Last active
December 1, 2023 19:01
-
-
Save kisp/81bc7c24c40483c2b8435677d44d2ad3 to your computer and use it in GitHub Desktop.
Pattern matching for Common Lisp with one simple macro: destructuring-match
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment