[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