読者です 読者をやめる 読者になる 読者になる

kb84tkhrのブログ

何を書こうか考え中です

Scheme手習い(21) eval、またはvalue、またはmeaning(2)

いよいよ関数適用に入ります

(define function-of car)
(define arguments-of cdr)
(define *application
  (lambda (e table)
    (ls-apply (meaning (function-of e) table)
           (evlis (arguments-of e) table))))

(define evlis
  (lambda (args table)
    (cond ((null? args) (quote ()))
          (else (cons (meaning (car args) table) 
                      (evlis (cdr args) table))))))

リストのcarを評価して返された関数を、リストのcdrを評価して返された引数リストに適用します
applyという関数はすでに存在してて定義できないのでls-applyという名前にしてます

(define primitive?
  (lambda (l) (eq? (first l) (quote primitive))))
(define non-primitive?
  (lambda (l) (eq? (first l) (quote non-primitive))))
(define ls-apply
  (lambda (fun vals)
    (cond ((primitive? fun) (apply-primitive (second fun) vals))
          ((non-primitive? fun) (apply-closure (second fun) vals)))))

primitiveな関数だったらapply-primitiveを、
non-primitiveな関数であればapply-closureを呼びます
(second fun)は適用しようとしている関数、valsは引数リストです

まずはprimitiveな関数の処理から

(define apply-primitive
  (lambda (name vals)
    (cond ((eq? name (quote cons)) (cons (first vals) (second vals)))
          ((eq? name (quote car)) (car (first vals)))
          ((eq? name (quote cdr)) (cdr (first vals)))
          ((eq? name (quote null?)) (null? (first vals)))
          ((eq? name (quote eq?)) (eq? (first vals) (second vals)))
          ((eq? name (quote atom?)) (:atom? (first vals)))
          ((eq? name (quote zero?)) (zero? (first vals)))
          ((eq? name (quote add1)) (add1 (first vals)))
          ((eq? name (quote sub1)) (sub1 (first vals)))
          ((eq? name (quote number?)) (number? (first vals))))))

ほとんどの関数は対応する関数を呼んでいるだけです
atom?の処理だけ別の関数を呼んでいます

(define :atom?
  (lambda (x)
    (cond ((atom? x) #t)
          ((null? x) #f)
          ((eq? (car x) (quote primitive)) #t)
          ((eq? (car x) (quote non-primitive)) #f)
          (else #f))))

atomなはずのprimitiveな関数は、*const(primitive <関数>)というリストに
置き換えられてしまっているためその場合分けをしています
non-primitiveな関数の判定はどう見ても不要ですがなにかを暗示しているんでしょうか
primitiveを判定したんだからnon-primitiveも、くらいの話?

> (value '(cons 1 (quote ())))
(1)
> (value '(add1 1))
2

動きました
condの例ももうちょっとそれっぽくすることができます

> (value '(cond ((null? (quote (a))) #f)
                (else #t)))
#t

ここからが本丸(自分がやりたい順に進めてます)
変数とλ式クロージャを一気に導入します
ほぼ三位一体
まずは*lambdaから

(define *lambda
  (lambda (e table)
    (build (quote non-primitive)
           (cons table (cdr e)))))

なにかごたいそうなことをするのかと思ったらこれだけ
現時点のテーブルとλ式のcdrをリストにして取っておくだけです

だから(mk-length mk-length)を評価すると無限に評価が終わらないときでも
(lambda (x) ((mk-length mk-length) x))はすぐに評価が終わる、というわけです

> (value '(lambda (n) (add1 n)))
(non-primitive (() (n) (add1 n)))
> (value '(lambda (hoge) (hage hige)))
(non-primitive (() (hoge) (hage hige)))
> (value '(lambda (x) ((mk-length mk-length) x)))
(non-primitive (() (x) ((mk-length mk-length) x)))

mk-lengthが定義されている必要すらありません

ここで保存した、現時点のテーブルとλ式のcdr、つまり引数リストと関数本体を
まとめてクロージャと呼びます
(lambda ...)を評価するとクロージャが返されることになります

クロージャからテーブル、引数リスト、関数本体を取り出す関数を定義します

(define table-of first)
(define formals-of second)
(define body-of third)

(ここで使うためにthirdを定義してたのか)

次に、クロージャを評価する関数を用意します

(define apply-closure
  (lambda (closure vals)
    (meaning (body-of closure)
             (extend-table (new-entry (formals-of closure) vals)
                           (table-of closure)))))

クロージャを評価するには、以下のような処理を行います

  1. クロージャの引数リストと、引数の値のリストからエントリを作る
  2. 作ったエントリをクロージャのテーブルに追加する
  3. 追加してできたテーブルを利用してクロージャの本体部分を評価する

これでやっと識別子と値が結び付けられるようになりました
なぜテーブルでは名前と値のペアのリストを持つのではなく
名前のリストと値のリストのペアを持つようにするのか少し疑問でしたが
引数リストをそのまま使いたいからということのようです

識別子を評価するには単にテーブルを名前で検索するだけ
lookup-in-tableの出番です

(define *identifier
  (lambda (e table)
    (lookup-in-table e table initial-table)))

initial-tableは次のとおりです。

(define initial-table
  (lambda (name)
    (car (quote ()))))

どう見てもエラーです
ありがとうございました

いつ、これは使われますか。

テーブルを最後まで検索したけれども名前が見つからなかったときですね

使われないことを祈りましょう。どうしてだと思いますか?

valueで評価している式が誤っているから、ってことでいいんでしょうか

あえてエラーを起こすくらいしか評価を途中で止める方法がないので
何かエラーを起こす式を書いただけで
式には別に意味はない?

> (value '((lambda (n) (add1 x)) 1))
mcar: contract violation

たぶんエラーメッセージはRacket特有

さてそれはともかく、これで関数適用も動くようになりました
動きを追ってみます

  (value '((lambda (n) (add1 n)) 1))
= (meaning '((lambda (n) (add1 n)) 1) '())
= (*application '((lambda (n) (add1 n)) 1) '())
= (ls-apply (meaning '(lambda (n) (add1 n)) '()) (evlis '(1) '()))
= (ls-apply (meaning '(lambda (n) (add1 n)) '()) '(1))
= (ls-apply (*lambda '(lambda (n) (add1 n)) '()) '(1))
= (ls-apply '(non-primitive (() (n) (add1 n))) '(1))
= (apply-closure '(() (n) (add1 n)) '(1))
= (meaning '(add1 n) (extend-table '((n) (1)) '()))
= (meaning '(add1 n) '(((n) (1))))
= (*application '(add1 n) '(((n) (1))))
= (ls-apply (meaning 'add1 '(((n) (1)))) (evlis '(n) '(((n) (1)))))
= (ls-apply '(primitive add1) (evlis '(n) '(((n) (1)))))
= (ls-apply '(primitive add1) (cons (meaning 'n '(((n) (1)))) '()))
= (ls-apply '(primitive add1) (cons (*identifier 'n '(((n) (1)))) '()))
= (ls-apply '(primitive add1) (cons (lookup-in-table 'n '(((n) (1))) initial-table) '()))
= (ls-apply '(primitive add1) '(1))
= (apply-primitive 'add1 '(1))
= 2

もう少しテーブルを育ててみます

  (value '((lambda (x) ((lambda (y) (cons x y)) (quote ()))) 1))
= (meaning '((lambda (x) ((lambda (y) (cons x y)) (quote ()))) 1) '())
= (ls-apply (meaning '(lambda (x) ((lambda (y) (cons x y)) (quote ()))) '())
            (evlis '(1) '()))
= (ls-apply '(non-primitive (() (x) ((lambda (y) (cons x y)) (quote ()))))
            '(1))
= (meaning '((lambda (y) (cons x y)) (quote ())) '(((x) (1))))
= (ls-apply (meaning '(lambda (y) (cons x y)) '(((x) (1))))
            (evlis '((quote ())) '(((x) (1)))))
= (ls-apply '(non-primitive ((((x) (1))) (y) (cons x y))) '(()))
= (meaning '(cons x y) '(((y) (())) ((x) (1))))
= (ls-apply (meaning 'cons '(((y) (())) ((x) (1))))
            (evlis '(x y) '(((y) (())) ((x) (1)))))
= (ls-apply '(primitive cons) '(1 ()))
= (cons 1 '())
= '(1)

クロージャの説明抜きで出てきたコレも今なら説明がつくでしょうか

(define eq?-c
  (lambda (a)
    (lambda (x)
      (eq? x a))))
(define eq?-salad (eq?-c 'salad))

> (eq?-salad 'salad)
#t
> ((eq?-c 'salad) 'salad)
#t

ただしdefineがないので例によってlambdaで名前をつけます
eq-2?というのは、ふたつの要素が等しいかどうかを返す関数の引数のひとつに2を入れたもの
つまり引数が2と等しいかどうかを返す関数です

((lambda (eq-c?)
   ((lambda (eq-2?) 
     (eq-2? 2))
   (eq-c? 2)))
 (lambda (a)
   (lambda (x)
     (eq? x a))))

追いかけます

  (value '((lambda (eq-c?) ((lambda (eq-2?) (eq-2? 2)) (eq-c? 2)))
           (lambda (a) (lambda (x) (eq? x a)))))
= (meaning '((lambda (eq-c?) ((lambda (eq-2?) (eq-2? 2)) (eq-c? 2)))
             (lambda (a) (lambda (x) (eq? x a))))
           '())
= (meaning '((lambda (eq-2?) (eq-2? 2)) (eq-c? 2))
           '(((eq-c?) ((non-primitive (() (a) (lambda (x) (eq? x a))))))))
= (meaning '(eq-2? 2)
           '(((eq-2?) ((non-primitive ((((a) (2))) (x) (eq? x a)))))
             ((eq-c?) ((non-primitive (() (a) (lambda (x) (eq? x a))))))))
= (meaning '(eq? x a) '(((x) (2)) ((a) (2))))
= #t

eq-2?(eq? x a)a2を入れたものであるということがそのまま表現されています
defineでいったんひとくぎり付くところはちょっと表現できてません
説明がついたかというと微妙

これで終わりですか。

はい。疲れました。

疲れました

でも、(define ...)はどうなのでしょう。

再帰はYコンビネータによって得られるので、必要はありません。

> (value
   '(((lambda (le)
        ((lambda (mk-length)
           (mk-length mk-length))
         (lambda (mk-length)
           (le (lambda (x)
                 ((mk-length mk-length) x))))))
      (lambda (length)
        (lambda (l)
          (cond ((null? l) 0)
                (else (add1 (length (cdr l))))))))
     '(1 2 3)))
⇛ 3

Yコンビネータによる変形を行うと、インタプリタ上でインタプリタを走らせることが可能であるということですか。

はい。でもそんなに悩まないでください。

やれっていってるんでしょうか

else

はい。もう宴会の時間です。