Permalink
Browse files

ch4

  • Loading branch information...
nslobodin committed Aug 26, 2012
1 parent 2b63cca commit ca0a66c6d33d69b4efd830ea85c10da8428fe001
Showing with 67 additions and 0 deletions.
  1. +1 −0 ch4/ex4-1.scm
  2. +66 −0 ch4/test_interpreter.scm
View
@@ -0,0 +1 @@
+#lang racket
View
@@ -0,0 +1,66 @@
+#lang racket
+
+;; Eval
+
+(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))
+ ((application? exp)
+ (apply (eval (operator exp) env) ;; apply procedure (proc, args)
+ (list-of-values (operands exp) env)))
+ (else
+ (error "Unknown expression type -- EVAL" exp))))
+
+;; Apply
+
+(define (apply procedure arguments)
+ (cond ((primitive-procedure? procedure)
+ (apply-primitive-procedure 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)

0 comments on commit ca0a66c

Please sign in to comment.