Commit 6ddf6767 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

new: DESTRUCTURING-CASE, -CCASE, and -ECASE

  I've been wondering about adding these for a fair while
  now, but they _are_ nice when writing eg. certain kinds
  of macros,
parent 0c6f41f5
......@@ -230,3 +230,77 @@ Signals a PROGRAM-ERROR is the lambda-list is malformed."
(simple-program-error "Invalid ordinary lambda-list:~% ~S" lambda-list)))))))
(values (nreverse required) (nreverse optional) rest (nreverse keys)
allow-other-keys (nreverse aux))))
;;;; DESTRUCTURING-*CASE
(defun expand-destructuring-case (key clauses case)
(once-only (key)
`(if (typep ,key 'cons)
(,case (car ,key)
,@(mapcar (lambda (clause)
(destructuring-bind ((keys . lambda-list) &body body) clause
`(,keys
(destructuring-bind ,lambda-list (cdr ,key)
,@body))))
clauses))
(error "Invalid key to DESTRUCTURING-~S: ~S" ',case ,key))))
(defmacro destructuring-case (keyform &body clauses)
"DESTRUCTURING-CASE, -CCASE, and -ECASE are a combination of CASE and DESTRUCTURING-BIND.
KEYFORM must evaluate to a CONS.
Clauses are of the form:
((CASE-KEYS . DESTRUCTURING-LAMBDA-LIST) FORM*)
The clause whose CASE-KEYS matches CAR of KEY, as if by CASE, CCASE, or ECASE,
is selected, and FORMs are then executed with CDR of KEY is destructured and
bound by the DESTRUCTURING-LAMBDA-LIST.
Example:
(defun dcase (x)
(destructuring-case x
((:foo a b)
(format nil \"foo: ~S, ~S\" a b))
((:bar &key a b)
(format nil \"bar, ~S, ~S\" a b))
(((:alt1 :alt2) a)
(format nil \"alt: ~S\" a))
((t &rest rest)
(format nil \"unknown: ~S\" rest))))
(dcase (list :foo 1 2)) ; => \"foo: 1, 2\"
(dcase (list :bar :a 1 :b 2)) ; => \"bar: 1, 2\"
(dcase (list :alt1 1)) ; => \"alt: 1\"
(dcase (list :alt2 2)) ; => \"alt: 2\"
(dcase (list :quux 1 2 3)) ; => \"unknown: 1, 2, 3\"
(defun decase (x)
(destructuring-case x
((:foo a b)
(format nil \"foo: ~S, ~S\" a b))
((:bar &key a b)
(format nil \"bar, ~S, ~S\" a b))
(((:alt1 :alt2) a)
(format nil \"alt: ~S\" a))))
(decase (list :foo 1 2)) ; => \"foo: 1, 2\"
(decase (list :bar :a 1 :b 2)) ; => \"bar: 1, 2\"
(decase (list :alt1 1)) ; => \"alt: 1\"
(decase (list :alt2 2)) ; => \"alt: 2\"
(decase (list :quux 1 2 3)) ; =| error
"
(expand-destructuring-case keyform clauses 'case))
(defmacro destructuring-ccase (keyform &body clauses)
(expand-destructuring-case keyform clauses 'ccase))
(defmacro destructuring-ecase (keyform &body clauses)
(expand-destructuring-case keyform clauses 'ecase))
(dolist (name '(destructuring-ccase destructuring-ecase))
(setf (documentation name 'function) (documentation 'destructuring-case 'function)))
......@@ -233,4 +233,7 @@
#:symbolicate
#:assoc-value
#:rassoc-value
#:destructuring-case
#:destructuring-ccase
#:destructuring-ecase
))
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