Pattern matching for Common Lisp with one simple macro: destructuring-match

destructuring-match.lisp

(in-package :cl-user)

;;; destructuring-match
;;;
;;; Really simple implementation of pattern matching with multiple
;;; clauses for Common Lisp (using one implementation detail of SBCL
;;; here, namely sb-kernel::defmacro-lambda-list-bind-error).
;;;
;;; Like a combination of destructuring-bind and case.
;;;
;;; Note that this does not allow to return multiple values from a clause body.
;;;
;;; For a more solid implementation have a look at
;;; tfeb/dsm: Destructuring match
;;; https://github.com/tfeb/dsm
;;;
;;; Also see the implementation of destructuring-case in alexandria
;;; alexandria-1/macros.lisp · master · alexandria / alexandria · GitLab
;;; https://gitlab.common-lisp.net/alexandria/alexandria/-/blob/master/alexandria-1/macros.lisp?ref_type=heads#L312

(defmacro destructuring-match (form &body clauses)
  (unless (null clauses)
    (destructuring-bind ((pattern &rest body) &rest rest) clauses
      (let ((=form= (gensym "FORM")))
        `(let ((,=form= ,form))
           (multiple-value-bind (result success)
               (handler-case
                   (values
                    (destructuring-bind ,pattern ,=form=
                      ,@body)
                    t)
                 (sb-kernel::defmacro-lambda-list-bind-error ()
                   (values nil nil)))
             (if success
                 result
                 (destructuring-match ,=form= ,@rest))))))))

;;; Well, it does generate quite a bit of code...
#+nil
(disassemble
 (lambda (x)
   (declare (type list x))
   (declare (optimize speed (safety 0) (debug 0)))
   (destructuring-match x
     ((a b c) (quux a b c))
     ((a b) (quux a b)))))

(defun foo (x)
  (destructuring-match x
    ((a b c)
     (declare (ignore b c))
     (list a))
    ((a b) (list a b))))