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) みたいなソレには対応してないな、多分。