SICP 読み (197) 4.2.2 遅延評価の解釈系
なんか知らんが動いた。基本的な理解は間違っていなかった模様。評価器のソースが微妙だったのかもしれません。allcode なソレを使ってます。
とりあえず、(quote (1 2 3)) という式は (cons 1 (cons 2 (cons 3 '()))) を actual-value したソレを戻す、という形です。cons は actual-value されたら
(procedure (m) (m x y) <environment>)
みたいな形のリスト (手続き) になります。環境については、例えば最初のナニであれば x には delay された 1、y には delay された (cons 2 (cons 3 '())) が束縛されている状態になっているハズ。
もう少し追試が必要かと思いますが修正部分と試験を以下に。
(define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((quoted? exp) (text-of-quotation exp env)) ;; change ((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)) ((application? exp) ; clause from book (apply (actual-value (operator exp) env) (operands exp) env)) (else (error "Unknown expression type -- EVAL" exp)))) (define (text-of-quotation exp env) (define (make-cons exp) (if (null? (cdr exp)) (list 'cons (car exp) (cdr exp)) (list 'cons (car exp) (make-cons (cdr exp))))) (let ((target (cadr exp))) (if (pair? target) (actual-value (make-cons target) env) target)))
試験が以下。
#!/usr/bin/env gosh (use test.unit) (require "ch4-leval") (define-test-suite "4.2.2" ("4.33 (1)" ("text-of-quotation" (let ((env (setup-environment))) (actual-value '(define (cons x y) (lambda (m) (m x y))) env) (actual-value '(define (car z) (z (lambda (p q) p))) env) (actual-value '(define (cdr z) (z (lambda (p q) q))) env) (assert-equal 1 (text-of-quotation '(quote 1) env)) (assert-equal 1 (actual-value '(quote 1) env)) (assert-equal 'procedure (car (text-of-quotation '(quote (1 2 3)) env))) (assert-equal '(m) (cadr (text-of-quotation '(quote (1 2 3)) env))) (assert-equal 1 (car (quote (1 2 3)))) (assert-equal 2 (car (cdr (quote (1 2 3))))) (assert-equal 3 (car (cdr (cdr (quote (1 2 3)))))) (assert-equal '() (cdr (cdr (cdr (quote (1 2 3)))))) ) ) ("cons list" (let ((env (setup-environment))) (actual-value '(define (cons x y) (lambda (m) (m x y))) env) (actual-value '(define (car z) (z (lambda (p q) p))) env) (actual-value '(define (cdr z) (z (lambda (p q) q))) env) (assert-equal 1 (actual-value '(car (cons 1 2)) env)) (assert-equal 2 (actual-value '(cdr (cons 1 2)) env)) ) ) ) )
てーか、まだ (1 2 3 (4 5) 6) みたいなソレには対応してないな、多分。