Archive for 2010年7月|Monthly archive page

newLISP で On Lisp する...第12章(番外編)

 前回の 第12章 汎変数(その1)から、いきなり、番外編です(笑)。
 さて、前回見たように、newLISP では、参照を返すマクロは作れませんでした。つまり、setf の汎変数に自作のマクロを適用できないということ。そこで、以前それを可能にするマクロを考えました。
 しかし、newLISP の進化はそれより早く、現在では、参照を返す記述が可能です。マクロではなく macro を使って。だから、番外編(笑)。

 前回記述したcontext 関連の参照を返すマクロ friend-of

(define-macro (friend-of)
  (letex (_p  (args 0)
          _q  (args 1))
       ((*friends* _p) _q)))

 を macro にします。

(module "macro.lsp")
(macro (friend-of P Q)
  ((*friends* P) Q))

 あとは、前回使った toggle を用意して、

(define-macro (toggle)
  (letex (_obj (args 0))
    (setf _obj (not $it))))

 データを定義します。

> (new Tree '*friends*)
*friends*
> (*friends* "marry" (new Tree 'marry.*friends*))
marry.*friends*
> ((*friends* "marry") "john"  true)
true
> ((*friends* "marry") "john")
true
> (setf ((*friends* "marry") "john" ) nil)
nil
> ((*friends* "marry") "john")
nil
> (toggle ((*friends* "marry") "john"))
true
> ((*friends* "marry") "john")
true
> (gethash "john" (gethash "marry" *friends*))
true
> 

 ここまでは、前回と同じ。これで、動作確認の準備完了です。
 macro の friend-of を試します。

> toggle
(lambda-macro () 
 (letex (_obj (args 0)) (setf _obj (not $it))))
> friend-of
(lambda-macro (P Q) (expand '((*friends* P) Q)))
> (toggle (friend-of "marry" "john"))
nil
> (friend-of "marry" "john")
nil
> (setf (friend-of "marry" "john") true)
true
> (friend-of "marry" "john")
true
> 

 といった感じで、違和感なく使えます(笑)。もちろん、macro ならではの制限もありますが(汗)、toggle と friend-of を直行的に使えます。(もちろん、setf とも)

 newLISP では、macro を使って、プログラムを "見事にモジュール化され、なおかつ美しくエレガント" にできるというわけです。

 これで、前回の問題点は、クリアされました。次回は再び、第12章 汎変数(その1)に戻ります。

 以上、如何でしょうか?

広告

newLISP で On Lisp する...第12章(その1)

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

 ついに、第12章 汎変数 まで来てしまいました。私にとっては、“On Lisp” の中でも、最も難解な章です。最も Lisp らしい章であるともいえます。

 まずは、汎変数という概念 から。
 Common Lisp の setf はマクロなので、macroexpand を使って展開式を確認できます。しかし、newLISP の組込を展開してみることはできません。つまり、Common Lisp のようにインバージョンな様子を見ることが出来ないのです。また、インバージョンが、表に出てこない上に、それらにまつわるマクロも用意されていません。つまり、自分で組むしかないということ。やりがいがあるともいえます(笑)。
 インバージョンとは、言ってみれば、融通の利かないプログラミング言語に、「それくらい、気を利かせろ!」と、いっているようなもの。他のプログラミング言語(C++ とか、pascalとか)なら、せいぜい、warning を出すのが関の山。多くの場合、バグになります。だから、そもそも、そういう記述をしないのが、優秀なプログラマと見られるところ。しかし、Lisp では、違います。言うことを聞くように、Lisp を作り変えてしまうのが、優秀な Lisper? Lisp の持つ強力なマクロなしには、実現できないことでしょう。
 さてさて、newLISP は、どこまで Common Lisp に迫れるか? 違った、私の実力は? ですね(笑)。
 またまた、前置きが長くなりましたが、“On Lisp”本書の例から、newLISP での動作例を

> (setq lst '(a b c))
(a b c)
> (setf (first lst) 480)
480
> lst
(480 b c)
> 

 ここで、(first lst) が 汎変数にあたるわけです。car に相当する first は、Common Lisp でも使えます。

(define-macro (toggle)
  (letex (_obj (args 0))
    (setf _obj (not _obj))))

 の動作は、

> [cmd]
(let ((lst '(a b c)))
    (toggle (first lst)) 
    lst) 
[/cmd]
(nil b c)
> 

 ここまでは、本書と同じです。
 次の例からは、hash が無いので、context で代用します。

> (define *friends*:*friends*)
nil
> (*friends* "marry" (new Tree 'marry.*friends*))
marry.*friends*
> ((*friends* "marry") "john"  true)
true
> ((*friends* "marry") "john")
true
> (setf ((*friends* "marry") "john" ) nil)
nil
> ((*friends* "marry") "john")
nil
> (toggle ((*friends* "marry") "john"))
true
> ((*friends* "marry") "john")
true
> 

 Tree は、context を hash 代わりに使う時の組込テンプレートです。友人 john の加わった marry.*friends* を使って、anne の友人を設定すると、

> (*friends* "anne" (new marry.*friends* 'anne.*frineds*))
anne.*frineds*
> ((*friends* "marry") "john")
true
> ((*friends* "anne") "john")
true
> 

 上記のように、marry の友人が anne の友人にコピーされます。
 そして、

(define-macro (friend-of)
  (letex (_p (string (args 0))
          _q (string (args 1)))
    ((*friends* _p) _q)))

を定義して、

> (friend-of "marry" "john")
true
> (friend-of "anne" "john")
true
> 

 となります。しかし、toggle と friend-of の直交性は、

> (toggle (friend-of "marry" "john"))
nil
> (friend-of "marry" "john")
true
> 

 ご覧の通り、期待できません。前にも書きましたが、Common Lispのマクロは、呼び出された場所で展開式が評価されますが、newLISPでは、マクロ内で評価されてしまうからだと考えられます(泣)。

 問題点が見つかったところで、気を取り直し、複数回の評価に関わる問題 に入ります。
 前述のマクロtoggle の動作は、

> toggle
(lambda-macro ()
(letex (_obj (args 0)) (setf _obj (not _obj))))
> [cmd]
(let ((lst '(true nil true))
             (i -1))
        (toggle (nth (++ i) lst))
        lst)
[/cmd]
(true nil true)
> 

 と、toggle されません。++ は、incf と同じ破壊的組込関数なので nth に置かれたインデックス変数 i が変わっていくためです。
 Common Lisp には、define-modify-macro がありますが、newLISPにはありません。しかし、代わりに、$it があります。

(define-macro (toggle)
  (letex (_obj (args 0))
    (setf _obj (not $it))))

 とすれば、

> toggle
(lambda-macro ()
(letex (_obj (args 0)) (setf _obj (not $it))))
> [cmd]
(let ((lst '(true nil true))
             (i -1))
        (toggle (nth (++ i) lst))
        lst)
[/cmd]
(nil nil true)
> 

 となります。$it は、汎変数の値を保持していますので、望ましい toggle のインバージョンを定義できるわけです。

 さて、ちょっと早いですが、新しい ユーティリティ からは、次回以降に(汗)。

 以上、如何でしょうか?

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

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

 第11章 古典的なマクロ も三回目。
 今回は、反復 から。
 最初のマクロforever です(do の定義は、こちらにあります)。

(define-macro (forever)
; (forever &body body)
  (letex (_body (cons 'begin (args)))
   (do ()  (nil) _body)))

 しかし、newLISP では、わざわざマクロを組む必要あありません。

(until nil  expr ・・・ )

 あるいは、

(while true  expr ・・・ )

で済みます。使うかどうかは別にして。
 newLISP 組込の反復制御構造文には、 whileuntil(マクロtillに相当)、 for の他に do-whiledo-until(それぞれ終了条件が、body部の実行後に判定される、つまり必ず一回は、body部が実行される。)があります。よほどのことが無い限り、これだけあれば十分でしょう。ということで、残りの、単純な反復用マクロ は、実装しません。すでに、do を実装し、それを使って、our-while を実装していますから、後は自明でしょう(笑)。
 ということで、部分リストに渡る再帰のためのマクロ に移ります。

(define-macro (do-tuples/o parms)
; (do-tuples/o parms source &body body)
  (if parms
    (letex (_parms parms
            _n (gensym)
            _parmslen (-- (length parms))
            _source (args 0)
            _body (cons 'begin (1 (args))))
      (map (curry apply (fn _parms _body)) 
           (0 (- (length _source) _parmslen) 
             (transpose (map (fn (_n) (_n _source))
                             (sequence 0 (length _parmslen))))))
      nil)))

 “On Lisp” 本書のマクロは、ソースとソースの cd…dr部 を用意し、mapc で部分リストを作っています。

(mapc #'(fn (x y z) (list x y z))
      '(a b c d e)
      '(b c d)
      '(c d))

 これを実現するために、mapc も用意したのですが、この形を見て思い出したんです。組込 transpose が使える、と。それで書いたのが上記マクロです。前に書いたように、map0-n は、 mapsequence の組合せで実現できます。展開式部の最後に nil があるのは、本書マクロの戻り値に合わせたものです。本書にあるように戻り値ではなく、副作用が目的ですから。
 動作はというと、

> (do-tuples/o (x y z w) '(a b c d e f) (print (list x y z w)))
(a b c d)(b c d e)(c d e f)nil
> (let (res) (do-tuples/o (x y z w) '(a b c d e f) (push (list x y z w) res -1)) res)
((a b c d) (b c d e) (c d e f))
> (let (res) (catch (do-tuples/o (x y z w) '(a b c d e f) (if (= x 'b) (throw (list x y z w)))) 'res) res)
(b c d e)

 return の代わりに catchthrow が使えます。
 マクロdo-tuples/c は、transpose を使うことで、補助関数すら要りません。

(define-macro (do-tuples/c parms)
; (do-tuples/o parms source &body body)
  (if parms
    (letex (_parms parms
            _n (gensym)
            _parmslen (-- (length parms))
            _source (args 0)
            _srclen (length (eval (args 0)))
            _body (cons 'begin (1 (args))))
      (when (< _parmslen _srclen)
        (map (curry apply (fn _parms _body)) 
             (0 _srclen (transpose (map (fn (_n) (_n (append _source (0 _parmslen _source))))
                                   (sequence 0 (length _parmslen))))))
      nil))))

 動作は、

> (do-tuples/c (x y z w) '(a b c d e f) (print (list x y z w)))
(a b c d)(b c d e)(c d e f)(d e f a)(e f a b)(f a b c)nil

 どちらも、引数が1個なら、 dolist と同じです。

> (do-tuples/o (x) '(a b c) (print x))
abcnil
> (do-tuples/c (x) '(a b c) (print x))
abcnil

 同じ引数に対しては、

> (do-tuples/o (x y z w) '(a b c d) (print (list x y z w)))
(a b c d)nil
> (do-tuples/c (x y z w) '(a b c d) (print (list x y z w)))
(a b c d)(b c d a)(c d a b)(d a b c)nil

 となります。mapc の実装については、後述します。

 さて、今回のメイン・イベント、複数の値に渡る反復 です。
 newLISP には、多値の戻り値を返す機能はありません。values と multiple-value-bind も既に定義しましたが、ここでは、values の代わりに list と使います。
 そして、すでに do と do* は、定義できていますから、あとは、mvsetq と mvpsetq が用意するだけです。
 前置きが長くなりましたが、mvpseq から。もちろん、破壊的ですから、マクロです
(labels と psetq は、newlisp-utility.lsp で定義してあります)。

(define (add-c lst)
  (labels ((add/c (x) (if (symbol? x) (letex (_x x) ''_x) x)))
    (if (atom? lst) (add/c lst)
      (let (res)
        (map (fn (x) (push (add/c x) res -1)) lst)
      res)))) 

(define (mvbind-c)
  (letex 
    (_vars (let (res)
      (dolist (v (explode (args 0) 2))
        (setf (v 1) (add-c (eval $it)))
        (if (list? (v 0))
            (push (transpose v) res -1)
          (push v res -1)))
      (flat res)))
    '_vars))

(define-macro (mvpsetq)
  (letex (_args (cons 'psetq (mvbind-c (args))))
    _args))

 補助関数mvbind-c を使って、見通しを良くしているつもりです(笑)。本当は、別の目論見もあったのですが(汗)。マクロの説明の前に動作を見てもらいましょう。
 例によって、展開式を表示させます。

> (mvpsetq x 1 (z w) (list 3 4) y 2)
(psetq x 1 z 3 w 4 y 2)
> (let ((w 0) (x 1) (y 2) (z 3)) (mvpsetq (w x) (list 'a 'b) (y z) (list w x)))
(psetq w 'a x 'b y 0 z 1)

 どうです、所望の展開になっているでしょう。もちろん、展開式用のカンマを外して、実行すれば、

> (let ((w 0) (x 1) (y 2) (z 3)) (mvpsetq (w x) (list 'a 'b) (y z) (list w x)) (list w x y z))
(a b 0 1)

 となります。values の代わりに list を使っているので、

> (let ((w 0) (x 1) (y 2) (z 3)) (mvpsetq (w x) '(a b) (y z) (list w x)) (list w x y z))
(a b 0 1)

 という形式でも使えます(笑)。
 これで、マクロmvdo を実装できます(hayashi と mappend は、newlisp-utility.lsp で定義してあります)。

(define-macro (mvdo)
  (letex (_init (flat (map first (args 0)))
          _initset (cons 'mvpsetq (mappend (hayashi select '(0 1)) (args 0)))
          _steps   (cons 'mvpsetq (mappend (hayashi select '(0 2)) (args 0)))
          _results (cons 'begin (rest (args 1)))
          _end-test (first (args 1))
          _body (cons 'begin (2 (args))))
     (local _init
       _initset
       (until _end-test
         _body
         _steps)
       _results)))

 あっけなく終わります。本書の動作例、

(mvdo ((x 1 (++ x))
      ((y z) (values 0 0) (list z x)))
      ((> x 5) (list x y z))
      (print (list x y z)))

 の結果は、

(1 0 0)(2 0 1)(3 1 2)(4 2 3)(5 3 4)(6 4 5)

 となります。
 そして、本書にはない(笑)、マクロmvsetq は

(define-macro (mvsetq)
  (dolist (v (explode (args) 2))
    (setf (v 1) (add-c (eval $it)))
    (if (list? (v 0))
        (eval (cons 'begin (map (curry append '(setq)) (transpose v))))
      (eval (cons 'setq v)))))

 となります。こちらは、マクロmvpsetq とうってかわって引数を順に評価していきます。引数を評価せずに受け取るためだけにマクロ機能を利用しています。Common Lispなら、マクロにする必要はないのですが(泣)。
 そして、マクロmvdo* は、

(define-macro (mvdo*)
  (letex (_init (flat (map first (args 0)))
          _initset (cons 'mvsetq (mappend (hayashi select '(0 1)) (args 0)))
          _steps   (cons 'mvsetq (mappend (hayashi select '(0 2)) (args 0)))
          _results (cons 'begin (rest (args 1)))
          _end-test (first (args 1))
          _body (cons 'begin (2 (args))))
   (let _init
     _initset
     (until _end-test
       _body
       _steps)
     _results)))

 となります。マクロmvdo の mvpsetq が、mvsetq に変わっただけですけどね。mvsetq と mvpsetq の実装で苦労した分、mvdo と mvdo* は楽に実装できたってことです(笑)。
 さて、動作例

(mvdo* ((x 1 (++ x))
       ((y z) (list 0 0) (list z x)))
       ((> x 5) (list x y z))
       (print (list x y z)))

 の結果は、

(1 0 0)(2 0 2)(3 2 3)(4 3 4)(5 4 5)(6 5 6)

 となり、所望のリストを得ます。
 また、関数shuffle は使っていませんが、面白そうなので実装してみました(defun、null と t は、newlisp-utility.lsp で定義してあります)。

(defun shuffle (x y)
  (cond ((null x) y)
        ((null y) x)
        (t (append (list (first x) (first y))
                   (shuffle (rest x) (rest y))))))

 動作は、

> (shuffle '(a b c) '(1 2 3 4))
(a 1 b 2 c 3 4)

 となります。

 さて、第11章 古典的なマクロ もいよいよ、最後、マクロの必要性 です。
 関数版if は、こうなります。

(defun fnif (test then else)
  (if test
      (then)
    (if else (else))))

 そうすれば、

(if (rich) (employ-lisper) (write-script))

 は、

(fnif (rich)
      (fn () (employ-lisper))
   (fn () (write-script)))

 と書けます(笑)。こんな例よりも、本書にある 引数の式の中身を切り分けたり,引数として渡された変数を束縛するためにはマクロが必要になる ということは、newLISPでも同じで、重要です。そして、反復構造についても、同様ですが、反復制御構造の豊富なnewLISP の方がマクロが軽くなるという点で有利かもしれませんね。
 さて、おまけに、newLISP には無い mapc を実装しましょう。

(defun mapc (f)
  (let (lsts (args))
    (dotimes (i (apply min (map length lsts)))
      (apply f (map (curry nth i) lsts)))))

 という風に関数で実装できます。
 動作は、

(mapc (fn (x y z) (print (list x y z)) nil)
      '(a b c d e)
      '(b c d)
      '(c d))

 が、

(a b c)(b c d)nil

 となります。

 第11章 古典的なマクロ まとめです。

  • newLISPには、反復構造制御文が豊富にあるので、do が必要になることは、めったに、ありません。
  • with-系マクロのエラー回避には、catch & throw が使えます。
  • newLISP の組込 or、and には、apply を適用できます。
  • Common Lispでは、マクロが必要なものでも、newLISP では、関数で済む場合があります。もちろん、その逆もあります。

 以上、如何でしょうか?

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 部の評価を一回で済ましています。

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

 以上、如何でしょうか?

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

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

 第11章 古典的なマクロ の始まりです。マクロの基礎講座が終わり、いよいよ Lispマクロの本番に突入です。

 先ずは、コンテキストの生成 から、“On Lisp” 本書の our-let の実装は、こうなります。

(define-macro (our-let)
; (our-let binds &body body)
  (letex (_body (append 
                  (list
                    (append
                      '(fn)
                      (list (map (fn (x) (if (list? x) (x 0) x)) (args 0)))
                      (1 (args))))
                  (map (fn (x) (if (list? x) (x 1) nil)) (args 0))))
    _body))

 さて、例によって、展開式を確認して見ましょう。

> (our-let ((x 1) (y 2) z ) (setq z (+ x y)) z)
((lambda (x y z) (setq z (+ x y)) z) 1 2 nil)

 結果は、見るまでもないですね。
 そして、変数を束縛するマクロの例 から二つの when系を。

(define-macro (when-bind)
;(when-bind (var expr) &body body)
  (letex (_var  (args 0 0)
          _expr (args 0 1)
          _body (append '(when) (list (args 0 0)) (1 (args))))
    (let (_var _expr)
      _body))) 

(define-macro (when-bind*)
; (when-bind* binds &body body)
  (if (null (args 0))
      (letex (_body (cons 'begin (1 (args)))) (begin _body))
    (letex (_var (args 0 0)
            _var1st (args 0 0 0)
            _body (append '(when-bind*)
                          (list (1 (args 0)))
                          (1 (args))))
      (let _var
        (if _var1st _body)))))

 when-bind はすでに紹介していますが、今回は、これで、newLISP にない関数find-if を記述します。もちろん、前に紹介した、find-if 最終形を使ってもかまいません。

(defun find-if (f lst)
  (when-bind (x (find nil lst (fn (x y) (f y)))) (nth x lst)))

 newLISP組込find は、リスト中、見つけた要素の位置を返すので、その値を when-bind で束縛して find-if を実現しています。そして、when-bind* の動作例です。( oddp は、newlisp-utility.lsp に定義してあります。)

(when-bind* ((x (find-if list? '(a (1 2) b)))
             (y (find-if oddp x)))
            (+ y 10))

 最初の展開式は、

(let (x (find-if list? '(a (1 2) b))) 
 (if x 
  (when-bind* ((y (find-if oddp x))) (+ y 10))))

 となり、さらに展開すると、

(let (y (find-if oddp x)) 
 (if y 
  (when-bind* () (+ y 10))))

 となります。
 さて、マクロwith-gensyms は、本書でもこれから度々登場します。しかし、すでに紹介したように、変数捕捉回避には、あまり意味を成しません。もちろん、意味が無いわけではなく、必要な場面もあるのですが、Common Lisp ほど必要としません。だから、実装しても、たぶん使わないでしょう。前置きが長くなりましたが、実装例です。

(define-macro (with-gensyms)
; (with-gensyms syms &body body)
(letex (_vars (map (fn (s) (list s '(gensym))) (args 0))
        _body (cons 'begin (1 (args))))
   (let _vars _body)))

(define-macro (with-gensyms-ex)
; (with-gensyms syms &body body)
(letex (_vars (map (fn (s) (list s '(gensym))) (args 0))
        _body (cons 'begin (1 (args))))
   (letex _vars _body)))

 マクロ用なので、letバージョンと letexバージョンがあります。(gensym は、newlisp-utility.lsp に定義してあります。)
 動作はというと、先ず、let バージョンは、

(with-gensyms (s0 s1)
  (println (list s0 s1))
  (println (list 's0 's1)) nil)

 の結果が

(gensym1 gensym2)
(s0 s1)
nil

 となります。with-gensyms を with-gensyms-ex に変えて実行すると、

<(nil nil)
(gensym3 gensym4)
nil

 です。 let バージョンは、説明要りませんよね。 letex バージョンの一行目は、gensym で作られた変数には、何も入っていないので nil です。二行目は、Common Lisp だと、

`(print (list ',s0 ',s1))

 に相当します。この例と、マクロpsetq の実装例で、使い方の見当はつくと思います。
 書き忘れましたが、このマクロwith-gensyms 系は、たぶん、マクロ本体には記述できません。展開式側には書けるのですが。おそらく使うとしたら、補助関数においてでしょう(汗)。いずれにしろ、変数捕捉回避には、あまり意味ありませんからね。
 さて、コンテキストの生成 の最後、condlet です。

(define-macro (condlet)
; (condlet clauses &body body)
  (let (_bodfn (gensym)
        _vars (map (fn (v) (cons v (gensym)))
                     (unique (map first (mappend rest (args 0))))))
    (letex (_f _bodfn
            _var (map first _vars)
            _condbody (append '(cond) (map (fn (cl) (condlet-clause _vars cl _bodfn)) (args 0)))
            _body (cons 'begin (1 (args))))
      (labels ((_f _var _body))
        _condbody)))) 

(defun condlet-clause (vars cl bodfn)
  (list (first cl) (list 'let (map rest vars)
                     (list 'let (condlet-binds vars cl)
                       (append (list bodfn) (map last vars)))))) 

(defun condlet-binds (vars cl)
  (map (fn (bindform)
         (if (consp bindform)
             (cons (last (assoc (first bindform) vars))
                        (rest bindform))))
         (rest cl)))

 本書のように、補助関数を使っています。いつも思うのですが、本書マクロ例のマクロ本体と補助関数の切り分けは、絶妙ですね。本当に参考になります。使用しているunique は、Common Lisp の remove-duplicates に相当する newLISP組込関数です。mappend は、もちろん、本書に出てきた関数です。labels と共に newlisp-utility.lsp に定義してあります。
 さて、動作例、 ( t は、newlisp-utility.lsp で true に定義しています。)

(condlet (((= 1 2) (x (print 'a)) (y (print 'b)))
          ((= 1 1) (y (print 'c)) (x (print 'd)))
          (t       (x (print 'e)) (z (print 'f))))
          (list x y z))

 の展開式はこうなります。

(labels ((gensym5 (x y z) 
   (begin 
    (list x y z)))) 
 (cond 
  ((= 1 2) 
   (let ((gensym6) (gensym7) (gensym8)) 
    (let ((gensym6 (print 'a)) (gensym7 (print 'b))) 
     (gensym5 gensym6 gensym7 gensym8)))) 
  ((= 1 1) 
   (let ((gensym6) (gensym7) (gensym8)) 
    (let ((gensym7 (print 'c)) (gensym6 (print 'd))) 
     (gensym5 gensym6 gensym7 gensym8)))) 
  (t 
   (let ((gensym6) (gensym7) (gensym8)) 
    (let ((gensym6 (print 'e)) (gensym8 (print 'f))) 
     (gensym5 gensym6 gensym7 gensym8))))))

 このマクロは、マクロpsetq と同様、newLISP でも、gensym が必要となるマクロです。
 ところで、newLISP では、未定義の変数は、全て nil になります。
 したがって、newLISP では、補助関数 condlet-clause は、

(defun condlet-clause (vars cl bodfn)
  (list (first cl) (list 'let (condlet-binds vars cl)
                     (append (list bodfn) (map last vars)))))

 で十分です。
 この時の展開式は、

(labels ((gensym17 (x y z) 
   (begin 
    (list x y z)))) 
 (cond 
  ((= 1 2) 
   (let ((gensym18 (print 'a)) (gensym19 (print 'b))) 
    (gensym17 gensym18 gensym19 gensym20))) 
  ((= 1 1) 
   (let ((gensym19 (print 'c)) (gensym18 (print 'd))) 
    (gensym17 gensym18 gensym19 gensym20))) 
  (t 
   (let ((gensym18 (print 'e)) (gensym20 (print 'f))) 
    (gensym17 gensym18 gensym19 gensym20)))))

 となります。Common Lisp では、実行すると、gensym20 の未定義エラーになります。
 どちらが望ましいか? 私は、newLISP 流を採りますが(笑)。

 with-系マクロ からは次回に。

 以上、如何でしょうか?

UTF-8 版 newLISP.dll を Visual C++ で使う

 前回は、newLISP.dll をコンソール アプリケーションで使いました。
 Visual C++(私の使っているのは、Express Edition) のコンソール アプリケーションには、Win32 の Win32 コンソール アプリケーション (前回のコンソール アプリケーション)の他に、CLR コンソール アプリケーション があります。
 何が違うかというと、日本語コードが UTF-8 になります。
 Visual C++ の開発環境で、

新規作成 → 新しいプロジェクト → CLR → CLR コンソール アプリケーション

 という風に進めて、新規プロジェクト CLR-newLISP を作成すると、

// CLR-newLISP.cpp : メイン プロジェクト ファイルです。

#include "stdafx.h"

using namespace System;

int main(array<System::String ^> ^args)
{
    Console::WriteLine(L"Hello World");
    return 0;
}

 といった具合にテンプレートが出てきます。
 CLR コンソール アプリケーション だと、見ての通り、文字列に String が使えます。
 日本語版Visual C++ の String の文字コードは、UTF-8 です。
 つまり、UTF-8版newlisp.dll を使うには、最適(笑)!
 ということで、以下コードです。

// CLR-newLISP.cpp : メイン プロジェクト ファイルです。

#include "stdafx.h"
#include <windows.h>
using namespace System;
using namespace System::Text;
using namespace System::Runtime::InteropServices;

	int String2char(String^ str, char* text)
	{
		Encoding^ utf8 = Encoding::GetEncoding(L"UTF-8");
		array<Byte>^ utf8Array;//
		utf8Array = utf8->GetBytes(str);
		Marshal::Copy(utf8Array, 0, (IntPtr)text, utf8Array->Length);
		text[utf8Array->Length] = '¥0';
		return utf8Array->Length;
	}
	String^ char2String (char* text) {
		int len = strlen(text);
		Encoding^ utf8 = Encoding::GetEncoding(L"UTF-8");
		array<Byte>^ utf8Array = gcnew array<Byte>(len);
		array<Char>^ utf8Chars;
		Marshal::Copy((IntPtr)text, utf8Array, 0, len);
		utf8Chars = utf8->GetChars(utf8Array);
		return gcnew String( utf8Chars);
	}
#define MAXBYTES	512
typedef int (__stdcall *newlispAPI)(IN LPCSTR script);

int main(array<System::String ^> ^args)
{
	String^	readdata;
	static newlispAPI newlispEvalStr = NULL;
	char script[MAXBYTES];
	char* res;
	int len;
	HMODULE hnewLISP = LoadLibrary(TEXT("newlisp.dll"));
	if (hnewLISP) {
	    Console::WriteLine(L"Hello newLISP World");
		newlispEvalStr = (newlispAPI)GetProcAddress(hnewLISP, "newlispEvalStr");
		Console::Write("> ");
		while ((readdata = Console::ReadLine()) != "(exit)") {
			len = String2char(readdata, script);
			res = (char *)newlispEvalStr((LPCSTR) script);
			Console::Write(char2String(res) + "> ");
		}
		Console::WriteLine("Press Enter key!");
		Console::ReadLine();
		if (hnewLISP) FreeLibrary(hnewLISP);
	} else {
		Console::WriteLine("newlisp.dll is not found.");
		Console::WriteLine("Press Enter key!");
		Console::ReadLine();
	}
	return 0;
}

 コードの解説は、、、ここは、newLISP の blog なので、割愛(笑)。
 これをコンパイルして実行すると

 こんな感じ。もちろん、UTF-8版newlisp.dll を用意しておく必要があります。
 newLISP インストール・ディレクトリに PATH が通っているなら、CLR-newLISP.exe と同じディレクトリに置いておく必要があります。
 これなら、Windows 環境の newLISP で普通に UTF-8 が使えます。
 なんせ Windows 環境の コンソール(DOS窓)は、Shift-JIS コードが標準ですから、UTF-8版newlisp.exe では、うまく日本が使えませんでした。chcp とかも試したのですが、、、
 しかし、これからは、Windows でも、UTF-8版newLISP が使える?
 それなら、Linux 用コードと分けなくて済む?(笑)

 以上、如何でしょうか?

newLISP.dll を C で使う

 Windows では、実行ファイル newlisp.exe の他に newlisp.dll があります。
 Unix の newlisp.so には、C 言語からの呼び出し例がマニュアルに載っていますが、newlisp.dll の項目 には、C 言語からの呼び出し例は載っていません。
 そこで、作ってみました(笑)。

 コンパイラが bcc の場合、

/* libdemo.c - demo for importing newlisp.dll
 *
 * use:
 *
 *    libdemo "(+ 3 4)"
 *    libdemo "(symbols)"
 *
 */
#include <stdio.h>
#include <windows.h>

typedef int (__stdcall *newlispAPI)(IN char* script);

int main(int argc, char* argv[])
{
	HMODULE hLibrary;
	newlispAPI func;

	if ((hLibrary = LoadLibrary("newlisp.dll")) == 0) {
	    printf("cannot import library\n");
		exit(-1);
	}

	func = (newlispAPI)GetProcAddress(hLibrary, "newlispEvalStr");

 	if (argc > 1) {
		printf("%s\n", argv[1]);
		printf("%s\n", func(argv[1]));
	}

	return(0);
}

 マニュアルにある Unix 版とほぼ同じ動作ですが、コマンドライン引数も出力するようにしてあります。
 また、引数は、"(ダブル・クォート)で囲みます。

 ついでに、Visual C++ の場合、こうなります。

#include "stdafx.h"
#include <stdio.h>
#include <windows.h>

typedef int (__stdcall *newlispAPI)(IN LPCSTR script);

int main(int argc, char* argv[])
{
	HMODULE hLibrary;
	newlispAPI func;

	if ((hLibrary = LoadLibrary(L"newlisp.dll")) == 0) {
	    printf("cannot import library\n");
		exit(-1);
	}

	func = (newlispAPI)GetProcAddress(hLibrary, "newlispEvalStr");

 	if (argc > 1) {
		printf("%s\n", argv[1]);
		printf("%s\n", func((LPCSTR) argv[1]));
	}

	return(0);
}

 キャストが微妙に違っています(笑)が、基本動作は同じです。

 さて、newlisp.dll の組込シンボルを symbols 使って見てみると、

Class
Tree
module

 の三つがありません。いずれも、予約変数または関数で、newlisp.exe にはあります。
定義がマニュアルにありますので、困ることはないでしょうが、ご使用の際は、ご注意を。

 以上、如何でしょうか?

マクロ と macro (その2)

 前回の“マクロ と macro”の続きです。と言っても、今回は、macro.lspmacro に関してのみです。

 macro の欠点として applymap が使えないことを挙げましたが、実は他にもあるのです。

 述部を引数にする関数、例えば、組込exists 等にも使えません。
(consp は、newlisp-utility.lspに定義してあります)

> (exists list? '(a (1 2) b))
(1 2)
> (map consp '(a (1 2) b))
((and (list? 'a) (true? 'a)) (and (list? '(1 2)) (true? '(1 2))) (and (list? 'b) 
  (true? 'b)))
> (map-M consp '(a (1 2) b))
(nil true nil)
> (exists consp '(a (1 2) b))
a

 組込exists は、Common Lisp の find-if に相当する述部です。
 上記例の exists と consp の組み合わせの戻り値が、引数リストの第一項目になっています。これは、exists の動作内で consp をリストの第一項目 a に対して適用した時、

(and (list? 'a) (true? 'a))

 と展開されますが評価されず、nil 以外なので、exists は、第一項目を返すわけです。
 それでは、map-M や apply-M のように exists-M を用意する、、、という訳には行きません(汗)。
 残念ながら、これは諦めるしかありません。
 consp のような述部は、macro しない方が良いようです。
 newlisp-utility.lsp の consp の定義も

(define (consp L) (and (list? L) (true? L)))

 このように、関数に戻すことにしましょう。
 以上、如何でしょうか?

マクロ と macro

 前回で“newLISP で On Lisp する”も Lisp マクロの基礎講座を終え、いよいよ Lisp マクロの本番となります(笑)。

 さて、マクロと言えば、本ブログでは、マクロと macro の二つの表記を使っています。
 マクロの方は、いわゆる fexpr(オペランドが評価されずに渡される関数)を指しています。“On Lisp” 本書のマクロも同じです。
 それに対して、macro は、macro.lsp で導入される rewrite macros の方を指しています。
 と言っても、あくまでも、本ブログでの使い方ですので、お間違え無く。
 読み込み時にオーバヘッドが生じるものの、早くて便利な macro
 ただし欠点もあります。applymap が使えないこと。
 例えば、よく使う i+ に対して、applymap を使うと、

> i+
(lambda-macro (X) (expand '(+ X 1)))
> (i+ 1)
2
> (apply i+ '(1))
(+ 1 1)
> (map i+ '(1 2 3))
((+ 1 1) (+ 2 1) (+ 3 1))

 このように、展開はされるのですが、評価されません。
 newLISP で On Lisp する...第5章(その2) 関数を合成する で、macro 対応と称して funcall-M を用意したのは、そのためです。
 現在、newlisp-utility.lsp に定義してある macro は、

> macro:macro-list
((i+ *) (i- *) (consp *) (mklist *) (aif *))

 です。aif を除けは、map は使いたくなるものです。そこで、funcall-M になぞらえて、map-M と apply-M を用意しました(笑)。

(define-macro (map-M)
  (letex (_func (cons 'map (args))) 
    (map eval _func)))

(define-macro (apply-M)
  (letex (_func (cons 'apply (args))) 
    (eval _func)))

 これで、よく使う i+ も map できます。

> (map-M i+ '(1 2 3))
(2 3 4)
> (map-M i- '(1 2 3))
(0 1 2)
> (map-M consp '(1 () (1) nil))
(nil nil true nil)
> (map-M mklist '(1 (1) nil))
((1) (1) (nil))

 もちろん、apply も、

> (apply-M i+ '(3))
4

 こんな感じ。さすがに、aif には、使えませんが(汗)。
 funcall-M のように MACRO? を使って macro 判定はしていないので、普通の関数には使えません、あしからず。

 以上、如何でしょうか?

newLISP で On Lisp する...第10章

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

 第10章 マクロのその他の落し穴 です。

 評価の回数 は Common Lisp では、検討が必要ですが、newLISP では、ほとんど必要ありません。なぜなら、すでに紹介したスタイルでマクロを書けば、newLISP のマクロで引数を評価するのは、letex 内だけになるから。Common Lisp のように、ループの中で繰り返し引数が評価される展開式を意図せず書くことにはならないでしょう(笑)。それでも、“On Lisp”本書にある マクロの引数は式であって値ではないことを忘れてはいけない は、newLISP にとっても、忘れてはいけないことです。

 評価の順番 は、newLISP でも左から右へ順に評価されます。

> (setq x 10)
10
> (+ (setq x 3) x)
6
> (let ((x 1)) (for (i x (setq x 13)) (print i)))
1234567891011121313

 上記例の for は、newLISP組込です。 もちろん、適切に定義されています(笑)。

 関数によらないマクロの展開 にあるような意図せず周囲に影響を与える(副作用のこと)ようなマクロは、newLISP では、書きにくいものです。newLISP 組込関数で破壊的な関数は、20あまり。そして、Common Lisp の nconc みたい使える破壊的関数extend が破壊するのは、第一引数のみです。
 また、マクロは破壊的になっても、それを使う関数が、破壊的になることは、まれです。例えば、newLISP組込reverse は、破壊的関数です。

(defun test-f (lst)
  (reverse lst))

(define-macro (test-m)
; (test-m lst)
  (letex (_lst (args 0))
    (reverse _lst)))

 これらの動作は、

> (setq x (sequence 1 10))
(1 2 3 4 5 6 7 8 9 10)
> (test-f x)
(10 9 8 7 6 5 4 3 2 1)
> x
(1 2 3 4 5 6 7 8 9 10)
> (test-m x)
(10 9 8 7 6 5 4 3 2 1)
> x
(10 9 8 7 6 5 4 3 2 1)

 このように、マクロは破壊的ですが、関数は非破壊になります。これは、関数の場合、引数に渡される変数が、コピーされたものだからです。そういう意味では newLISP は、“On Lisp” の意図に沿った言語なのかもしれません。
 “On Lisp”本書の apply の例も、

> (defun et-al () (extend (args) (list 'et 'al)))
(lambda () (extend (args) (list 'et 'al)))
> (et-al 'smith 'jones)
(smith jones et al)
> (setq greats '(leonardo michelangelo))
(leonardo michelangelo)
> (apply et-al greats)
(leonardo michelangelo et al)
> greats
(leonardo michelangelo)

 となります。また、&rest に対しての例でも

(define-macro (echo)
  (letex (_body (extend (args) (list 'amen)))
    '_body))

(defun foo () (echo x))

 として、実行すると、

> echo
(lambda-macro () 
 (letex (_args (args)) (extend '_args (list 'amen))))
> foo
(lambda () (echo x))
> (foo)
(x amen)
> (foo)
(x amen)

 と全く問題になりません。うっかり、自己書き換えを行うスクリプトにはならないのです。

 第10章の最後 再帰 では、nth と or の実装例から
(defun、labels、car、cdr は、newlisp-utility.lsp に定義してあります)、

(define-macro (nthd)
; (nthd n lst)
  (letex (_n (args 0)
          _lst (args 1))
    (nth-fn _n _lst))) 
(defun nth-fn (n lst)
  (if (= n 0)
    (lst 0)
    (nth-fn (- n 1) (rest lst)))) 

(define-macro (nthe)
; (nthe n lst)
  (let (_num (eval (args 0))
        _lst (eval (args 1)))
    (letex (_value
             (labels 
               ((nth-in (n lst)
                  (if (= n 0)
                      (car lst)
                    (nth-in (- n 1) (cdr lst)))))
               (nth-in _num _lst)))
      _value)))

 最初の例は、特に説明は要らないですね。二番目の例では、マクロ labels を使っています。以前、再帰のマクロを実装した時labels はふさわしくないとして、内部関数定義にdefine を使いました。今回は、あえて使っています。使えたのは、letex 内の定義で使って、そこで完了させているからです。そのため、予め let 文で引数を評価して渡しています。つまり、変数_value には、内部関数nth-in で評価された値が入ります。ここまでやると、マクロの意味があまり無いような気がしますが(笑)。

(define-macro (ora)
  (letex (_ora-body (or-expand (args)))
      _ora-body)) 
(defun or-expand (_args)
  (if (null? _args)
      nil
    (let (_sym (gensym))
      (append '(let)
              (list (list _sym  (first _args)))
              (list (list 'if _sym 
                              _sym
                            (or-expand (rest _args)))))))) 
(define-macro (orb)
  (if (null? (args))
      nil
      (letex (_sym (gensym)
              _arg (first (args))
              _recv (cons 'orb (rest (args))))
        (let (_sym _arg)
          (if _sym
              _sym
              _recv)))))

 マクロora では、補助関数or-expand が、展開式を返すだけでから、

(define-macro (ora)
  (or-expand (args)))

 とすると(i+ は、newlisp-utility.lsp に定義してあります)、

> (ora nil '() (i+ 1))
(let (gensym28 nil) 
 (if gensym28 
  gensym28 
  (let (gensym29 '()) 
   (if gensym29 
    gensym29 
    (let (gensym30 (+ 1 1)) 
     (if gensym30 
      gensym30 nil))))))

 こんな感じで、展開式が出てくるだけです。それ故に letex文が必須です。
 マクロora では、評価する前に全ての評価対象が展開されますが、マクロorb は、展開式の評価の際、再び、マクロorb が呼び出されます。効率的には、評価対象が真になった時点で展開が終わるマクロorb の方が有利です。

 第10章 マクロのその他の落し穴 のまとめです。

  • newLISP の式の評価は、左から右へ順に評価されます。
  • newLISP では、意図しない副作用をもたらすマクロは、書きにくい。

 以上、如何でしょうか?