work on metacircular evaluator

ch2/ex58.scm

@@ -36,21 +36,21 @@
         (else (list '+ a1 a2))))
 
 (define (sum? x)
-  (eq? '+ (operation expr)))
+  (eq? '+ (operation x)))
 
 (define (addend s)
   (define (iter e result)
     (if (eq? (car e) '+)
         result
-        (iter (cdr e) (append result (list (car expr))))))
-  (let ((result (iter e '())))
+        (iter (cdr e) (append result (list (car e))))))
+  (let ((result (iter s '())))
     (if (= (length result) 1)
         (car result)
         result)))
 
 (define (augend s)
-  (let ((result (cdr (memq '+ expr))))
-    (if (= (length result 1))
+  (let ((result (cdr (memq '+ s))))
+    (if (= (length result) 1)
         (car result)
         result)))
 
@@ -62,7 +62,7 @@
         (else (list '* m1 m2))))
 
 (define (product? x)
-  (eq? '* (operation expr)))
+  (eq? '* (operation x)))
 
 (define (multiplier p)
   (define (iter e result)

ch3/ex25.scm

@@ -0,0 +1,33 @@
+(define (lookup keys table)
+  (define (helper remaining last)
+    (cond ((null? remaining)
+           (cdr last))
+          (else
+           (let ((next (assoc (car remaining) (cdr last))))
+             (if next
+                 (helper (cdr remaining) next)
+                 #f)))))
+  (helper keys table))
+
+(define (insert! keys value table)
+  (define (helper remaining last)
+    (if (null? (cdr remaining))
+        (let ((record (assoc (car remaining) (cdr last))))
+          (if record
+              (set-cdr! record value)
+              (set-cdr! last
+                        (cons (cons (car remaining) value)
+                              (cdr last)))))
+        (let ((next (assoc (car remaining) (cdr last))))
+          (if next
+              (helper (cdr remaining) next)
+              (let ((new (list (car remaining))))
+                (set-cdr! last
+                          (cons new
+                                (cdr last)))
+                (helper (cdr remaining) new))))))
+    (helper keys table)
+  'ok)
+
+(define (make-table)
+  (list '*table*))

ch3/ex25.scm~

@@ -0,0 +1,36 @@
+(define (lookup key-1 key-2 table)
+  (let ((subtable
+         (assoc key-1 (cdr table))))
+    (if subtable
+        (let ((record
+               (assoc key-2 (cdr subtable))))
+          (if record
+              (cdr record)
+              #f))
+        #f)))
+
+(define (insert! key value table)
+  (let ((record (assoc key (cdr table))))
+    (if record
+        (set-cdr! record value)
+        (set-cdr! table (cons (cons key value)
+                              (cdr table)))))
+  'ok)
+
+(define (insert! key-1 key-2 value table)
+  (let ((subtable (assoc key-1 (cdr table))))
+    (if subtable
+        (let ((record (assoc key-2 (cdr subtable))))
+          (if record
+              (set-cdr! record value)
+              (set-cdr! subtable
+                        (cons (cons key-2 value)
+                              (cdr subtable)))))
+        (set-cdr! table
+                  (cons (list key-1
+                              (cons key-2 value))
+                        (cdr table)))))
+  'ok)
+
+(define (make-table)
+  (list '*table*))

ch4/evaluator-data-structures.scm

@@ -0,0 +1,51 @@
+;; conditionals
+;; if something is true it is not false
+(define (true? x)
+  (not (eq? x #f)))
+(define (false? x)
+  (eq? x false))
+
+;; procedures
+;; assumes that (apply-priitive-procedure) and (primitive-procedure?)
+;; exist
+;; NOT scheme standard, will be implemented later
+
+(define (make-procedure params body env)
+  (list 'procedure params body env))
+(define (compound-procedure? p)
+  (tagged-list? p 'procedure))
+(define (procedure-parameters p) (cadr p))
+(define (procedure-body p) (caddr p))
+(define (procedure-environment p) (cadddr p))
+
+;; MANIPULATION OF ENVIRONMENTS
+;;
+;; (lookup-variable-value var env)
+;; returns value bound to symbol var in environment env
+;; signals error if unbound
+;;
+;; (extend-environment variables values base-env)
+;; returns a new environment with a new frame where the list of
+;; variables is bound to the list of values sequentially, with an
+;; enclosing environment base-env
+;;
+;; (define-variable! var value env)
+;; adds to the first frame in evironment env a binding where var is
+;; assigned to value
+;;
+;; (set-variable-value! var value env)
+;; changes binding of variable var in environment env so variable is now
+;; bound to the new value
+;; signals error if unbound
+
+(define (enclosing-environment env) (cdr env))
+(define (first-frame env) (car env))
+(define the-empty-environment '())
+
+(define (make-frame variables values)
+  (cons variables values))
+(define (frame-variables frame) (car frame))
+(define (frame-values frame) (cdr frame))
+(define (add-binding-to-frame! var val frame)
+  (set-car! frame (cons var (car frame)))
+  (set-cdr! frame (cons val (cdr frame))))

ch4/evaluator-data-structures.scm~

@@ -0,0 +1,3 @@
+;; conditionals
+(define (true? x)
+  (not (eq? x #f)))

ch4/ex2.scm

@@ -0,0 +1,23 @@
+;; seriously?
+;; issues: the evaluator will attempt to look for a function (define) and
+;; fail to find it -- special forms don't work without explicit function
+;; syntax
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ;; ...
+        ((application? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        ((assignment? exp) (eval-assignment exp env))
+        ;; ...
+        (else
+         (error "Unknown expression type -- EVAL" exp))))
+
+;; ...
+
+
+;; god I hate this idea with a burning passion 
+(define (application? exp) (tagged-list? exp 'call))
+(define (operator exp) (cadr exp))
+(define (operands exp) (cddr exp))

ch4/ex2.scm~

@@ -0,0 +1,93 @@
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp) (symbol? exp))
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp) (cadr exp))
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+(define (assignment-variable exp) (cadr exp))
+(define (assignment-variable exp) (caddr exp))
+
+(define (definition? exp)
+  (tagged-list? exp 'define))
+(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)
+                   (cddr exp))))
+
+(define (lambda? exp) (tagged-list? exp 'lambda))
+(define (lambda-parameters exp) (cadr exp))
+(define (lambda-body exp) (cddr exp))
+
+(define (make-lambda parameters body)
+  (cons 'lambda (cons parameters body)))
+
+(define (if? exp) (tagged-list? exp 'if))
+(define (if-predicate exp) (cadr exp))
+(define (if-consequent exp) (caddr exp))
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+      (cadddr exp)
+      '#f))
+
+(define (make-if predicate consequent alternative)
+  (list 'if predicate consequent alternative))
+
+(define (begin? exp) (tagged-list? exp 'begin))
+(define (begin-actions exp) (cdr exp))
+(define (last-exp? seq) (null? (cdr seq)))
+(define (first-exp seq) (car seq))
+(define (rest-exps seq) (cdr seq))
+
+(define (sequence->exp seq)
+  (cond ((null? seq) seq)
+        ((last-exp? seq) (first-exp seq))
+        (else (make-begin seq))))
+(define (make-begin seq) (cons 'begin seq))
+
+(define (application? exp) (pair? exp))
+(define (operator exp) (car exp))
+(define (operands exp) (cdr exp))
+(define (no-operands? ops) (null? ops))
+(define (first-operand ops) (car ops))
+(define (rest-operands ops) (cdr ops))
+
+(define (cond? exp) (tagged-list? exp 'cond))
+(define (cond-clauses exp) (cdr exp))
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+(define (cond-predicate cause) (car clause))
+(define (cond-actions clause) (cdr clause))
+(define (cond->if exp)
+  (expand-clauses (cond-clauses exp)))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      #f
+      (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))))))

ch4/ex3.scm

@@ -0,0 +1,29 @@
+;; use table implementation from 3.3.3
+(define (operation-table (make-table)))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
+
+;; cannot represent variables, self-evaluation, or application without
+;; literal syntax in this manner
+(put 'op 'quote text-of-quotation)
+(put 'op 'set! eval-assignment)
+(put 'op 'define eval-definition)
+(put 'op 'if eval-if)
+(put 'op 'lambda (lambda (x y)
+                   (make-procedure (lambda-parameters x)
+                                   (lambda-body y)
+                                   y)))
+(put 'op 'begin (lambda (x y)
+                  (eval-sequeence (begin-actions x) y)))
+(put 'op 'cond (lambda (x y)
+                 (eval (cond->if x) y)))
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
+        ((application? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))

ch4/ex4.scm

@@ -0,0 +1,56 @@
+(define (operation-table (make-table)))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
+
+;; cannot represent variables, self-evaluation, or application without
+;; literal syntax in this manner
+(put 'op 'quote text-of-quotation)
+(put 'op 'set! eval-assignment)
+(put 'op 'define eval-definition)
+(put 'op 'if eval-if)
+(put 'op 'and eval-and)
+(put 'op 'or eval-or)
+(put 'op 'lambda (lambda (x y)
+                   (make-procedure (lambda-parameters x)
+                                   (lambda-body y)
+                                   y)))
+(put 'op 'begin (lambda (x y)
+                  (eval-sequeence (begin-actions x) y)))
+(put 'op 'cond (lambda (x y)
+                 (eval (cond->if x) y)))
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
+        ((application? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))
+
+(define (and? exp) (tagged-list? exp 'and))
+(define (and-clauses exp) (cdr exp))
+(define (eval-and exp env)
+  (let ((val (eval (first-exp exp) env)))
+    (if (last-exp? exp)
+        (if val
+            val
+            #f)
+        (else
+         (if val
+             (eval-and (rest-exps exp) env)
+             #f)))))
+
+(define (or? exp) (tagged-list? exp 'or))
+(define (or-clauses exp) (cdr exp))
+(define (eval-or exp env)
+  (let ((val (eval (first-exp exp) env)))
+    (if (last-exp? exp)
+        (if v
+            v
+            #f)
+        (else
+         (if v
+             v
+             (eval-or (rest-exps exp) env))))))

ch4/ex4.scm~

@@ -0,0 +1,28 @@
+(define (operation-table (make-table)))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
+
+;; cannot represent variables, self-evaluation, or application without
+;; literal syntax in this manner
+(put 'op 'quote text-of-quotation)
+(put 'op 'set! eval-assignment)
+(put 'op 'define eval-definition)
+(put 'op 'if eval-if)
+(put 'op 'lambda (lambda (x y)
+                   (make-procedure (lambda-parameters x)
+                                   (lambda-body y)
+                                   y)))
+(put 'op 'begin (lambda (x y)
+                  (eval-sequeence (begin-actions x) y)))
+(put 'op 'cond (lambda (x y)
+                 (eval (cond->if x) y)))
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((get 'op (car expr)) (apply (get 'op (car expr) expr env)))
+        ((application? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))

ch4/ex5.scm

@@ -0,0 +1,30 @@
+(define (cond? exp) (tagged-list? exp '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 (extended-cond? clause) (eq? (cadr clause) '=>))
+(define (extended-cond-test clause) (car clause))
+(define (extended-cond-recipient clause) (caddr clause))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      #f
+      (let ((first (car clauses))
+            (rest (cdr clauses)))
+        (cond ((cond-else-clause? first)
+               (if (null? rest)
+                   (sequence->exp (cond-actions first))
+                   (error "ELSE clause isn't last -- COND->IF" clauses)))
+              ((extended-cond-syntax first)
+               (make-if (extended-cond-test first)
+                        (list (extended-cond-recipient first)
+                              (extended-cond-test first))
+                        (expand-clauses rest)))
+              (else
+               (make-if (cond-predicate first)
+                        (sequence->exp (cond-actions first))
+                        (expand-clauses rest)))))))

ch4/ex5.scm~

@@ -0,0 +1,22 @@
+(define (cond? exp) (tagged-list? exp 'cond))
+(define (cond-clauses exp) (cdr exp))
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+(define (cond-predicate cause) (car clause))
+(define (cond-actions clause) (cdr clause))
+(define (cond->if exp)
+  (expand-clauses (cond-clauses exp)))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      #f
+      (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))))))

ch4/ex6.scm

@@ -0,0 +1,7 @@
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-variables exp) (map car (cadr exp)))
+(define (let-initializers exp) (map cadr (cadr exp)))
+(define (let-body exp) (cddr exp))
+(define (let->combination exp)
+  (cons (make-lambda (let-vars expr) (let-body expr))
+        (let-inits expr)))

ch4/ex6.scm~

@@ -0,0 +1,2 @@
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-vars exp) (car exp))

ch4/ex7.scm

@@ -0,0 +1,32 @@
+;; (let* ((x 3)
+;;        (y (+ x 2))
+;;        (z (+ x y 5)))
+;;   (* x z))
+;;
+;; ==
+;;
+;; (let ((x 1))
+;;   (let (y (+ x 2))
+;;     (let (z (+ x y 5))
+;;       (* x z))))
+
+;; ex6
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-definitions exp) (cadr exp))
+(define (let-variable def) (car def))
+(define (let-initializer def) (cadr def))
+(define (let-variables exp) (map let-variable (let-definitions exp)))
+(define (let-initializers exp) (map let-initializer (let-definitions exp)))
+(define (let-body exp) (cddr exp))
+(define (let->combination exp)
+  (cons (make-lambda (let-vars expr) (let-body expr))
+        (let-inits expr)))
+
+(define (let*? exp) (tagged-list? exp 'let*))
+(define (let*->nexted-lets exp)
+  (let ((inits (let-initializers exp))
+        (body (let-body exp)))
+    ((lambda (exps)
+      (if (null? exps)
+          body
+          (list 'let (list (car exps)) (make-lets (cdr exps))))) inits)))

ch4/ex7.scm~

@@ -0,0 +1,24 @@
+;; (let* ((x 3)
+;;        (y (+ x 2))
+;;        (z (+ x y 5)))
+;;   (* x z))
+;;
+;; ==
+;;
+;; (let ((x 1))
+;;   (let (y (+ x 2))
+;;     (let (z (+ x y 5))
+;;       (* x z))))
+
+;; ex6
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-variables exp) (map car (cadr exp)))
+(define (let-initializers exp) (map cadr (cadr exp)))
+(define (let-body exp) (cddr exp))
+(define (let->combination exp)
+  (cons (make-lambda (let-vars expr) (let-body expr))
+        (let-inits expr)))
+
+(define (let*? exp) (tagged-list? exp 'let*))
+(define (let*->nexted-lets exp)
+  (expand-))

ch4/ex8.scm

@@ -0,0 +1,11 @@
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-definitions exp) (cadr exp))
+(define (let-variable def) (car def))
+(define (let-initializer def) (cadr def))
+(define (let-variables exp) (map let-variable (let-definitions exp)))
+(define (let-initializers exp) (map let-initializer (let-definitions exp)))
+(define (let-body exp) (cddr exp))
+
+(define (let->combination exp)
+  (cons (make-lambda (let-vars expr) (let-body expr))
+        (let-inits expr)))

ch4/ex8.scm~

@@ -0,0 +1,10 @@
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-definitions exp) (cadr exp))
+(define (let-variable def) (car def))
+(define (let-initializer def) (cadr def))
+(define (let-variables exp) (map let-variable (let-definitions exp)))
+(define (let-initializers exp) (map let-initializer (let-definitions exp)))
+(define (let-body exp) (cddr exp))
+(define (let->combination exp)
+  (cons (make-lambda (let-vars expr) (let-body expr))
+        (let-inits expr)))

ch4/representing-expressions.scm

@@ -0,0 +1,93 @@
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp) (symbol? exp))
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp) (cadr exp))
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+(define (assignment-variable exp) (cadr exp))
+(define (assignment-variable exp) (caddr exp))
+
+(define (definition? exp)
+  (tagged-list? exp 'define))
+(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)
+                   (cddr exp))))
+
+(define (lambda? exp) (tagged-list? exp 'lambda))
+(define (lambda-parameters exp) (cadr exp))
+(define (lambda-body exp) (cddr exp))
+
+(define (make-lambda parameters body)
+  (cons 'lambda (cons parameters body)))
+
+(define (if? exp) (tagged-list? exp 'if))
+(define (if-predicate exp) (cadr exp))
+(define (if-consequent exp) (caddr exp))
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+      (cadddr exp)
+      '#f))
+
+(define (make-if predicate consequent alternative)
+  (list 'if predicate consequent alternative))
+
+(define (begin? exp) (tagged-list? exp 'begin))
+(define (begin-actions exp) (cdr exp))
+(define (last-exp? seq) (null? (cdr seq)))
+(define (first-exp seq) (car seq))
+(define (rest-exps seq) (cdr seq))
+
+(define (sequence->exp seq)
+  (cond ((null? seq) seq)
+        ((last-exp? seq) (first-exp seq))
+        (else (make-begin seq))))
+(define (make-begin seq) (cons 'begin seq))
+
+(define (application? exp) (pair? exp))
+(define (operator exp) (car exp))
+(define (operands exp) (cdr exp))
+(define (no-operands? ops) (null? ops))
+(define (first-operand ops) (car ops))
+(define (rest-operands ops) (cdr ops))
+
+(define (cond? exp) (tagged-list? exp 'cond))
+(define (cond-clauses exp) (cdr exp))
+(define (cond-else-clause? clause)
+  (eq? (cond-predicate clause) 'else))
+(define (cond-predicate cause) (car clause))
+(define (cond-actions clause) (cdr clause))
+(define (cond->if exp)
+  (expand-clauses (cond-clauses exp)))
+
+(define (expand-clauses clauses)
+  (if (null? clauses)
+      #f
+      (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))))))

ch4/representing-expressions.scm~

@@ -0,0 +1,51 @@
+(define (self-evaluating? exp)
+  (cond ((number? exp) #t)
+        ((string? exp) #t)
+        (else #f)))
+
+(define (variable? exp) (symbol? exp))
+
+(define (quoted? exp)
+  (tagged-list? exp 'quote))
+
+(define (text-of-quotation exp) (cadr exp))
+
+(define (tagged-list? exp tag)
+  (if (pair? exp)
+      (eq? (car exp) tag)
+      #f))
+
+(define (assignment? exp)
+  (tagged-list? exp 'set!))
+(define (assignment-variable exp) (cadr exp))
+(define (assignment-variable exp) (caddr exp))
+
+(define (definition? exp)
+  (tagged-list? exp 'define))
+(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)
+                   (cddr exp))))
+
+(define (lambda? exp) (tagged-list? exp 'lambda))
+(define (lambda-parameters exp) (cadr exp))
+(define (lambda-body exp) (cddr exp))
+
+(define (make-lambda parameters body)
+  (cons 'lambda (cons parameters body)))
+
+(define (if? exp) (tagged-list? exp 'if))
+(define (if-predicate exp) (cadr exp))
+(define (if-consequent exp) (caddr exp))
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+      (cadddr exp)
+      '#f))
+
+(define (make-if predicate consequent alternative)
+  (list 'if predicate consequent alternative))

ch4/the-core-of-the-evaluator.scm

@@ -0,0 +1,64 @@
+;; implemented as case analysis for simplicity
+;; should be implemented using object orientation
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((quoted? exp) (text-of-quotation exp))
+        ((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))
+        ((applicaton? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))
+
+(define (apply procedure arguments)
+  (cond ((primitive-procedure? procedure)
+         (apply-primitive-proccedure procedure arguments))
+        ((compound-procedure? procedure)
+         (eval-sequence
+          (procedure-body procedure)
+          (extend-environment
+           (procedure-parameters procedure)
+           arguments
+           (procedure-environment procedure))))
+        (else
+         (error
+          "Unknown procedure type -- APPLY" procedure))))
+
+(define (list-of-values exps env)
+  (if (no-operands? exps)
+      '()
+      (cons (eval (first-operand exps) env)
+            (list-of-values (rest-operands exps) env))))
+
+(define (eval-if exp env)
+  (if (true? (eval (if-predicate exp) env))
+      (eval (if-consequent exp) env)
+      (eval (if-alternative exp) env)))
+
+(define (eval-sequence exps env)
+  (cond ((last-exp? exps) (eval (first-exp exps) env))
+        (else (eval (first-exp exps) env)
+              (eval-sequence (rest-exps exps) env))))
+
+(define (eval-assignment exp env)
+  (set-variable-value! (assignment-variable exp)
+                       (eval (assignment-value exp) env)
+                       env)
+  'ok)
+
+(define (eval-definition exp env)
+  (define-variable! (definition-variable exp)
+    (eval (definition value exp) env)
+    env)
+  'ok)

ch4/the-core-of-the-evaluator.scm~

@@ -0,0 +1,22 @@
+;; implemented as case analysis for simplicity
+;; should be implemented using object orientation
+
+(define (eval exp env)
+  (cond ((self-evaluating? exp) exp)
+        ((variable? exp) (lookup-variable-value exp env))
+        ((quoted? exp) (text-of-quotation exp))
+        ((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))
+        ((applicaton? exp)
+         (apply (eval (operator exp) env)
+                (list-of-values (operands exp) env)))
+        (else
+         (error "Unknown expression type -- EVAL" exp))))