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

Erik Huelsmann ehuelsmann at common-lisp.net
Sun Feb 6 20:03:29 UTC 2011


Author: ehuelsmann
Date: Sun Feb  6 15:03:28 2011
New Revision: 13206

Log:
Simplify argument passing in CHECK-INITARGS.

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.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	Sun Feb  6 15:03:28 2011
@@ -2560,24 +2560,19 @@
     (error 'program-error
            :format-control "Odd number of keyword arguments."))
   (unless (getf initargs :allow-other-keys)
-    (let ((methods 
-	   (nconc 
-	    (compute-applicable-methods 
-	     #'shared-initialize
-	     (if initargs
-		 `(,instance ,shared-initialize-param , at initargs)
-	       (list instance shared-initialize-param)))
-	    (compute-applicable-methods 
-	     #'initialize-instance
-	     (if initargs
-		 `(,instance , at initargs)
-	       (list instance)))))
-	  (slots (class-slots (class-of instance))))
+    (let ((methods
+           (nconc
+            (compute-applicable-methods #'shared-initialize
+                                        (list* instance shared-initialize-param
+                                               initargs))
+            (compute-applicable-methods #'initialize-instance
+                                        (list* instance initargs))))
+          (slots (class-slots (class-of instance))))
       (do* ((tail initargs (cddr tail))
             (initarg (car tail) (car tail)))
            ((null tail))
         (unless (or (valid-initarg-p initarg slots)
-		    (valid-methodarg-p initarg methods)
+                    (valid-methodarg-p initarg methods)
                     (eq initarg :allow-other-keys))
           (error 'program-error
                  :format-control "Invalid initarg ~S."




More information about the armedbear-cvs mailing list