Geek-Side

Resource > SICP Exersise 4_3

Exercise 4.3:

Exercise 2.73も参照
 (define (eval exp env)
   (cond ((self-evaluating? exp) exp)
 	((variable? exp) (lookup-variable-value exp env))
 	((quoted? exp) (text-of-quotation exp))
 	((get 'eval (car exp)) (cdr exp) env)
 	((application? exp)
 	 (apply (eval (operator exp) env)
 		(list-of-values (operands exp) env)))
 	(else
 	 (error "Unknown expression type -- EVAL" exp))))
 
 (define (install-eval-package)
   (define (tagged-list? exp tag)
     (if (pair? exp)
 	(eq? (car exp) tag)
 	false))
   ;; assignment
   (define (eval-assignment exp env)
     (set-variable-value! (assignment-variable exp)
 			 (eval (assignment-value exp) env)
 			 env)
     'ok)
   (define (assignment-variable exp) (cadr exp))
   (define (assignment-value exp) (caddr exp))
   ;; define
   (define (eval-definition exp env)
     (define-variable! (definition-variable exp)
       (eval (definition-value exp) env)
       env)
     'ok)
   (define (definition-variable exp)
     (if (symbol? (cadr exp))
 	(cadr exp)
 	(caadr exp)))
   (define (definition-value exp)
     (if (symbol? (cadr exp))
 	(caddr exp)
 	(make-lambda (cdadr exp)   ; formal parameters
 		     (cddr exp)))) ; body
   ;; if
   (define (eval-if exp env)
     (if (true? (eval (if-predicate exp) env))
 	(eval (if-consequent exp) env)
 	(eval (if-alternative exp) env)))
   (define (if-predicate exp) (cadr exp))
   (define (if-consequent exp) (caddr exp))
   (define (if-alternative exp)
     (if (not (null? (cdddr exp)))
 	(cadddr exp)
 	'false))
 
   ;; cond
   (define (cond-clauses exp) (cdr exp))
   (define (cond-else-clause? clause)
     (eq? (cond-predicate clause) 'else))
   (define (cond-predicate clause) (car clause))
   (define (cond-actions clause) (cdr clause))
   (define (cond->if exp)
     (expand-clauses (cond-clauses exp)))
   (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))
 	      (make-if (cond-predicate first)
                           (sequence->exp (cond-actions first))
                           (expand-clauses rest))))))
   (define (make-if predicate consequent alternative)
               (list 'if predicate consequent alternative))
   (define (sequence->exp seq)
     (cond ((null? seq) seq)
 	  ((last-exp? seq) (first-exp seq))
 	  (else (make-begin seq))))
   (define (last-exp? seq) (null? (cdr seq)))
   (define (first-exp seq) (car seq))
   
   (define (make-begin seq) (cons 'begin seq))
   
   (put 'eval 'set! eval-assignment)
   (put 'eval 'define eval-definition)
   (put 'eval 'lambda (lambda (exp env) (make-procedure (lambda-parameters exp)
                                                 (lambda-body exp)
                                                 env)))
   (put 'eval 'if eval-if)
   (put 'eval 'begin (lambda(exp env) (eval-sequence (begin-actions exp) env)))
   (put 'eval 'cond (lambda(exp env) (eval (cond->if exp) env)))
   'done)
 (install-eval-package)