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)))))
クロージャを評価するには、以下のような処理を行います
これでやっと識別子と値が結び付けられるようになりました
なぜテーブルでは名前と値のペアのリストを持つのではなく
名前のリストと値のリストのペアを持つようにするのか少し疑問でしたが
引数リストをそのまま使いたいからということのようです
識別子を評価するには単にテーブルを名前で検索するだけ
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)
のa
に2
を入れたものであるということがそのまま表現されています
defineでいったんひとくぎり付くところはちょっと表現できてません
説明がついたかというと微妙
これで終わりですか。
はい。疲れました。
疲れました
でも、
(define ...)
はどうなのでしょう。
> (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
はい。もう宴会の時間です。