SICP 問題 4.33

遅延リストの実装に合わせて，quoteを遅延リストに対応させる．
(car '(a b c))で正しくaが表示できるようにする．

make-lambdaの(make-quote (car obj))のところ，始め(car obj)だけにしていたら，
数字ではうまくいくのに'(a b c)だとunbound variable: aとなる．
それならばと(list 'quote (car obj))とすると今度は(car '(1 2 3))が'1になってそれをさらにeval-quoteに渡すのでエラー．
make-quoteで数字とそれ以外を分けるようにしました．
(symbol? 1)でtrueが返ると思ってたのが間違っていました．
predicateを追加したらmake-quoteは(list 'quote obj)だけでよくなりました．

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (eval-quote exp env)) ;;eval-quoteに変更
        ((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))
        ((let? exp) (eval (let->combination exp) env))
        ((let*? exp) (eval (let*->nested-lets exp) env))
        ((letrec? exp) (eval (letrec->let exp) env))
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        ((and? exp) (eval-and exp env))
        ((or? exp) (eval-or exp env))
        ((application? exp)
         (my-apply (actual-value (operator exp) env)
                   (operands exp)
                   env))
        (else
         (error "Unknown expression type --EVAL" exp))))

(define (make-quote obj)
  (list 'quote obj))
(define (quote-body exp) (cadr exp))

(define (eval-quote exp env)
  (let ((obj (quote-body exp)))
    (cond ((null? obj) obj)
          ((symbol? obj) obj)
          ((number? obj) obj)
          (else (eval (quote->cons obj) env)))))

(define (quote->cons obj)
  (cond ((null? obj) (make-quote obj))
        ((symbol? obj) (make-quote obj))
        (else (list 'cons (make-quote (car obj))
                    (quote->cons (cdr obj))))))

test

;;; M-Eval input:
'(1 2 3)

;;; M-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; M-Eval input:
(car '(1 2 3))

;;; M-Eval value:
1

;;; M-Eval input:
(car (cdr '(1 2 3)))

;;; M-Eval value:
2

;;; M-Eval input:
'(a b c)

;;; M-Eval value:
(compound-procedure (m) ((m x y)) <procedure-env>)

;;; M-Eval input:
(car '(a b c))

;;; M-Eval value:
a

;;; M-Eval input:
(car (cdr '(a b c)))

;;; M-Eval value:
b

;;; M-Eval input:
(car '(a b c))

;;; M-Eval value:
a

;;; M-Eval input:
(cdr '(a))

;;; M-Eval value:
()

;;; M-Eval input:
(null? (cdr '(a)))

;;; M-Eval value:
#t

;;; M-Eval input:
(cdr '(a . b))

;;; M-Eval value:
b