Changeset 14138


Ignore:
Timestamp:
08/26/12 21:43:53 (9 years ago)
Author:
ehuelsmann
Message:

Re #241: Fix cases

(compile nil '(lambda (&rest foo &aux x)))

and (compile nil '(lambda (&aux x &rest)))

Note: Since the other 2 cases mentioned in the ticket are still

open, this commit doesn't actually close it.

File:
1 edited

Legend:

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

    r14130 r14138  
    9393
    9494"
    95   (let ((state :req)
     95  (let ((remaining lambda-list)
     96        (state :req)
    9697        req opt key rest whole env aux key-p allow-others-p)
    97     (dolist (arg lambda-list)
     98    (when (eq (car lambda-list) '&WHOLE)
     99      (let ((var (second lambda-list)))
     100        (when (memq var lambda-list-keywords)
     101          (error 'program-error
     102                 :format-control "Lambda list keyword ~A found where &WHOLE ~
     103                                  variable expected in lambda list ~A."
     104                 :format-arguments (list var lambda-list)))
     105        (setf whole (list var))
     106        (setf remaining (nthcdr 2 lambda-list))))
     107    (dolist (arg remaining)
    98108      (case arg
    99109        (&optional (setf state :opt))
     
    106116        (&whole (setf state :whole))
    107117        (&environment (setf state :env))
     118        (&whole
     119         (error 'program-error
     120                :format-control "&WHOLE must appear first in lambda list ~A."
     121                :format-arguments (list lambda-list)))
    108122        (t
    109123         (case state
     
    113127           (:env (setf env (list arg)
    114128                       state :req))
    115            (:whole (setf whole (list arg)
    116                          state :req))
    117129           (:none
    118130            (error "Invalid lambda list: argument found in :none state."))
     
    768780    (mapcan (lambda (x)
    769781              (mapcar #'first x))
    770             (list req opt key aux rest whole env))))
    771 
     782            (list req opt key aux (list rest) (list whole) (list env)))))
     783
     784(defun lambda-list-keyword-p (x)
     785  (memq x lambda-list-keywords))
    772786
    773787(defun rewrite-aux-vars (form)
    774788  (let* ((lambda-list (cadr form))
    775789         (aux-p (memq '&AUX lambda-list))
    776          (lets (cdr aux-p))
     790         (post-aux-&environment (memq '&ENVIRONMENT aux-p))
     791         (lets (ldiff (cdr aux-p) post-aux-&environment)) ; strip trailing &environment
    777792         aux-vars)
    778793    (unless aux-p
    779794      ;; no rewriting required
    780795      (return-from rewrite-aux-vars form))
     796    (dolist (var lets)
     797      (when (lambda-list-keyword-p var)
     798        (error 'program-error
     799               :format-control "Lambda list keyword ~A not allowed after &AUX in ~A."
     800               :format-arguments (list var lambda-list))))
    781801    (multiple-value-bind (body decls)
    782802        (parse-body (cddr form))
     
    786806              (t
    787807               (push form aux-vars))))
    788       (setf lambda-list (subseq lambda-list 0 (position '&AUX lambda-list)))
     808      (setf lambda-list
     809            (append (subseq lambda-list 0 (position '&AUX lambda-list))
     810                    post-aux-&environment))
    789811      (multiple-value-bind (let-decls lambda-decls)
    790812          (split-decls decls (lambda-list-names lambda-list))
Note: See TracChangeset for help on using the changeset viewer.