Changeset 14058

Timestamp:

08/05/12 20:27:10 (10 years ago)

Author:

ehuelsmann

Message:

Follow up to r14054, efficient arguments option variable references
for &rest and &key.

File:

• trunk/abcl/src/org/armedbear/lisp/clos.lisp (modified) (3 diffs)

trunk/abcl/src/org/armedbear/lisp/clos.lisp

@@ -1255 +1255 @@
         (whole required optional rest keys aux)
       (parse-define-method-combination-args-lambda-list args-lambda-list)
+    (unless rest
+      (when keys
+        (setf rest (gensym))))
     (let* ((gf-lambda-list (gensym))
            (args-var (gensym))
@@ -1273 +1276 @@
                               `((,whole ',args-var)))
                       ,@(when rest
-                              `((,rest `(subseq ,',args-var
-                                                (+ ,nreq ,nopt)))))
+                              `((,rest (progn
+                                         (push `(,',rest
+                                                 (subseq ,',args-var
+                                                          ,(+ nreq nopt)))
+                                               ,binding-forms)
+                                         ',rest))))
                         ,@(loop for var in required
                              and i upfrom 0
@@ -1308 +1315 @@
                                                     ,binding-forms)
                                               ',var-binding)))
-                        ,@(loop for ((key var) initform) in keys
+                        ,@(loop for ((key var) initform supplied-var) in keys
+                             for supplied-binding = (or supplied-var (gensym))
+                             for var-binding = (gensym)
                              ;; Same as optional parameters:
                              ;; even though keywords can't be supplied in
                              ;; excess, we should bind "supplied-p" in case
                              ;; the key isn't supplied in the arguments list
-                             collect `(,var `(getk (subseq ,',args-var
-                                                           (+ ,nreq ,nopt)) ,',key
-                                                           ,',initform)))
+                             collect `(,supplied-binding
+                                       (progn
+                                         (push `(,',supplied-binding
+                                                 (member ,',key ,',rest)))
+                                         ',supplied-binding))
+                             collect `(,var (progn
+                                              (push `(,',var-binding
+                                                      (if ,',supplied-binding
+                                                          (cadr ,',supplied-binding)
+                                                          ,',initform))
+                                                    ,binding-forms))))
                         ,@(loop for (var initform) in aux
                              for var-binding = (gensym)