SICP 読み (140) 4.1.2 式の表現
昨晩、微妙なまま力尽きた模様。続きを。
lambda 関連
試験を追加。
("lambda" ("lambda (1)" (let ((l '(lambda (x y) (* x y)))) (assert-equal '(x y) (lambda-parameters l)) (assert-equal '((* x y)) (lambda-body l)) ) ) ("lambda (2)" (let ((l '(lambda (x y) (* x y) (+ x y)))) (assert-equal '(x y) (lambda-parameters l)) (assert-equal '((* x y) (+ x y)) (lambda-body l)) ) ) ("make-lambda (1)" (let ((l (make-lambda '(x y) '(+ (* x y) (+ x y))))) (assert-equal '(x y) (lambda-parameters l)) (assert-equal '(+ (* x y) (+ x y)) (lambda-body l)) ) ) ("make-lambda (2)" (let ((l (make-lambda '(x y) '((* x y) (+ x y))))) (assert-equal 'lambda (car l)) (assert-equal '(x y) (lambda-parameters l)) (assert-equal '((* x y) (+ x y)) (lambda-body l)) ) )
うーん。どんどん試験を書こう。
if 関連
("if" ("if (1)" (let ((l '(if (= x 1) x (- x 1)))) (assert-equal '(= x 1) (if-predicate l)) (assert-equal 'x (if-consequent l)) (assert-equal '(- x 1) (if-alternative l)) ) ) ("if (2)" (let ((l '(if (= x 1) x))) (assert-equal '(= x 1) (if-predicate l)) (assert-equal 'x (if-consequent l)) (assert-equal 'false (if-alternative l)) ) ) )
何故にここだけ quote な false を戻すんだろうか。
make-if
make-if 微妙。必ず alternative なソレを渡さないといけないのか。
("make-if" ("make-if (1)" (let ((l (make-if '(= x 1) 'x '(- x 1)))) (assert-equal '(= x 1) (if-predicate l)) (assert-equal 'x (if-consequent l)) (assert-equal '(- x 1) (if-alternative l)) ) ) ("make-if (2)" (let ((l (make-if '(= x 1) 'x 'false))) (assert-equal '(= x 1) (if-predicate l)) (assert-equal 'x (if-consequent l)) (assert-equal 'false (if-alternative l)) ) ) )
begin
last-exp? の取り扱いが微妙に感じる。
("begin" ("begin (1)" (let ((l '(begin x y z))) (assert-equal 'x (first-exp (begin-action l))) (assert-equal 'y (first-exp (rest-exps (begin-action l)))) (assert-equal 'z (first-exp (rest-exps (rest-exps (begin-action l))))) (assert-false (last-exp? (begin-action l))) (assert-false (last-exp? (rest-exps (begin-action l)))) (assert-true (last-exp? (rest-exps (rest-exps (begin-action l))))) ) ) ("sequence->exp" (let ((l (sequence->exp '(x y z)))) (assert-equal 'begin (car l)) (assert-equal 'x (first-exp (begin-action l))) (assert-equal 'y (first-exp (rest-exps (begin-action l)))) (assert-equal 'z (first-exp (rest-exps (rest-exps (begin-action l))))) (assert-true (last-exp? (rest-exps (rest-exps (begin-action l))))) ) ) )
application
うーん。なんか機械的にヤッツケてしまってる感満点だなぁ。
("application" ("application (1)" (let ((l '(car x))) (assert-equal 'car (operator l)) (assert-equal '(x) (operands l)) ) ) ("application (2)" (let ((l '(cons x (cons y z)))) (assert-equal 'cons (operator l)) (assert-equal '(x (cons y z)) (operands l)) (assert-equal 'x (first-operand (operands l))) (assert-equal '(cons y z) (first-operand (rest-operands (operands l)))) (assert-false (no-operands? (operands l))) (assert-false (no-operands? (rest-operands (operands l)))) (assert-true (no-operands? (rest-operands (rest-operands (operands l))))) ) ) )
cond
cond の書き方ってどうだったか。たまたま sequence->exp 手続きが見えるので以下。
(define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq))))
cdr が条件式なソレですね。cond-clauses で取り出せるのが以下。これが clause か。
(((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))
clauses から要素を取り出す手続きが無いな、って cond は if に変換されるのか。とりあえず cond 関連の試験を書いとこう。 expand-clauses はその後。
("cond" ("cond" (let ((clauses '(((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq))))) (let ((l (cons 'cond clauses))) (assert-equal clauses (cond-clauses l)) (assert-false (cond-else-clause? (car clauses))) (assert-false (cond-else-clause? (cadr clauses))) (assert-true (cond-else-clause? (caddr clauses))) (assert-equal '(null? seq) (cond-predicate (car clauses))) (assert-equal '(seq) (cond-actions (car clauses))) ) ) ) )
expand-clauses
cond の試験に追加する形で以下。
("expand-clauses" (assert-equal 'false (expand-clauses '())) (assert-error (lambda () (expand-clauses '((else (x)) ((= x 1) (y)))))) (let ((l '(cond ((last-exp? exps) (eval (first-exp exps) env)) (else (eval (first-exp exps) env) (eval-sequence (rest-exps exps) env))))) (let ((if-S '(if (last-exp? exps) (eval (first-exp exps) env) (begin (eval (first-exp exps) env) (eval-sequence (rest-exps exps) env))))) (assert-equal if-S (expand-clauses (cond-clauses l))))) (let ((l '(cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq))))) (let ((if-S '(if (null? seq) seq (if (last-exp? seq) (first-exp seq) (make-begin seq))))) (assert-equal if-S (expand-clauses (cond-clauses l))))) )
cond->if もやっとくか。
("cond->if" (let ((l '(cond ((last-exp? exps) (eval (first-exp exps) env)) (else (eval (first-exp exps) env) (eval-sequence (rest-exps exps) env))))) (let ((if-S '(if (last-exp? exps) (eval (first-exp exps) env) (begin (eval (first-exp exps) env) (eval-sequence (rest-exps exps) env))))) (assert-equal if-S (cond->if l)))) (let ((l '(cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq))))) (let ((if-S '(if (null? seq) seq (if (last-exp? seq) (first-exp seq) (make-begin seq))))) (assert-equal if-S (cond->if l)))) )
eval もなんとかなるかと思いきや、env が何とかならんとどうにもならん。問題 4.3 の書き換えは別途きちんとやりたい、という事で以降の問題に着手予定。