265 |
(cond ((eq fun 'si:|#,|) |
(cond ((eq fun 'si:|#,|) |
266 |
(cmperr "Sharp-comma-macro is in a bad place.")) |
(cmperr "Sharp-comma-macro is in a bad place.")) |
267 |
((get fun 'package-operation) |
((get fun 'package-operation) |
268 |
(when *non-package-operation* |
; (when *non-package-operation* |
269 |
(cmpwarn "The package operation ~s was in a bad place." |
; (cmpwarn "The package operation ~s was in a bad place." |
270 |
form)) |
; form)) |
271 |
(let ((res (if (setq fd (macro-function fun)) |
(let ((res (if (setq fd (macro-function fun)) |
272 |
(cmp-expand-macro fd fun (copy-list (cdr form))) |
(cmp-expand-macro fd fun (copy-list (cdr form))) |
273 |
form))) |
form))) |
274 |
(maybe-eval t res) |
(maybe-eval t res) |
275 |
(wt-data-package-operation res))) |
(t1ordinary form) |
276 |
|
;(wt-data-package-operation res) |
277 |
|
)) |
278 |
((setq fd (get fun 't1)) |
((setq fd (get fun 't1)) |
279 |
(when *compile-print* (print-current-form)) |
(when *compile-print* (print-current-form)) |
280 |
(funcall fd args)) |
(funcall fd args)) |
696 |
(arg-p (length (get fname 'proclaimed-arg-types))) |
(arg-p (length (get fname 'proclaimed-arg-types))) |
697 |
(va (member '* (get fname 'proclaimed-arg-types)))) |
(va (member '* (get fname 'proclaimed-arg-types)))) |
698 |
(cond (va |
(cond (va |
699 |
(or (>= arg-c) |
(or (>= arg-c (- arg-p (length va))) |
|
(- arg-p (length va)) |
|
700 |
(cmpwarn "~a needs ~a args. ~a supplied." |
(cmpwarn "~a needs ~a args. ~a supplied." |
701 |
fname (- arg-p (length va)) |
fname (- arg-p (length va)) |
702 |
arg-c))) |
arg-c))) |