unmatch: パターンマッチングライブラリ

unmatch:ifmatchはOn Lispの機能限定版if-matchです。
特徴としては、低速、低容量、緩いライセンスがあげられます。

世の中には様々なCommon Lispのパターンマッチングライブラリがあり、 どれもが洗練された優れたものばかりです。
本ライブラリはそれらとは全く対極のものであり、 機能性や性能などは考慮していません。
求められているのはコードの手軽さです。

インストール

下記をコピーして使ってください。
asdファイルなんて用意していません。

;; unmatch.lisp   [Unlicense]
(defpackage :unmatch (:use :cl) (:export #:ifmatch))
(in-package :unmatch)

(defun strequal (x y)
  (and (symbolp y) (string= x (symbol-name y))))

(defun charequal (x y)
  (and (symbolp y) (char= x (char (symbol-name y) 0))))

(defun matchpat (a b &optional c)
  (cond ((strequal "_" a)
         (values t c))
        ((charequal #\? a)
         (let ((list (assoc a c :test #'eq)))
           (if list
             (values (equal (cdr list) b) c)
             (values t (acons a b c)))))
        ((and (consp a) (consp b))
         (multiple-value-bind (x y) (matchpat (car a) (car b) c)
           (and x (matchpat (cdr a) (cdr b) y))))
        (t (values (equal a b) c))))

(defun matchlet (a b &aux root)
  (labels ((rec (x) (cond ((consp x) (rec (car x)) (rec (cdr x)))
                          ((charequal #\? x) (pushnew x root)))))
    (rec a)
    (mapcar (lambda (x)
              `(,x (cdr (assoc ',x ,b :test #'eq))))
            root)))

(defun matchrec (x)
  (cond ((and (consp x) (eq (car x) 'quote)) x)
        ((consp x) `(cons ,(matchrec (car x)) ,(matchrec (cdr x))))
        ((or (charequal #\? x) (strequal "_" x)) `',x)
        (t x)))

(defmacro ifmatch (pat expr then &optional else)
  (let ((x (gensym)) (y (gensym)))
    `(multiple-value-bind (,x ,y) (matchpat ,(matchrec pat) ,expr)
       (declare (ignorable ,y))
       (if ,x
         (let ,(matchlet pat y) ,then)
         ,else))))

使い方

構文を下記に示します。

(ifmatch match expr
  then
  [else])

例えば下記の通り。

(ifmatch (_ ?a (_ ?b . _) 10) '(10 20 (30 40 50 60) 10)
  (list ?a ?b))
-> (20 40)