[armedbear-cvs] r12084 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Aug  8 10:15:32 2009
New Revision: 12084

Log:
Declaration (processing) fixes.

jvm.lisp (process-ignore/ignorable): Don't process function-binding
   declarations as if they were variables.

clos.lisp: declare CALL-NEXT-METHOD and NEXT-METHOD-P as ignorable
   function bindings (instead of variables).

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sat Aug  8 10:15:32 2009
@@ -1586,7 +1586,8 @@
                              (funcall next-emfun (or cnm-args args))))
                        (next-method-p ()
                          (not (null next-emfun))))
-                  (declare (ignorable call-next-method next-method-p))
+                  (declare (ignorable (function call-next-method)
+                                      (function next-method-p)))
                   (apply #'(lambda ,lambda-list , at declarations , at body) args))))
             ((null (intersection lambda-list '(&rest &optional &key &allow-other-keys &aux)))
              ;; Required parameters only.

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Sat Aug  8 10:15:32 2009
@@ -479,17 +479,18 @@
   (when (memq declaration '(IGNORE IGNORABLE))
     (let ((what (if (eq declaration 'IGNORE) "ignored" "ignorable")))
       (dolist (name names)
-        (let ((variable (find-variable name variables)))
-          (cond ((null variable)
-                 (compiler-style-warn "Declaring unknown variable ~S to be ~A."
-                                      name what))
-                ((variable-special-p variable)
-                 (compiler-style-warn "Declaring special variable ~S to be ~A."
-                                      name what))
-                ((eq declaration 'IGNORE)
-                 (setf (variable-ignore-p variable) t))
-                (t
-                 (setf (variable-ignorable-p variable) t))))))))
+        (unless (and (consp name) (eq (car name) 'FUNCTION))
+          (let ((variable (find-variable name variables)))
+            (cond ((null variable)
+                   (compiler-style-warn "Declaring unknown variable ~S to be ~A."
+                                        name what))
+                  ((variable-special-p variable)
+                   (compiler-style-warn "Declaring special variable ~S to be ~A."
+                                        name what))
+                  ((eq declaration 'IGNORE)
+                   (setf (variable-ignore-p variable) t))
+                  (t
+                   (setf (variable-ignorable-p variable) t)))))))))
 
 (defun finalize-generic-functions ()
   (dolist (sym '(make-instance