Archive for 2010年7月18日|Daily archive page

newLISP で On Lisp する...第11章(その2)

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

 今回は、第11章 古典的なマクロwith-系マクロ から。
 newLISPには、unwind-protect は、ありません。その代わりとして、catch が使えます。catch の使い方は、前に with-open-file の実装で書いていますが、本文の unwind-protect の例は、下記のようになります。

> [cmd]
(begin 
  (setq x 'a)
  (catch (begin (println "What error?") (throw-error "This error.")) '*error*)
  (setq x 'b)
  *error*)
[/cmd]
What error?
"ERR: user error : This error."
> x
b
> 

 throw-error は、newLISP 組込でユーザ定義エラー例外を起こします。エラーが起きそうな場所で、catch する方法です。unwind-protect のようにどの場所でエラーが起きても、、、とはいきませんが(汗)。

 さて、典型的な with-系マクロ。まずは、純粋なマクロ から。

(define-macro (with-db)
;(with-db db &body body)
  (letex (_temp (gensym)
          _res  (gensym)
          _db (args 0)
          _body (cons 'begin (1 (args))))
    (let ((_temp *db*) (_res))
      (catch (begin (setq *db* _db)
                    (lock *db*)
                    _body)
             '_res)
      (begin (release *db*)
             (setq *db* _temp)) 
      _res)))

 gensym を使っても、context の default functor を使わない限り、変数捕捉は、回避できません。とはいえ、gensym が不必要だというわけではありません。gensym を使わないと、_temp や _res は骨格になってしまいますから、使った方がベターです。ただ、完全に変数捕捉を回避するには、くどいですが、context の default functor が必要だということです。
 マクロと関数との組合せ はというと、(defun は、newlisp-utility.lsp に定義してあります。)

(define-macro (with-db)
;(with-db db &body body)
  (letex (_db (args 0)
          _body (append '(fn) '(()) (1 (args))))
    (with-db-fn *db* _db _body)))

(defun with-db-fn (old-db new-db body)
  (let (res)
   (catch (begin (setq *db* new-db)
                 (lock *db*)
                 (body))
          'res)
   (begin (release *db*)
          (setq *db* old-db))
   res))

 となります。こちらは、gensym を使っていません。本書のように gbod を作ってもかまいませんが、変数捕捉の可能性は、同等です。よって、変数捕捉問題を context の default functor で回避する newLISP では、gensym が不要な分だけ、こちらが有利です。いずれにしろ、複雑になれば、マクロと関数の組合せの方が実用的な点は、Common Lisp と同様です。その際、骨格になる変数は、なるべく、補助関数に持っていくのが、newLISP 流?(笑)

 次は、条件付き評価
 先ずは、if3 と nif から、

(define-macro (if3)
;(if3 test t-case nil-case ?-case)
  (letex (_test (args 0)
          _t-case (second (args))
          _n-case (third (args))
          _?-case (fourth (args)))
    (case _test
      (nil  _n-case)
      (?     _?-case)
      (true _t-case)))) 

(define-macro (nif)
;(nif expr pos zero neg)
  (letex (_g (gensym)
          _expr (args 0)
          _pos (second (args))
          _zero (third (args))
          _neg (fourth (args)))
    `(let ((_g _expr))
       (cond ((> _g) _pos)
             ((zero? _g) _zero)
             (t _neg)))))

 “On Lisp” 本書の if3 で (nil) だったキーは、nil になります。

> (if3 nil "true" "nil" "?")
"nil"

 本書の nif で使っている plusp は、newLISP には、ありません。上記スクリプトのような > 単品での使用がそれにあたります。もちろん、minusp 相当は、< 単品での使用です。わざわざ、gensym を使って変数を作り、評価式expr を代入しているのは、expr の評価を1回で済ませたいため。それにしても、第7章(その1)の実装例の方が、オーバー・ヘッドは少ないような気がしますが、cond を使った例というところでしょうか。
 動作は、示すまでも無いですが、

> (map (fn (x) (nif x 'P 'Z 'N)) '(0 1 -1))
(Z P N)

 となります。

 さて、次の in と inq のマクロ。先ずは、in から、

(define-macro (in)
;(in obj &rest choices)
  (letex (_obj (args 0)
          _choices (map eval (1 (args))))
    (apply or (map (fn (c) (= _obj c)) '_choices))))

 例によって、展開式を見ると、

> (in '(1 2 3) '(1 2 3) '(4 5 6) '(7 8 9))
(apply or (map (lambda (c) (= '(1 2 3) c)) '((1 2 3) (4 5 6) (7 8 9))))

 Common Lisper には、驚きの展開式かもしれません。orapply が使えるのですから(笑)。orand がマクロで定義されているCommonLispでは、使えない技。つまり、CommonLisp で in は、マクロでしか書けませんが、newLISP では、関数で書けるのです。

(defun in (obj)
;(in obj &rest choices)
  (apply or (map (fn (c) (= obj c)) (args))))

 驚くのはまだ早い(笑)。in の表記に見覚えがありませんか?choices部を括弧でくくれば、前に紹介した組込find の表記と一緒です。つまり、

(defun in (obj)
  (find obj (args))

or

(defun in (obj)
  (if (find obj (args)) true nil))

 と書けます。if文を使えば、戻り値が true/nil になりますが、実用的には、if 文は要らないはず。
 とはいえ、さすがに、inq までは、関数で書けません。

(define-macro (inq)
; (inq obj &rest args)
  (letex (_body (append '(in) 
                        (list ((fn (x) (letex (_x x) ''_x)) (eval (args 0))))
                        (map (fn (x) (letex (_x x) ''_x)) (1 (args)))))
    (begin _body)))

 カンマ(') を付加する関数を labels で定義したい時は、こうなります。(labels は、newlisp-utility.lsp に定義してあります。)

(define-macro (inq)
; (inq obj &rest args)
  (let (_obj (args 0)
        _choices (1 (args)))
    (letex (_body (labels ((add/c (x) (letex (_x x) ''_x)))
                                  (append '(in) 
                                  (list (add/c (eval _obj)))
                                  (map add/c _choices))))
      (begin _body))))

 ポイントは、内部関数add/c 。ここでカンマ(’) を付加しています。カンマが二つ付いていますが、前者が、CommonLispのバック・クォート(`)に相当すると考えればよいでしょう。つまり、letex と組み合わせることで、Common Lisp の

`',x

 に相当させているわけです。
 動作はというと、例によって、展開式で見てみましょう。

> (let (operator '/) (inq operator * + / -))
(in '/ '* '+ '/ '-)

 と、ここまでは、“On Lisp”本書風。
 しかし、newLISP で、クォートをつけるだけなら、

(define-macro (inq)
; (inq obj &rest args)
  (letex (_body (append '(in) 
                        (map quote (list (eval (args 0))))
                        (map quote (1 (args)))))
    _body))

 で、十分でだったのですね(笑)。
 次は、in-if です。

(define-macro (in-if)
;(in-if fn &rest choices)
  (letex (_fnsym (args 0)
          _choices (map eval (1 (args))))
    (apply or (map (fn (c) (_fnsym c)) '_choices))))

 動作を展開式で見ると、

> (in-if oddp 1 2)
(apply or (map (lambda (c) (oddp c)) '(1 2)))

 ということで、当然関数で書けます。

(defun in-if (fnsym)
;(in-if fn &rest choices)
  (apply or (map (fn (c) (fnsym c)) (args))))

 といった具合です。前述のように、Common Lisp では、関数で書けません。orapply が使える newLISP ならでは(笑)。
 さて、残りの >case は、こうなります。

(define-macro (>case)
; (>case expr &rest clauses)
  (let (_g (gensym))
  (letex (_expr (list _g (args 0))
          _condbody (cons 'cond (map (fn (cl) (>casex _g cl))
                          (1 (args)))))
    (let _expr
       _condbody)))) 

(defun >casex (g cl)
  (letex ((_key (first cl)) (_rest (rest cl)))
    (cond ((consp '_key) (append (list (append '(in) (list g) (mklist '_key))) '_rest ))
          ((inq '_key t otherwise) (append '(true) '_rest))
          (t (throw-error "bad >case clause")))))

 補助関数の変数 _key と _rest に全てカンマ(')が付いていつことに注意して下さい。
 動作はというと、

(>case (* 2 2)
       (((+ 1 1)(+ 1 2)) (print "X"))
       (((+ 2 2)) (print "Y"))
       (t (print "end")))

 の展開式が、

(let (gensym48 (* 2 2)) 
(cond 
  ((in gensym48 (+ 1 1) (+ 1 2)) (print "X")) 
  ((in gensym48 (+ 2 2)) (print "Y")) 
  (true (print "end"))))

 となります。gensym で作った変数に代入することで、expr 部の評価を一回で済ましています。

 反復 からの残りは、次回に。

 以上、如何でしょうか?

広告