[add] defun-case

2 files changed, 22 insertions, 0 deletions

diff --git a/hyperquirks.lisp b/hyperquirks.lisp
index b399519..2c7de1a 100644
--- a/hyperquirks.lisp
+++ b/hyperquirks.lisp
@@ -181,6 +181,27 @@ And would return
 
 
 
+(defmacro defun-case (name &rest clauses)
+  "Clauses look like (VARLIST . BODY) 
+
+E.g. 
+
+(defun-case foobar 
+  (() 10) 
+  ((x y) (+ x y))
+  ((foo) (* foo 2))
+  ((a b c d) (list a b c d)))"
+  (let* ((rest-args
+           (gensym "variable-pattern-"))
+         (clauses
+           (loop for (arglist . body) in clauses
+                 collect `(,(length arglist)
+                           (destructuring-bind ,arglist ,rest-args
+                             ,@body)))))
+    `(defun ,name (&rest ,rest-args)
+       (case (length ,rest-args)
+         ,@clauses))))
+
 ;;; LIST FUNCTIONS
 
 (defun group (n xs &optional default)
diff --git a/package.lisp b/package.lisp
index dff7a7e..b59340f 100644
--- a/package.lisp
+++ b/package.lisp
@@ -10,5 +10,6 @@
    #:>>
    #:imperative-cond
    #:with-plist
+   #:defun-case
    #:group
    #:tabulate))