Commit c5a96815 authored by Attila Lendvai's avatar Attila Lendvai
Browse files

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

parent 0c257112
......@@ -79,7 +79,10 @@ arguments when given."
(go :declarations)))
(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:
1. Required parameters.
......@@ -154,13 +157,15 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(cond ((consp elt)
(destructuring-bind (name &rest tail) elt
(check-variable name "optional parameter")
(if (cdr tail)
(check-spec tail "optional-supplied-p parameter")
(setf elt (append elt '(nil))))))
(cond ((cdr tail)
(check-spec tail "optional-supplied-p parameter"))
(setf elt (append elt '(nil)))))))
(check-variable elt "optional parameter")
(setf elt (cons elt '(nil nil)))))
(push elt optional))
(when normalize-optional
(setf elt (cons elt '(nil nil))))))
(push (ensure-list elt) optional))
(check-variable elt "rest parameter")
(setf rest elt
......@@ -177,14 +182,18 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(check-variable var "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)
(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))))
(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))
(if (consp elt)
......@@ -193,9 +202,10 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(check-variable var "&aux parameter"))
(check-variable elt "&aux parameter")
(setf elt (list elt nil))))
(setf elt (list* elt (when normalize-auxilary
(push elt aux))
(simple-program-error "Invalid ordinary lambda-list:~% ~S" lambda-list)))))))
(values (nreverse required) (nreverse optional) rest (nreverse keys)
allow-other-keys (nreverse aux))))
\ No newline at end of file
allow-other-keys (nreverse aux))))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment