newLISP で DAG する．．．または、match な find-all

　DAG (Directed acyclic graph) とは有向非巡回グラフのことらしい。
　といっても、DAG が何かわからずにコードを書いた私。
　きっかけは、newLISP Foram の投稿から。
　これは簡単にコード化はできそうだと思い、書いて投降したのですが、、、
　何か、しっくりこなかったのです。newLISP らしくないというか、、、
　同投稿で rickyboy 氏が find に match を使っているのを見て、思い出しました。 find-all がリストに対して match になる（第二構文）ことを。

(if (replace nil (map (fn (x) (match '(? _x) x true)) lst)) $it "start")

　なんて、長ったらしいコードは、find-all を使えば、

(if (find-all '(? _x) lst) $it "start")

　ああ、すっきり。
　前にも、こんなことがあったのを思い出し、忘れないよう blog に（笑）
　先に newLISP Foram に投降したコードは、こんな感じに変わります。

(define (search-pre lst)
  (letex (_x (args 0))
    (if (find-all '(? _x) lst) $it "start")))
(define (search-next lst)
  (letex (_x (args 0))
    (if (find-all '(_x ?) lst) $it "end")))
(define (search-all lst)
  (letex (_x (args 0))
    (local (res)
      (dolist (x lst)
         (if (match '(? _x) x) (push x res -1)
             (match '(_x ?) x) (push x res -1)))
      res)))

　ついでに newLISP らしく、if の cond 的な使い方も（笑）

　以上、如何でしょうか？

newLISP で On Lisp する．．．第１８章（その４）

（この blog は、“short short story または 晴耕雨読な日々”からの引越してきたもの。スクリプトは、newLISP V10.2.1 以降で動作するように書き直しています。
defun 等の newLISP組込関数に無い関数は、特に断らない限り、newlisp-utility.lsp と onnewlisp.lsp に定義してあります。）

　第１８章 分配 も大詰め マッチング です。

　先ずは、マッチング の前に アナフォリック･マクロacond2 のおさらいから、（gensym は newlisp-utility.lsp に、multiple-value-bind は onnewlisp.lsp に定義してあります）

(define-macro (acond2)
; (acond &rest clauses)
  (if (null? (args))
      nil
    (letex (_cl1st  (args 0 0)
            _clrest (cons 'begin (1 (args 0)))
            _acondrest (cons 'acond2 (1 (args))) 
            _val (gensym)
            _win (gensym))
      (multiple-value-bind (_val _win) _cl1st
        (if (or _val _win)
            (let (it _val) _clrest)
              _acondrest)))))

　acond2 自体には、第１４章（その２の続き）で実装したスクリプトそのままですが、中で使っている多値対応の multiple-value-bind を変更しています。最新の onnewlisp.lsp を使って下さい。有り体に言えば、複数回の評価に関わる問題 の修正です。もちろん、同じ多値対応の multiple-value-list も修正してあります。

　そして、マッチング の実装です。newLISP組込関数にmatch があるので matchEx に改名してあります。（aif、defun、t、second と consp は、newlisp-utility.lsp に定義してあります）

(define-macro (matchEx)
  (letex (_exec (cons 'matchx (args))
          _flag (eval values:mv-set))
    (let (_res _exec)
      (if _flag _res (_res 0)))))

(defun matchx (x y (binds '()))
  (acond2
    ((or (= x y) (= x '_) (= y '_)) (list binds t))
    ((binding x binds) (matchx it y binds))
    ((binding y binds) (matchx x it binds))
    ((varsym? x) (list  (cons (cons x y) binds) t))
    ((varsym? y) (list  (cons (cons y x) binds) t))
    ((and (consp x) (consp y) (matchx (first x) (first y) binds))
      (matchx (rest x) (rest y) it))
    (t (list nil nil)))) 

(defun varsym? (x)
  (and (symbol? x) (= ((string x) 0) "?")))

(defun binding (x binds)
  (if (atom? x)
      (labels ((recbind (x binds)
                 (aif (and binds (assoc x binds))
                      (or (recbind (rest it) binds)
                   it))))
        (let ((b (recbind x binds)))
          (list  (second (mklist b)) b)))
    (list nil nil)))

　matchEx は、多値対応にするために作ったマクロです。以前のようにリストで返す仕様であれば、matchx だけで十分です（笑）。
　values の代わりに list を使っている点を除けば、ほほ “On Lisp” 本書とほぼ同一の実装です。
　その最大の理由は、実行部の matchx がマクロでなく、関数だからでしょうか？
　動作はというと、（multiple-value-list は onnewlisp.lsp に定義してあります）

> (multiple-value-list (matchEx '(p a b c a) '(p ?x ?y c ?x)))
(((?y b) (?x a)) true)
> (matchEx '(p a b c a) '(p ?x ?y c ?x))
((?y b) (?x a))
> (matchEx '(p ?x b ?y a) '(p ?y b c a))
((?y c) (?x ?y))
> (matchEx '(a b c) '(a a a))
nil
> (multiple-value-list (matchEx '(a b c) '(a a a)))
(nil nil)
> (matchx '(p ?x) '(p ?x))
(() true)
> (matchEx '(p ?x) '(p ?x))
()
> (multiple-value-list (matchEx '(p ?x) '(p ?x)))
(() true)
> (matchx '(a ?x b) '(_ 1 _))
(((?x 1)) true)
> 

　という、感じです。空リストが nil にならないのは、仕様です。
　マッチング の残りは次回に。マクロですから、今回みたいに、すんなりとは行きません(笑)。
　以上、如何でしょうか？