X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fmacros.lisp;h=baec9382f55a137527920f67e64986d3539e491e;hb=dea9bd5c1afe23d9e061c60db654b88187ba9a5e;hp=b0c5f53fc71980667d12a3b0f80bf86cab3fcf24;hpb=24bc431a3403af05c5df601d09c0d0c27cb500b2;p=sbcl.git diff --git a/src/pcl/macros.lisp b/src/pcl/macros.lisp index b0c5f53..baec938 100644 --- a/src/pcl/macros.lisp +++ b/src/pcl/macros.lisp @@ -216,66 +216,4 @@ (defsetf slot-value set-slot-value) -(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")