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 にならないのは、仕様です。
　マッチング の残りは次回に。マクロですから、今回みたいに、すんなりとは行きません(笑)。
　以上、如何でしょうか？

newLISP で On Lisp する．．．第１４章（その２の続き）

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

　さて、第１４章 アナフォリックマクロ の 失敗 から 多値を返すアナフォリックマクロ の残りです（multiple-value-bind は、onnewlisp.lsp に定義してあります）。

(define-macro (awhen2)
; (awhen test-form &body body)
  (letex (_test-form (args 0)
          _body (cons 'begin (1 (args))))
    (aif2 _test-form _body))) 

(define-macro (awhile2)
; (awhile2 test &body body)
  (letex (_flag (gensym)
          _test (args 0)
          _body (cons 'begin (1 (args))))
    (let (_flag true)
      (while _flag
        (aif2 _test _body (setq _flag nil))))))

(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)))))

　ファイル用ユーティリティ で使われている Common Lisp の read に相当するのは、newLISP では read-expr です。ただし、引数は、文字列です（gensym は newlisp-utility.lsp に、values は onnewlisp.lsp に定義してあります）。

(context 'MAIN:read-expr2)
(setq g (gensym))
(define (read-expr2:read-expr2 str)
  (setq $0 g)
  (let (val (read-expr str))
      (if-not (= $0 g) (values val $0))))
(context MAIN)

(define-macro (do-file)
; (do-file filename &body body)
  (letex (_str (gensym)
          _file (args 0)
          _body (cons 'begin (1 (args))))
    (let (_str (read-file _file))
      (awhile2 (read-expr2 _str)
        _body
        (setq _str ($0 _str))))))

　関数read-expr2 の返す値は、文字列から読み取った式と読み取った文字数です。組込read-expr は、文字列の最初の式のみを取り出します。そして、システム変数 $0 に読み取った文字数が入ります。エラーもしくは、EOF の時は、$0 は変わりません。関数先頭で $0 に gensym で生成したシンボルを入れておき、エラーもしくは、EOF の判定に使っています。“On Lisp”本書の例に習って、gensym によるシンボル生成は、一回で済むようにしています。
　マクロdo-file では、読み取った文字列を切り取り、残りの文字列を関数read-expr2 に渡しています。システム変数 $0 が表に出ているのは、awhile2 を使っているから。
　awhile2 を使わずに、multiple-value-bind を使って

(define-macro (do-file)
; (do-file filename &body body)
  (letex (_str (gensym)
          _pos (gensym)
          _flag (gensym)
          _file (args 0)
          _body (cons 'begin (1 (args))))
    (let (_str (read-file _file)
          _flag true)
      (while _flag
        (multiple-value-bind (it _pos) (read2 _str)
          _body
          (if _pos
              (setq _str (_pos _str))
            (setq _flag nil)))))))

　とすれば、システム変数$0 は、read-expr2 内に隠れます。

　そして、第１４章 アナフォリックマクロ の 最後、参照の透明性 につながります（笑）。
　ここに書かれている、参照の透明性は、常に頭に入れておきたいものです。というのは、これを考えておかないと、思わぬバグを引き起こすからです。
　例えば、newLISP の組込find では、システム変数が使えます。

> (find nil '(2 3 6) (fn (x y) (oddp y)))
1
> $0
3
> (find nil '(2 4 6) (fn (x y) (oddp y)))
nil
> $0
3

　これは、（b）に反する例かもしれません。断っておきますが、newLISP が悪いといっているわけではありません。$0 は、システム変数ですから、保障された内容ではありません。使うのは自己責任です。上記の例では、2番目の検索で検出されなかったので、$0 が更新されなかっただけのこと。システム内の高速化を考えれば、リーズナブルな仕様です。使う側ではそのリスクを負わなければなりません。
　なぜ、これを例に出したのか？それは、私だけかもしれませんが、この手のことは、よく実装しがちだからです。書いた時は、そのことを覚えているのですが、しばらく経ってから使った時、思うように動かないのは、大抵こういうことだったりするからです。内部変数ではよいとしても、表に出てくる値に対しては、参照の透明性を考慮しておくべきでしょう。
　くどいようですが、$0 は、内部変数です。使う方の責任です。ちなみに、find で $0 の代わりに、$it は使えません。当たり前か。ということで、前に実装した find-if は、システム変数を使う場合、次のように実装すべきでしょう。

(define (find-if func lst)
  (and (find nil lst (fn (x y) (func y)))
       $0))

　実は、これを出したかっただけだったりして（汗）。

　閑話休題、第１４章 アナフォリックマクロ のまとめです。

• newLISP でも、アナフォリックマクロは可能ですし、役に立ちます。
• newLISP では、空リストと nil は、区別されます。ただし、if 文では、どちらも 偽（true の逆）です。
• newLISP でも、参照の透明性は、常に頭に入れておくべきでしょう。

　以上、如何でしょうか？