newLISP で On Lisp する．．．第１５章（その１）

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

　第１５章 関数を返すマクロ は、関数の構築 から、汎用の関数生成マクロ を実装します。（gensym と labels は newlisp-utility.lsp に定義してあります。）

(define-macro (fn+ expr)
  (rbuild expr)) 

(defun rbuild (expr)
  (if (or (atom? expr) (lambda? expr))
      expr
    (if (= (first expr) 'compose)
        (build-compose (rest expr))
      (build-call (first expr) (rest expr))))) 

(defun build-call (op fns)
  (let (g (gensym))
  (letex (_g g
          _op op
          _fbody (cons op (map (fn (f) (list (rbuild f) g)) fns)))
    (fn (_g) _fbody)))) 

(defun build-compose (fns)
  (let (g (gensym))
    (letex (_g g
            _lbody (labels ((rec (_f)
                              (if _f 
                                  (list (rbuild (first _f))
                                        (rec (rest _f)))
                                g)))
                           (rec fns)))
      (fn (_g) _lbody))))

　newLISP では、fn は、lambda と同じなので、fn+ に改名してあります。
　動作は（oddp は newlisp-utility.lsp に定義してあります）、

> (define int-odd? (fn+ (and integer? oddp)))
(lambda (gensym7) (and (integer? gensym7) (oddp gensym7)))
> (map int-odd? '(2 3 'a))
(nil true nil)
> (define s2i+ (fn+ (compose list ++ int)))
(lambda (gensym9) (list (++ (int gensym9))))
> (map s2i+ '("2" "3" "14"))
((3) (4) (15))
> (define s2i+3 (fn+ (compose (fn (x) (+ 3 x)) int)))
(lambda (gensym10) ((lambda (x) (+ 3 x)) (int gensym10)))
> (map s2i+3 '("2" "3" "14"))
(5 6 17)
> 

　という風に関数が返り、実際に組み合わせの動作をします。newLISP組込int は、Common Lisp の truncate と同じように使えます。
　この関数を使えば、（identity と map1-n は onnewlisp.lsp に定義してあります。）

> (map (fn+ (and integer? oddp)) '(c 3 p 0))
(nil true nil nil)
> (map (fn+ (or integer? symbol?)) '(c 3 p 0.2))
(true true true nil)
> (map1-n (fn+ (if oddp ++ identity)) 6)
(2 2 4 4 6 6)
> (map (fn+ (list -- ++ ++)) '(1 2 3))
((0 1 2) (1 2 3) (2 3 4))
> 

　と、なります。
　newLISP 組込 ++ と -- は破壊的関数なので、最後の例のような動作をします。
　さて、今までの newlisp-utility.lsp では cdr を rest で置き換えていますが、今回から、次の定義を使います。

(define cdr (fn (lst) (or (rest lst) nil)))

　そして（consp と remove-if は newlisp-utility.lsp に定義してあります）、

> (remove-if (fn+ (or (and integer? oddp) (and consp cdr))) '(1 (a b) c (d) 2 3.4 (e f g)))
(c (d) 2 3.4)
> 

　ちなみに、cdr と newLISP組込rest の違いは、

> (map cdr '((a b) (a) ()))
((b) nil nil)
> (map rest '((a b) (a) ()))
((b) () ())
> 

　そして、newLISP では、nil と 空リスト () は別物なので、上記remove-if の使い方では、cdr が必要です。

　さて、関数を入れ子するよりも

> (fn+ (list (++ int)))
(lambda (gensym14) (list ((lambda (gensym15) (++ (int gensym15))) gensym14)))
> (fn+ (compose list ++ int))
(lambda (gensym16) (list (++ (int gensym16))))
> 

　compose を使った方が簡潔になるというのが、マクロfn+ のポイントでしょうか（笑）。

　ということで、切りが良いので、Cdr 部での再帰 からは、次回に。
　関数版に相当する 第５章 返り値としての関数 と同様、長丁場になります。

　以上、如何でしょうか？

newLISP で On Lisp する．．．第５章（その３）

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

　第５章 返り値としての関数 もその３です。
　今回は、Cdr 部での再帰 から。ちなみに、newLISP では、伝統的な car と cdr が無く、新しい仕様の first と rest のみとなっています。newLISP だから（笑）？　newlisp-utility.lsp に、その辺りを定義してあるので、本 blog では、当たり前のように使っていますけどね。
　前置きが長くなりましたが、関数lrec は、こうなります。（defun、null、labels は newlisp-utility.lsp に定義してあります）

(define functionp (fn (x) (or (lambda? x) (primitive? x))))
(defun lrec (rec-f base-f)
  (letex (rec rec-f
          base base-f)
    (labels ((self-r (lst)
                   (if (null lst)
                       (if (functionp 'base) (base) 'base)
                       (rec (car lst)
                            (fn () (self-r (cdr lst)))))))
      self-r)))

　関数functionp が、newLISPに無いので、最初に定義しています。あとは、今まで使った手法をそのまま使えます。なんといっても、labels が使えるのが楽です（笑）。また、現在のnewLISPでは、self は組込なので、self-r に変えてあります。
　動作はというと、（numberp、oddp は newlisp-utility.lsp に定義してあります）

> ((lrec (lambda (x f) (++ (f))) 0) '(1 2 3 4))
4
> ((lrec (lambda (x f) (or (numberp x) (f)))) '(1 2 3 4))
true
> ((lrec (lambda (x f) (and (oddp x) (f))) t) '(1 5 3 7))
true
> ((lrec (lambda (x f) (list x (f))) '(5 6)) '(1 2 3 4))
(1 (2 (3 (4 (5 6)))))
> 

　そして、lrec で表現された関数は、（evenp は newlisp-utility.lsp に定義してあります）

> ((lrec (fn (x f) (cons x (f))) '()) '(1 a 2 b))
(1 a 2 b)
> (defun adjoin (x lst) (if (find x lst) lst (cons x lst)))
(lambda (x lst) 
 (if (find x lst) 
  lst 
  (cons x lst)))
> ((lrec (fn (x f) (adjoin x (f))) '()) '(1 2 3 1 3 4))
(2 1 3 4)
> ((lrec (fn (x f) (if (evenp x) x (f)))) '(1 2 3))
2
> ((lrec (fn (x f) (or (evenp x) (f)))) '(1 2 3))
true
> ((lrec (fn (x f) (or (evenp x) (f)))) '(1 5 3))
nil
> 

　こんな感じでしょうか？
　lambda は、fn と書けるの楽です。
　関数adjoin は、newLISP には、無いので途中で定義しています。
　copy-list と remove-duplicates の動作例に空リスト '() が必要なのは、newLISPでは、nil と '() が別物だからです。いずれも、'() が無いと、戻りリストの最後に nil が入ります。

　そして、部分ツリーでの再帰 です。前にも言ったように、newLISP では、eq、eql、equal の区別が無いので、copy-list と copy-tree の結果の比較は無意味です。どっちみち両関数ともありませんけどね。ツリーとしてのリストとは、本書にある図とたぶん一緒です、nil が無い点を除けば。
　ですから、ツリーの葉を数える関数count-leaves
（atom は newlisp-utility.lsp に定義してあります）

(defun count-leaves (tree)
  (if (atom tree)
      1
      (+ (count-leaves (car tree))
         (or (if (cdr tree) (count-leaves (cdr tree)))
             0)))) ; orignal 1 ,but in newLISP there are no dotted pairs. 

　の動作は、

> (count-leaves '((a b (c d)) (e) f))
6
> 

　です。Common Lisp の場合と違って、アトムの数だけになります。何故って、関数count-leaves の最後の行の 1 を 0 に書き換えているからです（笑）。ここのカウントが nil の数になります。当然、newLISP では、0 でしょう、なんてね。 1 に戻せば、Common Lisp と同じ数が出ます。
　さて、関数flatten は、newlisp-utility.lsp を使えば、nconc を newLISP組込extendと置き換えるだけで、動きます。
　関数rfind-if は、

(defun rfind-if (f tree)
  (if (atom tree)
      (and ( f tree) tree)
      (or (rfind-if f (car tree))
          (if (rest tree) (rfind-if f (rest tree))))))  ; cdr -> rest at 2010/ 8/ 4 changed.

　いつものように、fn は f にして、funcall を外します。
　そして、動作は、

> (rfind-if (fint numberp oddp) '(2 (3 4) 5))
3
> 

　前回定義した fint との組み合わせも問題ありません。私の持っている“On Lisp”本書の動作例では、関数addp と記載されていますが、oddp に変えて試しています（笑）。
　次に、関数ttrav を定義します。

(defun identity (x) x)
(defun ttrav (rec-f (base-f identity))
  (letex (rec rec-f
          base base-f)
    (labels ((self-r (tree)
               (if (atom tree)
                   (if (functionp 'base) (base tree)
                       (MACRO?    'base) (eval (base tree))
                     'base)
                 (rec (self-r (car tree))
                      (if (rest tree) ; cdr -> rest at 2010/ 8/ 4 changed.
                          (self-r (rest tree)))))))
    self-r)))

　関数identity は、newLISP には、無いので、先に定義してあります。
　関数判定部分に MACRO? を追加しているのは、前回同様、macro 対応です。あとは、labels と letex のおかげで、ここですら、特筆すべきことが無いですね（笑）。
　では、動作を

> ((ttrav (lambda (l r) (+ l (or r 0))) 1) '((a b (c d)) (e) f))
6
> (define nconc extend)
extend
> ((ttrav nconc mklist) '(1 2 (3 4)))
(1 2 3 4)
> ((ttrav append list) '(1 2 (3 4)))
(1 2 3 4)

　関数mklist は、第４章（その２）にあり（newlisp-utility.lspにもあります）、nconc は newLISPで同等機能の extend に変えてあります。
　そして、関数trec 。

(defun trec (rec-f (base-f identity))
  (letex (rec rec-f
          base base-f)
    (labels
      ((self-r (tree)
         (if (atom tree)
             (if (functionp 'base) (base tree)
                 (MACRO?    'base) (eval (base tree))
               'base)
             (rec tree (fn () (self-r (car tree)))
                       (fn () (if (rest tree)  ; cdr -> rest at 2010/ 8/ 4 changed.
                                  (self-r (rest tree))))))))
      self-r)))

　動作は、

> ((trec (fn (o l r) (or (l) (r))) (fn (tree) (and (oddp tree) tree))) '(2 (3 4) 5))
3
> ((trec (lambda (o l r) (extend (l) (r))) mklist) '(a b (c d (e f) g h) i))
(a b c d e f g h i)
> ((trec (lambda (o l r) (append (l) (r))) list) '(a b (c d (e f) g h) i))
(a b c d e f g h i)

　と、いうところ。抽象化が進むにつれて、実行時の表記が面倒に思えてくるのは、私だけ？

　最後に、いつ関数を作るべきか 。単純に、クロージャを返す関数から始まり、合成、再帰による展開等を使って、より抽象化されたクロージャ生成関数へと進んできました。この抽象化していくとう考え方は、Lisp に限らず、プログラミングでは重要です。後は、それをどう実装するか？ Lisp は、それをクロージャを返す関数として実装できるすぐれものです。
　実行時のオーバーヘッド（関数生成にかかる時間）をどう考えるか？ CPU の性能アップはメモリ帯域と共に上がりっぱなしですからね（笑）。
　この章で見てきた抽象化への道筋は、おろそかには出来ません。

　さて、第５章のまとめです。

• newLISP でも、クロージャを返す関数は作れる。ただし、letex （ expand な部分） の使用が不可欠です。

　以上、如何でしょうか？

newLISP で On Lisp する．．．第５章（その２）

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

　第５章 返り値としての関数 。
　今回は、関数を合成する です。
まず、関数を合成する関数compose ですが、newLISP には reduce がありませんので定義します。

(define-macro (reduce)
; (reduce func list [bool-form-end] [exp-initial-value]) 
  (local (from-end initial-value)
    (if (> (length (args)) 2) (bind (2 (args)) true))
    (letex (_fn (args 0)
            _lst (args 1))
      (let (lst (if initial-value
                    (if from-end
                        (append _lst (list initial-value))
                      (cons initial-value _lst))
                  _lst))
        (cond ((empty? lst) (_fn nil))
              ((= (length lst) 1) (_fn (lst 0)))
              ((= (length lst) 2) (_fn (lst 0) (lst 1))) 
              (from-end (_fn (lst 0) (reduce _fn (rest lst) (from-end true))))
              (true (_fn (reduce _fn (chop lst)) (last lst))))))))

　以前書いた“newLISP で reduce する”の定義で、オプション名を指定する方です。
　そして、関数compose 。（defun は newlisp-utility.lsp に定義してあります）

(define butlast chop)
(defun identity (x) x)
(define (MACRO? f)
  (and (list? f) (macro? f) (= 'expand (nth '(1 0) f))))
(define (funcall-M) 
  (if (MACRO? (args 0)) (eval (args)) (args)))
(defun compose ()
  (let (_fns (args))
    (if _fns
        (letex (fn1 (last _fns)
                fns (butlast _fns))
          (fn () (let (_lst (args))
                   (eval
                        (reduce funcall-M 'fns
                           (from-end true)
                           (initial-value (apply fn1 _lst)))))))
      identity)))

　関数butlast は、newLISP では、組込関数chop に相当しますので、先頭で定義しています。前にも書いたように newLISP の last は last1 と同じ機能です。関数identity もないので、定義しておきます。MACRO? と funcall-M は、あとで解説します。
さて、動作です。（i+ は newlisp-utility.lsp に定義してあります）

> (compose list i+)
(lambda () 
 (let (_lst (args)) 
  (eval (reduce funcall-M '(list) (from-end true) (initial-value (apply (lambda-macro 
       (X) 
       (expand '(+ X 1))) _lst))))))
> ((compose list i+) 1)
(2)
> (defun find-if (f lst) (dolist (item lst (and (f item) item)))) 
(lambda (f lst) 
 (dolist (item lst (and (f item) item))))
> (compose i+ find-if)
(lambda () 
 (let (_lst (args)) 
  (eval (reduce funcall-M '((lambda-macro (X) (expand '(+ X 1)))) (from-end true) 
    (initial-value (apply (lambda (f lst) 
       (dolist (item lst (and (f item) item)))) _lst))))))
> ((compose i+ find-if) oddp '(2 3 4))
4

　関数find-if は、組込exists で代用してもよいのですが、ここでは、第４章（その１）の定義を使っています。
　二つの例で、'（アポストロフィ）の付けていないのに気付かれたでしょうか？
以前なら、' を付けても付けなくても動作します。しかし、現在の newLISP では、macro があります。
　' を付けた場合の展開されたクロージャを見てください。

> (compose 'i+ 'find-if)
(lambda () 
 (let (_lst (args)) 
  (eval (reduce funcall-M '(i+) (from-end true) (initial-value (apply find-if _lst))))))

' を付けると関数名（または、macro名）がそのままクロージャに入ります。しかし、付けないと、前の例のように、関数find-ifはλ式に展開されて入ります。そして、macro の i+ も展開されます。
　どういう事かというと、

> ((compose 'i+ 'find-if) oddp '(2 3 4))
(+ 3 1)

　macro 定義したものに ' を付けると、実行時に展開が評価される前の式で止まってしまうのです。
　従って、' を付けないの newLISP での流儀です。いまさら、macroの無い環境には戻れません（笑）。そして、macro を使っても動作しているのは、MACRO? と funcall-M を使って、macro を判定し、必要に応じて eval を追加しているからです。
　macro 対応なんて、“On Lisp”のスクリプトを記述するだけなら必要ないのですが、使えるスクリプトにしておきたいので。使うかどうかは、別ですが（笑）。

　また、関数compose は、わざわざ reduce を使わなくても、dolist を使って定義できます。

(defun compose ()
  (let (fns (reverse (butlast (args)))
        res (list 'apply (last (args)) '(args)))
    (dolist (f fns)
      (setq res (list 'funcall-M f res)))
    (letex (func res)
      (fn () (eval func)))))

　もちろん、macro 対応です。こちらの方が、すっきり見えるのは、まだ手続型から抜け切れていない証拠？（笑）
　さて、compose を使って、complement を定義してみましょう。

(defun complement (pred)
  (compose not pred))

　動作は、（oddp は newlisp-utility.lsp に定義してあります）

> (remove-if oddp (sequence 1 10))
(2 4 6 8 10)
> complement
(lambda (pred) (compose not pred))
> (remove-if (complement oddp) (sequence 1 10))
(1 3 5 7 9)

　と、こんな感じ。

　次の、関数生成方法のさらなる例 のスクリプトは、次のようになります。

(defun fif (if-f then-f (else-f nil))
  (letex (func1 if-f
          func2 then-f
          func3 else-f)
    (fn (x) (if (func1 x) (func2 x)
              (if func3 (func3 x)))))) 

(defun fint (f)
  (if (args)
      (letex (func f
              chain (apply fint (args)))
        (fn (x) (and (func x) (chain x))))
    (letex (func f)
      (fn (x) (func x)))))

(defun fun (f)
  (if (args)
      (letex (func f
              chain (apply fint (args)))
        (fn (x) (or (func x) (chain x))))
    (letex (func f)
      (fn (x) (func x)))))

　返り値のλ式に入れる関数は、letex で展開するのが、お約束。
　まずは、fif の例から、（type-of の定義は、こちらにあります。また、evenp は newlisp-utility.lsp に定義してあります））

> (map (fif numberp evenp) '(a 1 2))
(nil nil true)
> (map (fif number? evenp type-of) '(a 1 2))
("symbol" nil true)

　次に、fint の使用例を

> ((fint number?) 1)
true
> ((fint number?) a)
nil
> ((fint number? evenp) 1)
nil
> ((fint number? evenp) 2)
true
> ((fint number? evenp (fn (x) (> x 10))) 2)
nil
> ((fint number? evenp (fn (x) (> x 10))) 12)
true

　ざっと、こんなところ。fun は、and が or に変わっているだけなので、省略します。
　えっ、macro 対応？

(defun fif (if-f then-f (else-f nil))
  (letex (func1 if-f
          func2 then-f
          func3 else-f)
    (fn (x) (eval (if (func1 x) (funcall-M func2 x)
              (if func3 (funcall-M func3 x)))))))

(defun fint (f)
  (if (args)
      (letex (func f
              chain (apply fint (args)))
        (fn (x) (and (func x) (chain x))))
    (letex (func f)
      (fn (x) (eval (funcall-M func x))))))

(defun fun (f)
  (if (args)
      (letex (func f
              chain (apply fint (args)))
        (fn (x) (or (func x) (chain x))))
    (letex (func f)
      (fn (x) (eval (funcall-M func x))))))

　こんな感じでしょうか？

　残りの再帰に関する部分は、次回にまとめて。

　以上、如何でしょうか？