value関数（完結）

一応今回で「The Little Schemerの勉強垂れ流し日記」は完結。
残るアクションは1つ。
ということで、今回は＊application関数をば。定義は以下。

;; アクション本体
(define *application
  (lambda (e table)
    (_apply (meaning (function-of e) table)
           (evlis (argument-of e) table))))

(meaning (function-of e) table)で関数を作って、evlisで引数全部評価して、そいつら使って関数適用（apply）しているわけね。
関数適用する前に、引数の値が全部決まってなくちゃいけないので、evlisで評価してる。
んで、その他諸々の補助関数は以下。

;; 第1引数が(primitive 関数名)または(non-primitive closure-record)
;; 第2引数が引数のリスト
(define _apply
  (lambda (fun vals)
    (cond
      ((primitive? fun)
       (apply-primitive (second fun) vals))
      ((non-primitive? fun)
       (apply-closure (second fun) vals)))))

;; 関数と引数を取り出す
(define function-of car)
(define argument-of cdr)

;; 引数で受け取ったリストの要素を全て評価して、リストで返す関数
(define evlis
  (lambda (elements table)
    (cond
      ((null? elements) '())
      (else (cons (meaning (car elements) table)
                  (evlis (cdr elements) table))))))

;; primitiveな関数かどうか判断
(define primitive?
  (lambda (l) (eq? (first l) 'primitive)))

;; non-primitiveな関数かどうか判断
(define non-primitive?
  (lambda (l) (eq? (first l) 'non-primitive)))

;; primitiveな関数を適用
(define apply-primitive
  (lambda (name vals)
    (cond
      ((eq? name 'cons) (cons (first vals) (second vals)))
      ((eq? name 'car) (car (first vals)))
      ((eq? name 'cdr) (cdr (first vals)))
      ((eq? name 'null?) (null? (first vals)))
      ((eq? name 'eq?) (eq? (first vals) (second vals)))
      ((eq? name 'atom?) (_atom? (first vals)))
      ((eq? name 'zero?) (zero? (first vals)))
      ((eq? name 'add1) (add1 (first vals)))
      ((eq? name 'sub1) (sub1 (first vals)))
      ((eq? name 'number?) (number? (first vals))))))

;; 引数がアトムかどうか調べる。
;; ただし、引数がリストであっても、先頭のアトムがprimitiveかnon-primitiveの場合は#tを返す。
(define _atom?
  (lambda (e)
    (cond
      ((atom? e) #t)
      ((null? e) #f)
      ((eq? (car e) 'primitive) #t)
      ((eq? (car e) 'non-primitive) #t)
      (else #f))))

;; non-primitiveな関数適用
(define apply-closure
  (lambda (closure vals)
    (meaning (body-of closure)
             (extend-table
               (new-entry (formals-of closure) vals)
               (table-of closure)))))

...って、関数多すぎ。
primitiveな関数の適用（apply-primitive関数）は簡単なので割愛。

(value '(add1 1))

を手を動かしてやってみよう。

問題はapply-closure関数ですな。
今までは、テーブルから検索するばっかりで、テーブルはぜんぜん拡大しなかったけど、今回はさにあらず。

(formals-of closure)

で取得される仮引数名と、valsでもって新しいエントリを作って、そいつでテーブルを拡大（extend-tableしてる所）してる。
拡大されたテーブルでもって、さらにmeaning。検索範囲が広がったわけね。

んじゃ、

(value '((lambda (x) (add1 x)) 1))

を順を追ってやってみよう。まずは以下のように展開

(meaning '((lambda (x) (add1 x)) 1) '())

んで、さらに以下のように展開

((expression-to-action '((lambda (x) (add1 x)) 1))
 '((lambda (x) (add1 x)) 1))
 '())

んで、さらに以下のように展開

(*application '((lambda (x) (add1 x)) 1)) '())

んで、＊applicationを展開

(_apply
  (meaning (function-of '((lambda (x) (add1 x)) 1)) '())
  (evlis (arguments-of '((lambda (x) (add1 x)) 1)) '()))

んで、function-ofとarguments-ofを適用して

(_apply
  (meaning '(lambda (x) (add1 x)) '())
  (evlis '(1) '()))

んで、meaningとevlisを適用すると

(_apply
  ((expression-to-action '(lambda (x) (add1 x)))
   '(lambda (x) (add1 x))
   '())
  '(1))

アクションを決定して

(_apply
  (*lambda '(lambda (x) (add1 x)) '())
  '(1))

＊lambdaを展開して

(_apply
  '(non-primitive (() (x) (add1 x)))
  '(1))

んで、_applyを展開

(cond
  ((primitive? '(non-primitive (() (x) (add1 x))))
   (apply-primitive (second '(non-primitive (() (x) (add1 x)))) '(1))
  (non-primitive? '(non-primitive (() (x) (add1 x))))
   (apply-closure (second '(non-primitive (() (x) (add1 x)))) '(1)))

んで、こいつはnon-primitive?で捕捉されるので、

(apply-closure
  (second '(non-primitive (() (x) (add1 x))))
  '(1))

second取っ払って

(apply-closure
  '(() (x) (add1 x))
  '(1))

apply-closureを展開して

(meaning (body-of '(() (x) (add1 x)))
         (extend-table
           (new-entry (formals-of '(() (x) (add1 x))) '(1))
           '()))

body-of、extend-table適用して

(meaning '(add1 x) '(((x) (1))))

...と、こんな感じでnon-primitiveに関する部分はなくなった。
あとは適当にやってみてちょ。

大切なのは、面倒臭がらないこと。
ピンと来なかったら、実際に1ステップずつやってみる！これに限る。

んで、今回作ったvalue関数、どんだけすごいかって言うと、

(value
 '(((lambda (le)
      ((lambda (f) (f f))
       (lambda (f) (le (lambda (x) ((f f) x))))))
    (lambda (f)
      (lambda (l)
	(cond
	 ((null? l) 0)
	 (else (add1 (f (cdr l))))))))
   '(foo bar baz)))

なんていうYコンビネータ使った再帰関数もちゃんと動いた。

ただ、

(value '((lambda (x) (+ x x)) 5))

なんていうのは動きませんよ。
この処理系で「+」が定義されてないからね。
ってか、値や式に名前をつけるための関数（define的な関数）もないので、プリミティブとして「+」を定義しない限り、足し算するのさえもadd1を再帰させることになるから、Yが必要になってすんげぇ面倒。

このvalue関数に関するソースコードはid:kazu-yamamoto:20080402で公開されてるので、使わせて頂きましょう。

10章はテーブルの検索をやってたらLISPがいつの間にかできてた感じ。

あ…ありのまま 今　起こった事を話すぜ！

『おれはテーブルの検索をしていたと思ったら
いつのまにかScheme処理系ができていた』

な…　何を言ってるのか　わからねーと思うが
おれも何をされたのかわからなかった…

頭がどうにかなりそうだった…

The little schemer: なつたん

ほんとこんな感じ。

ということで、The Little Schemer読了。楽しかった。
The Ten Commandments覚えてないけど。
次はやっとGauche本へ。

The Little Schemer (The MIT Press)