SICP 4.1.2 Representing Expressions
ノート
式の表現。
式を解釈して要素を取り出す部分と、要素分解された式を評価する部分とは分離する事が出来る。
tagged-list?は特定のシンボルから始まるリストかどうかをチェックする。
definition-variableはexpの第２要素がシンボルであれば基本構文なのでそのシンボル、シンボルではない場合はリストである（手続き定義の構文）とみなしてその第１要素。
definition-valueはexpの第２要素がシンボルであれば基本構文なので第３要素、シンボルではない場合はリストである（手続き定義の構文）とみなして第２要素のリストの第２要素以降を引数、第３要素を定義の本文とみなしてラムダ式として解釈する。
Lispのifは式なので条件部が真でも偽でも何かしら値を決める必要がある。Racketではelse部が無いとエラーだが、ここでの文法では許していて、その時の値は'falseとする。
Exercise 4.2
evalの定義にあるcondの条件達の中でプログラム本体かどうかチェックする部分を代入をチェックする部分より前に持って来た方が効率的であるとの主張。
a.
代入よりも先にプログラムかどうか解釈すると(set!
この式が代入として解釈される事は決して無い。
assignment?以降のタイプは全て解釈される事は無いのでdefineにしても同様。xと言うシンボルを探して普通は未定義でエラー。定義されていればその値と解釈される。3は3のまま。で最後にdefineと言う手続きを探しに行ってしまう。
b.
(define (application? exp) (tagged-list? exp 'call)) (define (operator exp) (cadr exp)) (define (operands exp) (cddr exp)) (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval (cond->if exp) env)) (else (error "Unknown expression type -- EVAL" exp))))
適当にスタブを作って、
(define (lookup-variable-value exp env) (display "(lookup-variable-value ")(display exp)(newline)) (define (eval-assignment exp env) (display "eval-assignment:")(display exp)(newline) 'ok) (define (eval-definition exp env) (display "eval-definition:")(display exp)(newline) 'ok)
実行すると
> (eval '(call func a b c) null) (lookup-variable-value func (lookup-variable-value a (lookup-variable-value b (lookup-variable-value c . . application: not a procedure; expected a procedure that can be applied to arguments given: #<void> arguments...: #<void> #<void> #<void> > (eval '(define val 1) null) eval-definition:(define val 1) 'ok > (eval '(func 1 2 3) null) . . Unknown expression type -- EVAL (func 1 2 3) >
ちゃんと評価出来る訳ではないが、手続き呼び出しとdefineが同居出来ている事が確認出来る。
Exercise 4.3
evalをデータ指向で再実装せよとの事だが、ディスパッチする部分のみを再実装する。
- タイプによってハンドラの引数が異なるが、これらは全てexpとenvに統一する。
- 取り敢えず全てのハンドラはeval-***に統一する
- evalは他にもタイプに応じた対応をしているが、application以外の対応に付いてはハンドラに任せる
- ここでのハンドラは呼ばれた事を表示するのみで何も仕事はしない
と言う方針にする。
テーブルは3.3.3のものをそのまま流用。ただしここでは第１キーが全てevalなので２次元テーブルになっている意味は無い。
#lang scheme (require r5rs) ;from section 3.3.3 (define (make-table) …（中略） (define eval-table (make-table)) (define get (eval-table 'lookup-proc)) (define put (eval-table 'insert-proc!))
コア部分。self-evaluatingとかvariableは仮想的にタグがある状態にすると統一的に扱える。3.3.3のテーブルにset-cdr!が存在するのでRacketモードではなくschemeモードでr5rsをrequireしているが、この状態ではevalは既定義でエラーとなるのでここでは単にevとする。
(define (tag exp) (cond ((pair? exp) (car exp)) ((or (number? exp) (string? exp)) 'self-evaluating) (else 'variable))) (define operator car) (define operands cdr) (define no-operands? null?) (define first-operand car) (define rest-operands cdr) (define (list-of-values exps env) (if (no-operands? exps) '() (cons (ev (first-operand exps) env) (list-of-values (rest-operands exps) env)))) (define (eval-application exp env) (display "(eval-application ")(display exp)(display " ")(display env)(display ")")(newline)) (define (ev exp env) (let ((defined-handler (get 'eval (tag exp)))) (if defined-handler (defined-handler exp env) (eval-application (ev (operator exp) env) (list-of-values (operands exp) env)) )))
後から登録する部分
(define (eval-variable exp env) (display "(eval-variable ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-quotation exp env) (display "(eval-quotation ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-assignment exp env) (display "(eval-assignment ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-definition exp env) (display "(eval-definition ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-if exp env) (display "(eval-if ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-lambda exp env) (display "(eval-lambda ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-begin exp env) (display "(eval-begin ")(display exp)(display " ")(display env)(display ")")(newline)) (define (eval-cond exp env) (display "(eval-cond ")(display exp)(display " ")(display env)(display ")")(newline)) (put 'eval 'self-evaluating (lambda (exp env) exp)) (put 'eval 'variable eval-variable) (put 'eval 'quote eval-quotation) (put 'eval 'set! eval-assignment) (put 'eval 'define eval-definition) (put 'eval 'if eval-if) (put 'eval 'lambda eval-lambda) (put 'eval 'begin eval-begin) (put 'eval 'cond eval-cond)
動作確認
> (ev 123 null) 123 > (ev "abc" null) "abc" > (ev 'a null) (eval-variable a ()) > (ev '(quote a b c) null) (eval-quotation (quote a b c) ()) > (ev '(set! a 10) null) (eval-assignment (set! a 10) ()) > (ev '(define b 10) null) (eval-definition (define b 10) ()) > (ev '(define (f x) (+ x 1)) null) (eval-definition (define (f x) (+ x 1)) ()) > (ev '(if (= a b) c d) null) (eval-if (if (= a b) c d) ()) > (ev '(lambda (x) (+ x 1)) null) (eval-lambda (lambda (x) (+ x 1)) ()) > (ev '(begin (display a)(newline)) null) (eval-begin (begin (display a) (newline)) ()) > (ev '(cond ((= a 1) 1)((= a 2) 2)(else 3)) null) (eval-cond (cond ((= a 1) 1) ((= a 2) 2) (else 3)) ()) > (ev '(a 1 2) null) (eval-variable a ()) (eval-application #<void> (1 2)) > (ev '(a b c) null) (eval-variable a ()) (eval-variable b ()) (eval-variable c ()) (eval-application #<void> (#<void> #<void>)) > (ev '((a) (b c) (d e f)) null) (eval-variable a ()) (eval-application #<void> ()) (eval-variable b ()) (eval-variable c ()) (eval-application #<void> (#<void>)) (eval-variable d ()) (eval-variable e ()) (eval-variable f ()) (eval-application #<void> (#<void> #<void>)) (eval-application #<void> (#<void> #<void>)) > (ev '((a) (if b (c) (d)) e) null) (eval-variable a ()) (eval-application #<void> ()) (eval-if (if b (c) (d)) ()) (eval-variable e ()) (eval-application #<void> (#<void> #<void>)) >
式のオペランドに式や条件分があってもちゃんと評価している。
Exercise 2.73との比較だが、2.73ではS式で表した数式を解釈していたが、ここではそのS式をLispプログラムとして解釈していて、evalの部分（Exercise 2.73ではderiv）は本質的には変わっていない。基本的には同じコアで、登録するハンドラによってどちらも扱える筈である。
Exercise 4.4
(define (eval exp env) (cond ((self-evaluating? exp) exp) 中略 ((cond? exp) (eval (cond->if exp) env)) ((and? exp) (eval-and exp env)) ((or? exp) (eval-or exp env)) ((application? exp) 以下略
(define (and? exp) (tagged-list? exp 'and)) (define (or? exp) (tagged-list? exp 'or)) (define (eval-and exp env) (define (eval-conditions exps env) (cond ((no-operands? exps) true) ((true? (eval (first-operand exps) env)) (eval-conditions (rest-operands exps) env)) (else false))) (eval-conditions (operands exp) env)) (define (eval-or exp env) (define (eval-conditions exps env) (cond ((no-operands? exps) false) ((true? (eval (first-operand exps) env)) true) (else (eval-conditions (rest-operands exps) env)))) (eval-conditions (operands exp) env))
テストする為に#tと#fを解釈出来る様にする。
(define (self-evaluating? exp) (cond ((number? exp) true) ((string? exp) true) ((boolean? exp) true) (else false)))
後は適当にスタブを作って。true?にログを仕込む。
(define (true? exp) (display "true? ")(display exp)(newline)(if exp true false))
実行結果
> (eval '(and #t #t #t #t) null) true? #t true? #t true? #t true? #t #t > (eval '(and #t #t #f #t) null) true? #t true? #t true? #f #f > (eval '(or #f #f #t #t) null) true? #f true? #f true? #t #t > (eval '(or #f #f #f #f) null) true? #f true? #f true? #f true? #f #f >
andでは#fが出て来た時点で、orでは#tが出て来た時点で評価が終わっている事が分かる。
次にandとorを書き換える実装。
(define (predicates exp) (cdr exp)) (define (and->if exp) (expand-and-conditions (predicates exp))) (define (expand-and-conditions preds) (if (null? preds) #t (make-if (car preds) (expand-and-conditions (cdr preds)) #f))) (define (or->if exp) (expand-or-conditions (predicates exp))) (define (expand-or-conditions preds) (if (null? preds) #f (make-if (car preds) #t (expand-or-conditions (cdr preds)))))
動作確認
> (expand-and-conditions '((= a 1) (= b 2))) '(if (= a 1) (if (= b 2) #t #f) #f) > (expand-and-conditions '((= a 1) (= b 2) (= c 3))) '(if (= a 1) (if (= b 2) (if (= c 3) #t #f) #f) #f) > (expand-or-conditions '((= a 1) (= b 2))) '(if (= a 1) #t (if (= b 2) #t #f)) > (expand-or-conditions '((= a 1) (= b 2) (= c 3))) '(if (= a 1) #t (if (= b 2) #t (if (= c 3) #t #f))) > (eval '(and #t #t #t #t) null) true? #t true? #t true? #t true? #t #t > (eval '(and #t #t #f #t) null) true? #t true? #t true? #f #f > (eval '(or #f #f #f #f) null) true? #f true? #f true? #f true? #f #f > (eval '(or #f #f #t #f) null) true? #f true? #f true? #t #t >
evel-ifのtrue?が必要な回数だけ呼ばれている。
Exercise 4.5
真っ先に気付くのは
そうすると
- 一つの式で（beginで囲む必要は無い）
- 先頭に1引数のlamba式
- lambda式の中身は
- 引数が真であればcond-actionの関数を引数に適用、
- 引数が偽であれば残りの(expand-cond rest)
- lambda式をcond-predecateの結果に適用
と言う形に展開しなければならない。=>形式ではない条件もあわせて考えると、全体をmake-ifの連鎖にするのではなくlambda式の内側に展開して行く形になる。
- 一つの式で（beginで囲む必要は無い）
- 先頭に1引数のlamba式
- lambda式の中身は
- 引数が真であれば
- cond-actionの先頭が=>であれば、cond-actionの関数を引数に適用（(list
<引数>)で形成） - cond-actionの先頭が=>でなければ、cond-actionそのまま（ここは元のsequene->expが必要）
- cond-actionの先頭が=>であれば、cond-actionの関数を引数に適用（(list
- 引数が偽であれば残りの(expand-cond rest)
- 引数が真であれば
- lambda式をcond-predecateの結果に適用
纏めると
(define (expand-clauses clauses) (if (null? clauses) 'false ; no else clause (let ((first (car clauses)) (rest (cdr clauses))) (if (cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last -- COND->IF" clauses)) (let ((action (cond-actions first))) (list (make-lambda '(result) (list (make-if 'result (if (cond-alternate-form? action) (list (cadr action) 'result) (sequence->exp action)) (expand-clauses rest)))) (cond-predicate first))))))) (define (cond-alternate-form? exp) (eq? '=> (car exp)))
make-lambdaが引数リストと本体をconsで繋いでしまうので、make-lambdaの引数にmake-ifの結果のリストを渡すと引数リストの続きになってしまう。なのでmake-ifの結果をもう一段listで囲む必要がある。
実行結果
> (expand-clauses '(((= a 1) 2) ((assoc 'b '((a 1) (b 2))) => cadr) (else (display "else")(newline)))) '((lambda (result) (if result 2 ((lambda (result) (if result (cadr result) (begin (display "else") (newline)))) (assoc 'b '((a 1) (b 2)))))) (= a 1)) >
Exercise 4.6
特別どうと言う事は無くExercise 4.5と同様make-lamdaを使ってlambda式とその呼び出しに展開する。
(define (eval exp env) 中略 ((cond? exp) (eval (cond->if exp) env)) ((and? exp) (eval (and->if exp) env)) ((or? exp) (eval (or->if exp) env)) ((let? exp) (eval (let->combination exp) env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp)))) 中略 (define (let? exp) (tagged-list? exp 'let)) (define (let-variables exp) (cadr exp)) (define (let-body exp) (cddr exp)) (define (let-parameters variables) (map car variables)) (define (let-arguments variables) (map cadr variables)) (define (let->combination exp) (cons (make-lambda (let-parameters (let-variables exp)) (let-body exp)) (let-arguments (let-variables exp))))
テストと実行結果。
> (let-variables '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline))) '((a 1) (b 2) (c (d 4))) > (let-body '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline))) '((display "body") (newline)) > (let-parameters (let-variables '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline)))) '(a b c) > (let-arguments (let-variables '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline)))) '(1 2 (d 4)) > (let->combination '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline))) '((lambda (a b c) (display "body") (newline)) 1 2 (d 4)) > (eval '(let ((a 1) (b 2) (c 4)) (display "body")(newline)) null) (make-procedure (a b c) ((display body) (newline)) . . Unknown procedure type -- APPLY #<void> >
make-procedureはスタブで、渡された引数を表示するだけ。手続きの呼び出しはまだ実装していないので現時点で最後まで評価は出来ない。
Exercise 4.7
letの場合、同時に定義した変数同士は参照出来ない。lambdaで実現した形で言うと、引数が呼び出し先の仮引数を参照する事になってしまうので実現不可能。これを参照可能にする為には左側から順番に一つずつletで定義して行く必要がある。
テキストの例は以下の様になっていれば良い。
(let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z))))
expand-let*を定義して再帰的にletを作って繋げて行く。問題は変数が無くなったらbodyを返す事になるが、このbodyは手続き呼び出しのリストで上位のletのブロックにconsで繋がれるべきなのに対し、入れ子のletを返す時にはリストの一つの要素として追加する（consを使っては駄目）な所。
expand-let*が返して来たリストをconsで繋ぐ事にすると、入れ子のletを返す時にはlet式を最初の要素に持つリストを返す必要があり、そうすると最上位のlet*->nested-letsではexpand-let*の結果に対してcarを取る必要がある。
(define (eval exp env) (cond ((self-evaluating? exp) exp) 中略 ((let? exp) (eval (let->combination exp) env)) ((let*? exp) (eval (let*->nested-lets exp) env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp)))) 中略 (define (let*? exp) (tagged-list? exp 'let*)) (define (let*->nested-lets exp) (car (expand-let* (let-variables exp) (let-body exp)))) (define (expand-let* variable-list body) (if (null? variable-list) body (list (cons 'let (cons (list (car variable-list)) (expand-let* (cdr variable-list) body))))))
テスト
> (let*->nested-lets '(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z))) '(let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z)))) > (let*->nested-lets '(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (display "body")(newline))) '(let ((x 3)) (let ((y (+ x 2))) (let ((z (+ x y 5))) (display "body") (newline)))) > (eval '(let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z)) null) (make-procedure (x) ((let ((y (+ x 2))) (let ((z (+ x y 5))) (* x z)))) . . Unknown procedure type -- APPLY #<void> >
例によってまだ最後までは評価出来ない。
evalがlet*を入れ子になったletに変換して再びevalを呼び出し、次にevalはletをlambdaを呼び出す式に変換して再びevalを呼び出す。letが実装されていればこれで十分評価出来、non-derivedな処理の必要は無い。
Exercise 4.8
自己参照する為にはletやlambdaではコンビネータを使ってややこしい事をしないと実現出来ないので、defineを使う。
(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))
は
(begin (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n) )
と展開される。名前付きletがdefine直後などsequenceを書ける所にあれば良いが、if節の場合もあり得るのでletと同様そこにsequenceを作らなければならないのでbeginで括る事にする。
(define (let->combination exp) (if (named-let? exp) (expand-named-let exp) (cons (make-lambda (let-parameters (let-variables exp)) (let-body exp)) (let-arguments (let-variables exp))))) (define (named-let? exp) (symbol? (named-let-name exp))) (define (named-let-name exp) (cadr exp)) (define (named-let-variables exp) (caddr exp)) (define (named-let-body exp) (cdddr exp)) (define (expand-named-let exp) (sequence->exp (list (cons 'define (cons (cons (named-let-name exp) (let-parameters (named-let-variables exp))) (named-let-body exp))) (cons (named-let-name exp) (let-arguments (named-let-variables exp))))))
動作確認
> (named-let? '(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) #t > (expand-named-let '(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) '(begin (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n)) > (let->combination '(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) '(begin (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n)) > (let->combination '(let ((a 1) (b 2) (c (d 4))) (display "body")(newline))) '((lambda (a b c) (display "body") (newline)) 1 2 (d 4)) > (eval '(let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) null) (make-procedure (a b count) ((if (= count 0) b (fib-iter (+ a b) a (- count 1)))) . . Unknown procedure type -- APPLY 1 >
Exercise 4.9
doループを実装してみる。
(do ((x 1 (inc! x)) (y 2 (inc! y))) ((>= x 100) x) (display x)(display y)(newline)))
こんなのが、名前付きletを使って
(let loop ((x 1) (y 2)) (if (>= x 100) x (begin (display x)(display y)(newline)(loop (inc! x) (inc !y)))))
こうなれば良さそう。
(define (eval exp env) (cond ((self-evaluating? exp) exp) 中略 ((let*? exp) (eval (let*->nested-lets exp) env)) ((do? exp) (eval (do->named-let exp) env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp)))) 中略 (define (do? exp) (tagged-list? exp 'do)) (define (do-bindings exp) (cadr exp)) (define (do-variables bindings) (map (lambda (b) (list (car b) (cadr b))) bindings)) (define (do-updates bindings) (map caddr bindings)) (define (do-predicate exp) (caaddr exp)) (define (do-value exp) (cadr (caddr exp))) (define (do-body exp) (cdddr exp)) (define (do->named-let exp) (list 'let 'loop (do-variables (do-bindings exp)) (make-if (do-predicate exp) (do-value exp) (sequence->exp (append (do-body exp) (list (cons 'loop (do-updates (do-bindings exp)))))))))
動作確認
> (define exp '(do ((x 1 (inc! x)) (y 2 (inc! y))) ((>= x 100) x) (display x)(display y)(newline))) > (do? exp) #t > (do-bindings exp) '((x 1 (inc! x)) (y 2 (inc! y))) > (do-bindings exp) '((x 1 (inc! x)) (y 2 (inc! y))) > (do-variables (do-bindings exp)) '((x 1) (y 2)) > (do-updates (do-bindings exp)) '((inc! x) (inc! y)) > (do-predicate exp) '(>= x 100) > (do-value exp) 'x > (do-body exp) '((display x) (display y) (newline)) > (do->named-let exp) '(let loop ((x 1) (y 2)) (if (>= x 100) x (begin (display x) (display y) (newline) (loop (inc! x) (inc! y))))) > (eval exp null) (make-procedure (x y) ((if (>= x 100) x (begin (display x) (display y) (newline) (loop (inc! x) (inc! y))))) . . Unknown procedure type -- APPLY 1 >
一応出来ていそう。
Exercise 4.10
到底使いやすいとは思えないが、例えば後置記法にしてifを実装してみる。ifを最後に持って来るだけで他の要素の順番はそのまま。
(define (tagged-list? exp tag) (cond ((not (pair? exp)) false) ((null? (cdr exp)) (eq? (car exp) tag)) (else (tagged-list? (cdr exp) tag)))) (define (if? exp) (tagged-list? exp 'if)) (define (if-predicate exp) (car exp)) (define (if-consequent exp) (cadr exp)) (define (if-alternative exp) (caddr exp))
この変更だけ。動作確認
> (tagged-list? '(if a b c) 'if) #f > (tagged-list? '(a b c if) 'if) #t > (eval '(#t 2 3 if) null) true? #t 2 > (eval '(#f 2 3 if) null) true? #f 3 >
妙な記法だが一応期待通り動作している。
