Changeset 12416


Ignore:
Timestamp:
02/03/10 23:55:25 (12 years ago)
Author:
astalla
Message:

Fixed lambda.nn test failures caused by errors in lambda inlining.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r12411 r12416  
    206206           :collect `(,(var var-info) ,(initform var-info))))))
    207207 
    208   (values
    209    (append req-bindings temp-bindings bindings)
    210    ignorables)))))
     208  (values (append req-bindings temp-bindings bindings)
     209    ignorables)))))
    211210
    212211(defun match-keyword-and-rest-args (key allow-others-p rest arguments)
     
    219218       :mismatch-type :odd-number-of-keyword-arguments))
    220219   
    221     (let (temp-bindings bindings other-keys-found-p ignorables)
     220    (let (temp-bindings bindings other-keys-found-p ignorables already-seen
     221    args)
    222222      ;;If necessary, make up a fake argument to hold :allow-other-keys,
    223223      ;;needed later. This also handles nicely:
     
    237237   :for value :in (cdr arguments) by #'cddr
    238238   :do (let ((var-info (find var key :key #'keyword)))
    239          (if var-info
     239         (if (and var-info (not (member var already-seen)))
    240240       ;;var is one of the declared keyword arguments
    241241       (progn
    242242         (push-argument-binding (var var-info) value
    243243              temp-bindings bindings)
    244          ;(push `(,(var var-info) ,value) bindings)
    245244         (when (p-var var-info)
    246            (push `(,(p-var var-info) t) bindings)))
    247        (setf other-keys-found-p t))))
     245           (push `(,(p-var var-info) t) bindings))
     246         (push var args)
     247         (push (var var-info) args)
     248         (push var already-seen))
     249       (let ((g (gensym)))
     250         (push `(,g ,value) temp-bindings)
     251         (push var args)
     252         (push g args)
     253         (push g ignorables)
     254         (unless var-info
     255           (setf other-keys-found-p t))))))
    248256     
    249257      ;;Then, let's bind those arguments that haven't been passed in
    250258      ;;to their default value, in declaration order.
    251       (loop
    252    :for var-info :in key
    253    :do (unless (find (var var-info) bindings :key #'car)
    254          (push `(,(var var-info) ,(initform var-info)) bindings)
    255          (when (p-var var-info)
    256      (push `(,(p-var var-info) nil) bindings))))
     259      (let (defaults)
     260  (loop
     261     :for var-info :in key
     262     :do (unless (find (var var-info) bindings :key #'car)
     263     (push `(,(var var-info) ,(initform var-info)) defaults)
     264     (when (p-var var-info)
     265       (push `(,(p-var var-info) nil) defaults))))
     266  (setf bindings (append (nreverse defaults) bindings)))
    257267     
    258268      ;;If necessary, check for unrecognized keyword arguments.
     
    280290      (error 'lambda-list-mismatch :mismatch-type :unknown-keyword)))
    281291      (when rest
    282   (push `(,(var rest)
    283      (list ,@(let (list)
    284          (loop
    285             :for var :in arguments :by #'cddr
    286             :for val :in (cdr arguments) :by #'cddr
    287             :do (let ((bound-var
    288            (var (find var key :key #'keyword))))
    289             (push var list)
    290             (if bound-var
    291           (push bound-var list)
    292           (push val list))))
    293          (nreverse list))))
    294         bindings))
    295       (values
    296        (nreverse bindings)
    297        temp-bindings
    298        ignorables))))
     292  (setf bindings (append bindings `((,(var rest) (list ,@(nreverse args)))))))
     293      (print bindings)
     294      (values bindings temp-bindings ignorables))))
    299295
    300296#||test for the above
Note: See TracChangeset for help on using the changeset viewer.