Changeset 14138
- Timestamp:
- 08/26/12 21:43:53 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
r14130 r14138 93 93 94 94 " 95 (let ((state :req) 95 (let ((remaining lambda-list) 96 (state :req) 96 97 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) 98 108 (case arg 99 109 (&optional (setf state :opt)) … … 106 116 (&whole (setf state :whole)) 107 117 (&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))) 108 122 (t 109 123 (case state … … 113 127 (:env (setf env (list arg) 114 128 state :req)) 115 (:whole (setf whole (list arg)116 state :req))117 129 (:none 118 130 (error "Invalid lambda list: argument found in :none state.")) … … 768 780 (mapcan (lambda (x) 769 781 (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)) 772 786 773 787 (defun rewrite-aux-vars (form) 774 788 (let* ((lambda-list (cadr form)) 775 789 (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 777 792 aux-vars) 778 793 (unless aux-p 779 794 ;; no rewriting required 780 795 (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)))) 781 801 (multiple-value-bind (body decls) 782 802 (parse-body (cddr form)) … … 786 806 (t 787 807 (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)) 789 811 (multiple-value-bind (let-decls lambda-decls) 790 812 (split-decls decls (lambda-list-names lambda-list))
Note: See TracChangeset
for help on using the changeset viewer.