Archive for the ‘match’ Tag

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

 DAG (Directed acyclic graph) とは有向非巡回グラフのことらしい。
 といっても、DAG が何かわからずにコードを書いた私。
 きっかけは、newLISP Foram の投稿から。
 これは簡単にコード化はできそうだと思い、書いて投降したのですが、、、
 何か、しっくりこなかったのです。newLISP らしくないというか、、、
 同投稿で rickyboy 氏が findmatch を使っているのを見て、思い出しました。 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 らしく、ifcond 的な使い方も(笑)

 以上、如何でしょうか?

広告

newLISP で On Lisp する...第18章(その4)

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

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

 先ずは、マッチング の前に アナフォリック・マクロ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 自体には、第14章(その2の続き)で実装したスクリプトそのままですが、中で使っている多値対応の 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 にならないのは、仕様です。
 マッチング の残りは次回に。マクロですから、今回みたいに、すんなりとは行きません(笑)。
 以上、如何でしょうか?