Skip to content
Snippets Groups Projects
Commit c5a96815 authored by Attila Lendvai's avatar Attila Lendvai
Browse files

parse-ordinary-lambda-list: make normalization customizable through keywords

parent 0c257112
No related branches found
No related tags found
No related merge requests found
...@@ -79,7 +79,10 @@ arguments when given." ...@@ -79,7 +79,10 @@ arguments when given."
(go :declarations))) (go :declarations)))
(values body (nreverse decls) doc))) (values body (nreverse decls) doc)))
(defun parse-ordinary-lambda-list (lambda-list) (defun parse-ordinary-lambda-list (lambda-list &key (normalize t)
(normalize-optional normalize)
(normalize-keyword normalize)
(normalize-auxilary normalize))
"Parses an ordinary lambda-list, returning as multiple values: "Parses an ordinary lambda-list, returning as multiple values:
1. Required parameters. 1. Required parameters.
...@@ -154,13 +157,15 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -154,13 +157,15 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(cond ((consp elt) (cond ((consp elt)
(destructuring-bind (name &rest tail) elt (destructuring-bind (name &rest tail) elt
(check-variable name "optional parameter") (check-variable name "optional parameter")
(if (cdr tail) (cond ((cdr tail)
(check-spec tail "optional-supplied-p parameter") (check-spec tail "optional-supplied-p parameter"))
(setf elt (append elt '(nil)))))) (normalize-optional
(setf elt (append elt '(nil)))))))
(t (t
(check-variable elt "optional parameter") (check-variable elt "optional parameter")
(setf elt (cons elt '(nil nil))))) (when normalize-optional
(push elt optional)) (setf elt (cons elt '(nil nil))))))
(push (ensure-list elt) optional))
(&rest (&rest
(check-variable elt "rest parameter") (check-variable elt "rest parameter")
(setf rest elt (setf rest elt
...@@ -177,14 +182,18 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -177,14 +182,18 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(check-variable var "keyword parameter"))) (check-variable var "keyword parameter")))
(t (t
(check-variable var-or-kv "keyword parameter") (check-variable var-or-kv "keyword parameter")
(setf var-or-kv (list (make-keyword var-or-kv) var-or-kv)))) (when normalize-keyword
(setf var-or-kv (list (make-keyword var-or-kv) var-or-kv)))))
(if (cdr tail) (if (cdr tail)
(check-spec tail "keyword-supplied-p parameter") (check-spec tail "keyword-supplied-p parameter")
(setf tail (append tail '(nil)))) (when normalize-keyword
(setf tail (append tail '(nil)))))
(setf elt (cons var-or-kv tail)))) (setf elt (cons var-or-kv tail))))
(t (t
(check-variable elt "keyword parameter") (check-variable elt "keyword parameter")
(setf elt (list (list (make-keyword elt) elt) nil nil)))) (setf elt (if normalize-keyword
(list (list (make-keyword elt) elt) nil nil)
(list elt)))))
(push elt keys)) (push elt keys))
(&aux (&aux
(if (consp elt) (if (consp elt)
...@@ -193,9 +202,10 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -193,9 +202,10 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(check-variable var "&aux parameter")) (check-variable var "&aux parameter"))
(progn (progn
(check-variable elt "&aux parameter") (check-variable elt "&aux parameter")
(setf elt (list elt nil)))) (setf elt (list* elt (when normalize-auxilary
'(nil))))))
(push elt aux)) (push elt aux))
(t (t
(simple-program-error "Invalid ordinary lambda-list:~% ~S" lambda-list))))))) (simple-program-error "Invalid ordinary lambda-list:~% ~S" lambda-list)))))))
(values (nreverse required) (nreverse optional) rest (nreverse keys) (values (nreverse required) (nreverse optional) rest (nreverse keys)
allow-other-keys (nreverse aux)))) allow-other-keys (nreverse aux))))
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment