マッチング - OnLisp

マッチングの簡単な例としてOn Lispに載っている match 関数。
Scheme のコードで書いてみました。
acond2 や aif を使っていないので見にくいです。

(define (varsym? x)
  (if (symbol? x)
      (char=? (string-ref (symbol->string x) 0) #\?)
      #f))

varsym? は変数 ?x / ?y とただのシンボルを区別します。

(define (binding x binds)
  (define (recbind x binds)
    (let ((it (assoc x binds)))
      (if it
          (or (recbind (cdr it) binds) it) #f)))
  (let ((b (recbind x binds)))
    (if (pair? b)
        (values (cdr b) b)
        (values #f b))))

binds は

        '((?a . 3) (?z . 1) (q . ?z))

のように変数の実際の束縛状況を保持したものです。

ありえないくらい汚いな。（やっていることはシンプルなだけにもったいない。）

(define (match x y . binds)
  (let ((bs (if (pair? binds) (car binds) '())))
  (if (or (eq? x y) (eq? x '_) (eq? y '_))
      (values bs #t)
      (receive
       (v b)
       (binding x bs)
       (if v
           (match v y bs)
           (receive
            (v b)
            (binding y bs)
            (if v
                (match x v bs)
                (if (varsym? x)
                    (values (cons (cons x y) bs) #t)
                    (if (varsym? y)
                        (values (append bs (cons y x)) #t)
                        (let ((r (and (pair? x)
                                      (pair? y)
                                      (receive (v b) (match (car x) (car y) bs) v))))
                          (if r
                              (match (cdr x) (cdr y) r)
                              (values #f #f))))))))))))

実行してみると

gosh> (match '(?x (b ?y (d . ?z)))  '(a (b c (d . e))))
((?z . e) (?y . c) (?x . a))
#t

素敵。

感想

if や cdr の仕様違いに悩んだり、アナフォリックマクロを勉強したりでここまでたどり着くのにとても時間がかかった。
頭の回転が早くなる魔法が欲しいです