Commit 2b1eb406 authored by Nikodemus Siivola's avatar Nikodemus Siivola

add existence of &KEY to return-values of PARSE-ORDINARY-LAMBDA-LIST

parent 107eb17c
...@@ -112,6 +112,8 @@ arguments when given." ...@@ -112,6 +112,8 @@ arguments when given."
(name init). (name init).
7. Existence of &KEY in the lambda-list.
Signals a PROGRAM-ERROR is the lambda-list is malformed." Signals a PROGRAM-ERROR is the lambda-list is malformed."
(let ((state :required) (let ((state :required)
(allow-other-keys nil) (allow-other-keys nil)
...@@ -120,6 +122,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -120,6 +122,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(optional nil) (optional nil)
(rest nil) (rest nil)
(keys nil) (keys nil)
(keyp nil)
(aux nil)) (aux nil))
(labels ((fail (elt) (labels ((fail (elt)
(simple-program-error "Misplaced ~S in ordinary lambda-list:~% ~S" (simple-program-error "Misplaced ~S in ordinary lambda-list:~% ~S"
...@@ -148,7 +151,8 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -148,7 +151,8 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(&key (&key
(if (member state '(:required &optional :after-rest)) (if (member state '(:required &optional :after-rest))
(setf state elt) (setf state elt)
(fail elt))) (fail elt))
(setf keyp t))
(&allow-other-keys (&allow-other-keys
(if (eq state '&key) (if (eq state '&key)
(setf allow-other-keys t (setf allow-other-keys t
...@@ -229,7 +233,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed." ...@@ -229,7 +233,7 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(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) keyp)))
;;;; DESTRUCTURING-*CASE ;;;; DESTRUCTURING-*CASE
......
...@@ -1885,3 +1885,13 @@ ...@@ -1885,3 +1885,13 @@
(equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0)) (equal '(#C(0.0 0.0) #C(0.0 2.0) #C(0.0 4.0))
(iota 3 :start 0.0 :step #C(0 2))) (iota 3 :start 0.0 :step #C(0 2)))
t) t)
(deftest parse-ordinary-lambda-list.1
(multiple-value-bind (req opt rest keys allowp aux keyp)
(parse-ordinary-lambda-list '(a b c &optional d &key))
(and (equal '(a b c) req)
(equal '((d nil nil)) opt)
(equal '() keys)
(not allowp)
(not aux)
(eq t keyp))))
Markdown is supported
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