/[gcl]/gcl/cmpnew/gcl_cmptop.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmptop.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by camm, Fri Jul 8 06:02:47 2005 UTC revision 1.27 by camm, Sat Jul 23 08:48:57 2005 UTC
# Line 265  Line 265 
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))
# Line 694  Line 696 
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)))

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26