0.7.7.34:
[sbcl.git] / src / pcl / macros.lisp
index b0c5f53..baec938 100644 (file)
 
 (defsetf slot-value set-slot-value)
 \f
-(defun misplaced-lambda-list-keyword (lambda-list keyword)
-  (error "Lambda list keyword ~S is misplaced in ~S." keyword lambda-list))
-
-(defmacro process-lambda-list (lambda-list &rest clauses)
-  ;; (process-lambda-list '(a b &optional (c 1))
-  ;;                      (&required)
-  ;;                      ((&optional (print "Started processing optional arguments"))
-  ;;                       (format "Optional argument: ~S~%" it))
-  ;;                      (&rest (print "Rest")))
-  (let ((clauses (loop for clause in clauses
-                    collect
-                      (cond ((symbolp (car clause))
-                             `(,(car clause) nil . ,(cdr clause)))
-                            ((consp (car clause))
-                             `(,(caar clause) ,(cdar clause) . ,(cdr clause)))
-                            (t (error "Invalid clause format: ~S." clause)))))
-        (ll (gensym "LL"))
-        (state (gensym "STATE"))
-        (restp (gensym "RESTP"))
-        (check-state (gensym "CHECK-STATE")))
-    `(let ((,ll ,lambda-list)
-           (,state '&required)
-           (,restp nil))
-       (dolist (it ,ll)
-         (flet ((,check-state (possible)
-                  (unless (memq ,state possible)
-                    (misplaced-lambda-list-keyword ,ll it))))
-           (cond ((memq it lambda-list-keywords)
-                  (case it
-                    (&optional (,check-state '(&required))
-                               ,@(cadr (assoc '&optional clauses)))
-                    (&rest (,check-state '(&required &optional))
-                           ,@(cadr (assoc '&rest clauses)))
-                    (&key (,check-state '(&required &optional &rest))
-                          (when (and (eq ,state '&rest)
-                                     (not ,restp))
-                            (error "Omitted &REST variable in ~S." ,ll))
-                          ,@(cadr (assoc '&key clauses)))
-                    (&allow-other-keys (,check-state '(&key))
-                                       ,@(cadr (assoc '&allow-other-keys clauses)))
-                    (&aux (when (and (eq ,state '&rest)
-                                     (not ,restp))
-                            (error "Omitted &REST variable in ~S." ,ll))
-                          ,@(cadr (assoc '&aux clauses)))
-                    (t (error "Unsupported lambda list keyword ~S in ~S."
-                              it ,ll)))
-                  (setq ,state it))
-                 (t (case ,state
-                      (&required ,@(cddr (assoc '&required clauses)))
-                      (&optional ,@(cddr (assoc '&optional clauses)))
-                      (&rest (when ,restp
-                               (error "Too many variables after &REST in ~S." ,ll))
-                             (setq ,restp t)
-                             ,@(cddr (assoc '&rest clauses)))
-                      (&key ,@(cddr (assoc '&key clauses)))
-                      (&allow-other-keys (error "Variable ~S after &ALLOW-OTHER-KEY in ~S."
-                                                it ,ll))
-                      (&aux ,@(cddr (assoc '&aux clauses))))))))
-       (when (and (eq ,state '&rest)
-                  (not ,restp))
-         (error "Omitted &REST variable in ~S." ,ll)))))
-
 (/show "finished with pcl/macros.lisp")