Archive for the ‘concnew’ Tag

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

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

 さて、第12章 汎変数 は、番外編を挟んで その1 の続きです(笑)。

 新しい ユーティリティ のインバージョンも、define-modify-macro のない newLISP では、自前で展開します(笑)。
 先ずは、汎変数に対して機能するマクロ から、(mappend は、newlisp-utility.lsp で定義してあります。)

(define-macro (allf)
; (allf val &rest args)
  (let (_val (args 0))
    (letex (_body (cons 'setf (mappend (fn (a) (list a _val)) (1 (args)))))
      _body)))

(define-macro (nilf)
; (nif (&rest args))
  (letex (_body (flat (list 'allf 'nil (args))))
    _body)) 

(define-macro (tf)
; (tf (&rest args))
  (letex (_body (flat (list 'allf 'true (args))))
    _body)) 

(define-macro (toggles)
; (toggles &rest args)
  (letex (_toggles (cons 'begin (map (fn (a) (list 'toggle a)) (args))))
    _toggles))

 “On Lisp”本書のマクロtoggle は、toggles と名前を変え、その1 で定義した

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

 を内部で使っています。
 動作は、

> (list a b c)
(nil nil nil)
> (allf 1 a b c)
1
> (list a b c)
(1 1 1)
> (nilf a b c)
nil
> (list a b c)
(nil nil nil)
> (tf a b c)
true
> (list a b c)
(true true true)
> (toggle b)
nil
> (list a b c)
(true nil true)
> (toggles a b c)
nil
> (list a b c)
(nil true nil)
> 

 こんな感じ。

 そして、 汎変数に対するリスト操作 は、

(define-macro (concf)
  (letex (_place (args 0)
          _obj (args 1))
    (setf _place (append $it _obj)))) 

(define-macro (conc1f)
  (letex (_place (args 0)
          _obj (args 1))
    (push _obj _place -1)   ; or (setf _place (append $it (list _obj)))
    ))

(define-macro (concnew)
  (letex (_place (args 0)
          _obj (args 1))
    (unless (find _obj _place)
      (push _obj _place -1) ; or (setf _place (append $it (list _obj)))
    )))

 となります。
 conc1f と concnew には、newLISP組込push を使っています。setf を使ったバージョンは、コメントにしてあります。お好みで、どうぞ。push の引数の最後の -1 は、push 先をリストの末尾に指定するインデックス機能です。これが使えるので、Common Lisp のように push して最後に reverse することは、newLISP ではしなくて済みます。しかも、先頭に付加するのと同じくらいの速さに最適化してある優れものです。もちろん、対の pop にもインデックス機能が使えます。
 動作は、

> (setq lst '(a (b 1) c))
(a (b 1) c)
> (concf lst '(2))
(a (b 1) c 2)
> (concf (lst 1) '(2))
(b 1 2)
> lst
(a (b 1 2) c 2)
> (conc1f lst 3)
(a (b 1 2) c 2 3)
> (conc1f (lst 1) 3)
(b 1 2 3)
> lst
(a (b 1 2 3) c 2 3)
> (concnew lst 2)
3
> lst
(a (b 1 2 3) c 2 3)
> (concnew lst 4)
(a (b 1 2 3) c 2 3 4)
> (concnew (lst 1) 3)
3
> lst
(a (b 1 2 3) c 2 3 4)
> (concnew (lst 1) 4)
(b 1 2 3 4)
> lst
(a (b 1 2 3 4) c 2 3 4)
> 

 こんな感じ。
 さて、newLISP の宣伝(pushpop)をしたところで、新たなる問題点です。
 concnew では、オブジェクトの有無を検索するために、変数_place が push (または setf)動作の前に評価されています。つまり、複数回の評価に関わる問題 が発生するということ。

> (setq lst '(a (b 1) (c 2)))
(a (b 1) (c 2))
> (let (i 0) (concnew (nth (++ i) lst) 2))
(c 2 2)
> lst
(a (b 1) (c 2 2))
> 

 concnew 以外は、$it の使用で評価を一回で済ませていましたが、こればっかりは、お手上げ?
 もちろん、そのなことはありません。

(define-macro (concnew)
  (letex (_place (args 0)
          _obj (args 1))
    (setf _place (let (_x $it)
                   (if (find _obj _x) _x
                     (append _x (list _obj)))))))

 と、定義すれば、

> (setq lst '(a (b 1) (c 2)))
(a (b 1) (c 2))
> (let (i 0) (concnew (nth (++ i) lst) 2))
(b 1 2)
> lst
(a (b 1 2) (c 2))
> (let (i 0) (concnew (nth (++ i) lst) 2))
(b 1 2)
> lst
(a (b 1 2) (c 2))
> 

 このように、複数回の評価に関わる問題 を回避できます。
 $itlet 文で変数 _x に割り当てているのは、評価に使う関数で $it を変更する関数が使われることを考えての記述です。今回のマクロでは、_x を $it で置き換えても動作します。
 さて、define-modify-macro がある Common Lisp の方が、この点では、一日の長があります。
 今回の勝負、どちらも一長一短で引き分け?(笑)

 更に複雑なユーティリティ は、次回に。

 以上、如何でしょうか?

広告