diff --git a/collects/tests/eopl/chapter1/test-chap1.scm b/collects/tests/eopl/chapter1/test-chap1.scm
new file mode 100755
index 0000000000..99a55a12f7
--- /dev/null
+++ b/collects/tests/eopl/chapter1/test-chap1.scm
@@ -0,0 +1,191 @@
+(module test-chap1 mzscheme
+
+  ;; This collects the code in chapter 1.  It uses a very primitive
+  ;; testing macro, equal??.  This needs to be a macro because we print
+  ;; the test as well as evaluate it.
+
+  ;; We use a more sophisticated testing setup for the interpreters
+  ;; later on.
+
+  (define-syntax equal??
+    (syntax-rules ()
+      ((_ test-exp correct-ans)
+       (let ((observed-ans test-exp))
+         (if (not (equal? observed-ans correct-ans))
+           (printf "~s returned ~s, should have returned ~s~%"
+             'test-exp
+             observed-ans
+             correct-ans))))))
+
+
+  ;; in-S? : N -> Bool
+  ;; usage: (in-S? n) = #t if n is in S, #f otherwise
+  ;; The set S is defined in Definition 1.1.1 on page 2.
+  (define in-S?
+    (lambda (n)
+      (if (zero? n) #t
+        (if (>= (- n 3) 0) (in-S? (- n 3))
+          #f))))
+
+  (equal?? (in-S? 4) #f)
+  (equal?? (in-S? 9) #t)
+
+
+  ;; list-length : List -> Int
+  ;; usage: (list-length l) = the length of l
+  ;; Page: 14
+  (define list-length
+    (lambda (lst)
+      (if (null? lst)
+        0
+        (+ 1 (list-length (cdr lst))))))
+
+  (equal?? (list-length '(a (b c) d)) 3)
+
+
+  ;; nth-element : List * Int -> SchemeVal
+  ;; usage: (nth-element lst n) = the nth element of lst
+  ;; Page: 15
+  (define nth-element
+    (lambda (lst n)
+      (if (null? lst)
+        (report-list-too-short n)
+        (if (zero? n)
+          (car lst)
+          (nth-element (cdr lst) (- n 1))))))
+
+  (define report-list-too-short
+    (lambda (n)
+      (error 'nth-element 
+        "List too short by ~s elements.~%" (+ n 1))))
+
+  ;; uncomment these to test equal??
+  ;; (equal?? (nth-element '(a b c d) 2) 'foo)
+  ;; (equal?? (nth-element '(a b c d) 3) 'bar)
+
+  (equal?? (nth-element '(a b c d) 2) 'c)
+
+  ;; remove-first : Sym * Listof(Sym) -> Listof(Sym)
+  ;; Page: 18
+  (define remove-first
+    (lambda (s los)
+      (if (null? los)
+        '()
+        (if (eqv? (car los) s)
+          (cdr los)
+          (cons (car los) (remove-first s (cdr los)))))))
+
+  (equal?? (remove-first 'a '(a b c)) '(b c))
+
+  (equal?? (remove-first 'b '(e f g)) '(e f g))
+
+  (equal?? (remove-first 'a4 '(c1 a4 c1 a4)) '(c1 c1 a4))
+
+  (equal?? (remove-first 'x '()) '())
+
+  ;; occurs-free? : Sym * Lcexp -> Bool
+  ;; usage:
+  ;;   returns #t if the symbol var occurs free in exp,
+  ;;   otherwise returns #f.
+  ;; Page: 19
+  (define occurs-free?
+    (lambda (var exp)
+      (cond
+        ((symbol? exp) (eqv? var exp))  
+        ((eqv? (car exp) 'lambda)
+         (and
+           (not (eqv? var (car (cadr exp))))
+           (occurs-free? var (caddr exp))))
+        (else
+          (or
+            (occurs-free? var (car exp))
+            (occurs-free? var (cadr exp)))))))
+
+
+  (equal?? (occurs-free? 'x 'x) #t)
+
+  (equal?? (occurs-free? 'x 'y) #f)
+
+  (equal?? (occurs-free? 'x '(lambda (x) (x y))) #f)
+
+  (equal?? (occurs-free? 'x '(lambda (y) (x y))) #t)
+
+  (equal?? (occurs-free? 'x '((lambda (x) x) (x y))) #t)
+
+  (equal?? (occurs-free? 'x '(lambda (y) (lambda (z) (x (y z))))) #t)
+
+  ;; subst : Sym * Sym * S-list -> S-list
+  ;; Page: 21
+  (define subst
+    (lambda (new old slist)
+      (if (null? slist)
+        '()
+        (cons
+          (subst-in-s-exp new old (car slist)) 
+          (subst new old (cdr slist))))))
+
+  ;; subst-in-s-exp : Sym * Sym * S-exp -> S-exp
+  ;; Page: 21
+  (define subst-in-s-exp
+    (lambda (new old sexp)
+      (if (symbol? sexp) 
+        (if (eqv? sexp old) new sexp)
+        (subst new old sexp))))
+
+  (equal?? (subst 'a 'b '((b c) (b () d))) '((a c) (a () d)))
+
+  ;; number-elements-from : Listof(SchemeVal) * Int ->
+  ;;                           Listof(List(Int,SchemeVal))  
+  ;; usage: (number-elements-from '(v0 v1 v2  ...) n) 
+  ;;         = ((n v0 ) (n+1 v1) (n+2 v2) ...)
+  ;; Page: 23
+  (define number-elements-from
+    (lambda (lst n)
+      (if (null? lst) '()
+        (cons
+          (list n (car lst))
+          (number-elements-from (cdr lst) (+ n 1))))))
+
+  ;; number-elements : List -> Listof(List(Int,SchemeVal))
+  ;; Page: 23.
+  (define number-elements
+    (lambda (lst)
+      (number-elements-from lst 0)))
+
+  (equal?? (number-elements '(a b c d e)) '((0 a) (1 b) (2 c) (3 d) (4 e)))
+
+  ;; list-sum : Listof(Int) -> Int
+  ;; Page: 24
+  (define list-sum
+    (lambda (loi)
+      (if (null? loi)
+        0
+        (+ (car loi) 
+          (list-sum (cdr loi))))))
+
+  (equal?? (list-sum (list 1 2 3 4 5)) 15)
+
+  ;; partial-vector-sum : Vectorof(Int) * Int -> Int
+  ;; usage if 0 <= n < length(v), then
+  ;;            (partial-vector-sum v n) = SUM(v_i from 0 <= i <= n)
+  ;; Page: 25
+  (define partial-vector-sum
+    (lambda (v n)
+      (if (zero? n)
+        (vector-ref v 0)
+        (+ (vector-ref v n)
+          (partial-vector-sum v (- n 1))))))
+
+  ;; vector-sum : Vectorof(Int) -> Int
+  ;; usage (vector-sum v) = SUM(v_i from 0 <= i <= length(v)-1)
+  ;; Page: 25
+  (define vector-sum
+    (lambda (v)
+      (let ((n (vector-length v)))
+        (if (zero? n)
+          0
+          (partial-vector-sum v (- n 1))))))
+
+  (equal?? (vector-sum (vector 1 2 3 4 5)) 15)
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter2/README.txt b/collects/tests/eopl/chapter2/README.txt
new file mode 100755
index 0000000000..0b9ff215fc
--- /dev/null
+++ b/collects/tests/eopl/chapter2/README.txt
@@ -0,0 +1,3 @@
+(* This directory intentionally left blank *)
+
+The code snippets in this chapter will be posted at a later time.
diff --git a/collects/tests/eopl/chapter2/sec2.1.scm b/collects/tests/eopl/chapter2/sec2.1.scm
new file mode 100755
index 0000000000..af5b49f64d
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.1.scm
@@ -0,0 +1,92 @@
+(module sec2.1 (lib "eopl.ss" "eopl")
+
+  (require "utils.scm")
+
+  (let ()
+    ;; Unary Representation
+    ;; page 33
+    (define zero (lambda () '()))
+    (define is-zero? (lambda (n) (null? n)))
+    (define successor (lambda (n) (cons #t n)))
+    (define predecessor (lambda (n) (cdr n)))
+
+    ;; Need this style of definition to define a recursive function
+    ;; inside a let, sorry.
+    (define (plus x y)
+      (if (is-zero? x)
+        y
+        (successor (plus (predecessor x) y))))
+
+    (define (scheme-int->my-int n)
+      (if (zero? n) (zero)
+        (successor (scheme-int->my-int (- n 1)))))
+
+    (define (my-int->scheme-int x)
+      (if (is-zero? x) 0
+        (+ 1 (my-int->scheme-int (predecessor x)))))
+
+    (equal?? 
+      (my-int->scheme-int
+        (plus 
+          (scheme-int->my-int 3)
+          (scheme-int->my-int 7)))
+      10)
+
+    (report-unit-tests-completed 'unary-representation)
+    )
+
+  (let ()
+    ;; Scheme number representation
+    ;; page 33
+    (define zero (lambda () 0))
+    (define is-zero? (lambda (n) (zero? n)))
+    (define successor (lambda (n) (+ n 1)))
+    (define predecessor (lambda (n) (- n 1)))
+
+    (define (plus x y)
+      (if (is-zero? x)
+        y
+        (successor (plus (predecessor x) y))))
+
+    (equal?? (plus 3 7) 10)
+
+    (report-unit-tests-completed 'scheme-number-representation)
+
+    )
+
+  (let ()
+    ;; Reverse-number representation
+    ;; Represent n by the Scheme number 5-n
+    (define zero (lambda () 5))
+    (define is-zero? (lambda (n) (= n 5)))
+    (define successor (lambda (n) (- n 5)))
+    (define predecessor (lambda (n) (+ n 5)))
+
+    ;; unchanged below here!
+
+    (define plus
+      (lambda (x y)
+        (if (is-zero? x)
+          y
+          (successor (plus (predecessor x) y)))))
+
+    (define (scheme-int->my-int n)
+        (if (zero? n) (zero)
+          (successor (scheme-int->my-int (- n 1)))))
+
+    (define (my-int->scheme-int x)
+        (if (is-zero? x) 0
+          (+ 1 (my-int->scheme-int (predecessor x)))))
+
+    (equal?? 
+      (my-int->scheme-int
+        (plus 
+          (scheme-int->my-int 3)
+          (scheme-int->my-int 7)))
+      10)
+
+    (report-unit-tests-completed 'reverse-number-representation)
+    )
+
+  )
+
diff --git a/collects/tests/eopl/chapter2/sec2.2-ds-rep.scm b/collects/tests/eopl/chapter2/sec2.2-ds-rep.scm
new file mode 100755
index 0000000000..9b09c8bfec
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.2-ds-rep.scm
@@ -0,0 +1,57 @@
+(module sec2.2-ds-rep (lib "eopl.ss" "eopl")
+
+  ;; Simple data structure representation of environments
+  ;; Page: 38
+
+  (require "utils.scm")
+
+  ;; data definition:
+  ;; Env ::= (empty-env) | (extend-env Var Schemeval Env)
+
+  ;; empty-env : () -> Env
+  (define empty-env
+    (lambda () (list 'empty-env)))
+  
+  ;; extend-env : Var * Schemeval * Env -> Env
+  (define extend-env
+    (lambda (var val env)
+      (list 'extend-env var val env)))
+  
+  ;; apply-env : Env * Var -> Schemeval
+  (define apply-env
+    (lambda (env search-var)
+      (cond
+        ((eqv? (car env) 'empty-env)
+         (report-no-binding-found search-var))
+        ((eqv? (car env) 'extend-env)
+         (let ((saved-var (cadr env))
+               (saved-val (caddr env))
+               (saved-env (cadddr env)))
+           (if (eqv? search-var saved-var)
+             saved-val
+             (apply-env saved-env search-var))))
+        (else
+          (report-invalid-env env)))))
+  
+  (define report-no-binding-found
+    (lambda (search-var)
+      (eopl:error 'apply-env "No binding for ~s" search-var)))
+  
+  (define report-invalid-env
+    (lambda (env)
+      (eopl:error 'apply-env "Bad environment: ~s" env)))
+
+  (define e
+    (extend-env 'd 6
+      (extend-env 'y 8
+        (extend-env 'x 7
+          (extend-env 'y 14
+            (empty-env))))))
+
+  (equal?? (apply-env e 'd) 6)
+  (equal?? (apply-env e 'y) 8)
+  (equal?? (apply-env e 'x) 7)
+
+  (report-unit-tests-completed 'apply-env)
+
+)
diff --git a/collects/tests/eopl/chapter2/sec2.2-proc-rep.scm b/collects/tests/eopl/chapter2/sec2.2-proc-rep.scm
new file mode 100755
index 0000000000..ce71e0037c
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.2-proc-rep.scm
@@ -0,0 +1,53 @@
+(module sec2.2-proc-rep (lib "eopl.ss" "eopl")
+
+  ;; Simple procedural representation of environments
+  ;; Page: 40
+
+  (require "utils.scm")
+
+  ;; data definition:
+  ;; Env = Var -> Schemeval
+
+  ;; empty-env : () -> Env
+  (define empty-env
+    (lambda ()
+      (lambda (search-var) 
+        (report-no-binding-found search-var))))
+  
+  ;; extend-env : Var * Schemeval * Env -> Env
+  (define extend-env
+    (lambda (saved-var saved-val saved-env)
+      (lambda (search-var)
+        (if (eqv? search-var saved-var)
+          saved-val
+          (apply-env saved-env search-var)))))
+  
+  ;; apply-env : Env * Var -> Schemeval
+  (define apply-env
+    (lambda (env search-var) 
+      (env search-var)))
+
+  (define report-no-binding-found
+    (lambda (search-var)
+      (eopl:error 'apply-env "No binding for ~s" search-var)))
+  
+  (define report-invalid-env
+    (lambda (env)
+      (eopl:error 'apply-env "Bad environment: ~s" env)))
+
+  (define e
+    (extend-env 'd 6
+      (extend-env 'y 8
+        (extend-env 'x 7
+          (extend-env 'y 14
+            (empty-env))))))
+
+  (equal?? (apply-env e 'd) 6)
+  (equal?? (apply-env e 'y) 8)
+  (equal?? (apply-env e 'x) 7)
+
+  (report-unit-tests-completed 'apply-env)
+
+  )
+
+
diff --git a/collects/tests/eopl/chapter2/sec2.3.scm b/collects/tests/eopl/chapter2/sec2.3.scm
new file mode 100755
index 0000000000..5f6519cd7d
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.3.scm
@@ -0,0 +1,85 @@
+(module sec2.3 (lib "eopl.ss" "eopl")
+
+  (require "utils.scm")
+
+  ;; var-exp : Var -> Lc-exp
+  (define var-exp
+    (lambda (var)
+      `(var-exp ,var)))
+
+  ;; lambda-exp : Var * Lc-exp -> Lc-exp
+  (define lambda-exp
+    (lambda (var lc-exp)
+      `(lambda-exp ,var ,lc-exp)))
+
+  ;; app-exp : Lc-exp * Lc-exp -> Lc-exp
+  (define app-exp
+    (lambda (lc-exp1 lc-exp2)
+      `(app-exp ,lc-exp1 ,lc-exp2)))
+
+  ;; var-exp? : Lc-exp -> Bool
+  (define var-exp?
+    (lambda (x)
+      (and (pair? x) (eq? (car x) 'var-exp))))
+
+  ;; lambda-exp? : Lc-exp -> Bool
+  (define lambda-exp?
+    (lambda (x)
+      (and (pair? x) (eq? (car x) 'lambda-exp))))
+
+  ;; app-exp? : Lc-exp -> Bool 
+  (define app-exp?
+    (lambda (x)
+      (and (pair? x) (eq? (car x) 'app-exp))))
+  ;; var-exp->var : Lc-exp -> Var
+  (define var-exp->var
+    (lambda (x)
+      (cadr x)))
+
+  ;; lambda-exp->bound-var : Lc-exp -> Var
+  (define lambda-exp->bound-var
+    (lambda (x)
+      (cadr x)))
+
+  ;; lambda-exp->body : Lc-exp -> Lc-exp
+  (define lambda-exp->body
+    (lambda (x)
+      (caddr x)))
+
+  ;; app-exp->rator : Lc-exp -> Lc-exp
+  (define app-exp->rator
+    (lambda (x)
+      (cadr x)))
+
+  ;; app-exp->rand : Lc-exp -> Lc-exp
+  (define app-exp->rand
+    (lambda (x)
+      (caddr x)))
+
+  ;; occurs-free? : Sym * Lcexp -> Bool
+  (define occurs-free?
+    (lambda (search-var exp)
+      (cond
+        ((var-exp? exp) (eqv? search-var (var-exp->var exp)))
+        ((lambda-exp? exp) 
+         (and
+           (not (eqv? search-var (lambda-exp->bound-var exp)))
+           (occurs-free? search-var (lambda-exp->body exp))))
+        (else
+          (or
+            (occurs-free? search-var (app-exp->rator exp))
+            (occurs-free? search-var (app-exp->rand exp)))))))
+
+  ;; a few small unit tests
+
+  (equal??
+    (occurs-free? 'a (lambda-exp 'a (app-exp (var-exp 'b) (var-exp 'a))))
+    #f)
+
+  (equal??
+    (occurs-free? 'b (lambda-exp 'a (app-exp (var-exp 'b) (var-exp 'a))))
+    #t)
+
+  (report-unit-tests-completed 'occurs-free?)
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter2/sec2.4.scm b/collects/tests/eopl/chapter2/sec2.4.scm
new file mode 100755
index 0000000000..c128c65e25
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.4.scm
@@ -0,0 +1,114 @@
+(module sec2.4 (lib "eopl.ss" "eopl")
+
+  (require "utils.scm")
+
+  (define identifier? symbol?)
+
+  (define-datatype lc-exp lc-exp? 
+    (var-exp
+      (var identifier?))
+    (lambda-exp
+      (bound-var identifier?)
+      (body lc-exp?))
+    (app-exp
+      (rator lc-exp?)
+      (rand lc-exp?)))
+
+  ;; occurs-free? : Sym * Lcexp -> Bool
+  (define occurs-free?
+    (lambda (search-var exp)
+      (cases lc-exp exp
+        (var-exp (var) (eqv? var search-var))
+        (lambda-exp (bound-var body)
+          (and
+            (not (eqv? search-var bound-var))
+            (occurs-free? search-var body)))
+        (app-exp (rator rand)
+          (or
+            (occurs-free? search-var rator)
+            (occurs-free? search-var rand))))))
+
+  ;; test items
+  (equal?? (occurs-free? 'x (var-exp 'x)) #t)
+
+  (equal?? (occurs-free? 'x (var-exp 'y)) #f)
+
+  (equal?? (occurs-free? 'x (lambda-exp 'x
+                              (app-exp (var-exp 'x) (var-exp 'y))))
+    #f)
+
+  (equal??
+    (occurs-free? 'x (lambda-exp 'y
+                       (app-exp (var-exp 'x) (var-exp 'y))))
+    #t)
+
+  (equal??
+    (occurs-free? 'x 
+      (app-exp
+        (lambda-exp 'x (var-exp 'x))
+        (app-exp (var-exp 'x) (var-exp 'y))))
+    #t)
+
+  (equal?? 
+    (occurs-free? 'x
+      (lambda-exp 'y
+        (lambda-exp 'z
+          (app-exp (var-exp 'x)
+            (app-exp (var-exp 'y) (var-exp 'z))))))
+    #t)
+
+  (define-datatype s-list s-list? 
+    (empty-s-list)
+    (non-empty-s-list 
+      (first s-exp?)
+      (rest s-list?)))
+  
+  (define-datatype s-exp s-exp? 
+    (symbol-s-exp
+      (sym symbol?))
+    (s-list-s-exp
+      (slst s-list?)))
+
+  ;; page 48: alternate definition 
+  (define-datatype s-list-alt s-list-alt? 
+    (an-s-list
+      (sexps (list-of s-exp?))))
+  
+  (define list-of
+    (lambda (pred)
+      (lambda (val)
+        (or (null? val)
+          (and (pair? val)
+            (pred (car val))
+            ((list-of pred) (cdr val)))))))
+
+  ;; For exercises 2.24-2.25
+  (define-datatype bintree bintree? 
+    (leaf-node 
+      (num integer?))
+    (interior-node
+      (key symbol?) 
+      (left bintree?)
+      (right bintree?)))
+
+  ;;   > (bintree-to-list
+  ;;       (interior-node
+  ;;         'a
+  ;;         (leaf-node 3)
+  ;;         (leaf-node 4)))
+  ;;   (interior-node a (leaf-node 3) (leaf-node 4)))
+
+  ;;   > (define tree-1
+  ;;       (interior-node 'foo (leaf-node 2) (leaf-node 3)))
+  ;;   > (define tree-2
+  ;;       (interior-node 'bar (leaf-node -1) tree-1))
+  ;;   > (define tree-3
+  ;;       (interior-node 'baz tree-2 (leaf-node 1)))
+  ;;   > (max-interior tree-2)
+  ;;   foo
+  ;;   > (max-interior tree-3)
+  ;;   baz
+
+  (eopl:printf "unit tests completed successfully.~%")
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter2/sec2.5.scm b/collects/tests/eopl/chapter2/sec2.5.scm
new file mode 100755
index 0000000000..61627dd4c1
--- /dev/null
+++ b/collects/tests/eopl/chapter2/sec2.5.scm
@@ -0,0 +1,150 @@
+(module sec2.5 (lib "eopl.ss" "eopl")
+
+  (require "utils.scm")
+
+  ;; data definitions
+  (define identifier? symbol?)
+
+  (define-datatype lc-exp lc-exp? 
+    (var-exp
+      (var identifier?))
+    (lambda-exp
+      (bound-var identifier?)
+      (body lc-exp?))
+    (app-exp
+      (rator lc-exp?)
+      (rand lc-exp?)))
+
+  ;; parse-expression : Schemeval -> Lcexp
+  ;; page 53
+  (define parse-expression
+    (lambda (datum)
+      (cond
+        ((symbol? datum) (var-exp datum))
+        ((pair? datum)
+         (if (eqv? (car datum) 'lambda)
+           (lambda-exp
+             (car (cadr datum))
+             (parse-expression (caddr datum)))
+           (app-exp
+             (parse-expression (car datum))
+             (parse-expression (cadr datum)))))
+        (else (report-invalid-concrete-syntax datum)))))
+
+  (define report-invalid-concrete-syntax
+    (lambda (datum)
+      (eopl:error "invalid concrete syntax ~s" datum)))
+
+  ;; unit tests
+  (equal??
+    (parse-expression 'x)
+    (var-exp 'x))
+
+  (equal??
+    (parse-expression 'y)
+    (var-exp 'y))
+
+  (equal??
+    (parse-expression '(lambda (x) (x y)))
+    (lambda-exp 'x
+      (app-exp (var-exp 'x) (var-exp 'y))))
+
+  (equal??
+    (parse-expression '(lambda (y) (x y)))
+    (lambda-exp 'y (app-exp (var-exp 'x) (var-exp 'y))))
+
+  (equal??
+    (parse-expression '((lambda (x) x) (x y))) 
+    (app-exp
+      (lambda-exp 'x (var-exp 'x))
+      (app-exp (var-exp 'x) (var-exp 'y))))
+
+  (equal?? 
+    (parse-expression '(lambda (y) (lambda (z) (x (y z)))))
+    (lambda-exp 'y
+      (lambda-exp 'z
+        (app-exp (var-exp 'x)
+          (app-exp (var-exp 'y) (var-exp 'z))))))
+
+  (report-unit-tests-completed 'parse-expression)
+
+  ;; unparse-lc-exp : Lcexp -> Schemeval
+  ;; page 53
+  (define unparse-lc-exp
+    (lambda (exp)
+      (cases lc-exp exp
+        (var-exp (var) var)
+        (lambda-exp (bound-var body) 
+          (list 'lambda (list bound-var)
+            (unparse-lc-exp body)))
+        (app-exp (rator rand)
+          (list 
+            (unparse-lc-exp rator) (unparse-lc-exp rand))))))
+
+
+  ;; unit tests
+  (equal??
+    (unparse-lc-exp (var-exp 'x))
+    'x)
+
+  (equal??
+    (unparse-lc-exp (var-exp 'y))
+    'y)
+
+  (equal??
+    (unparse-lc-exp
+      (lambda-exp 'x (app-exp (var-exp 'x) (var-exp 'y))))
+    '(lambda (x) (x y)))
+
+  (equal??
+    (unparse-lc-exp
+      (lambda-exp 'y (app-exp (var-exp 'x) (var-exp 'y))))
+    '(lambda (y) (x y)))
+
+  (equal??
+    (unparse-lc-exp 
+      (app-exp
+        (lambda-exp 'x (var-exp 'x))
+        (app-exp (var-exp 'x) (var-exp 'y))))
+    '((lambda (x) x) (x y)))
+
+
+  (equal?? 
+    (unparse-lc-exp 
+      (lambda-exp 'y
+        (lambda-exp 'z
+          (app-exp (var-exp 'x)
+            (app-exp (var-exp 'y) (var-exp 'z))))))
+    '(lambda (y) (lambda (z) (x (y z)))))
+
+  (report-unit-tests-completed 'unparse-lc-exp)
+
+
+  ;; Exercise 2.27
+  ;;   ((lambda (a) (a b)) c)
+  
+  ;;   (lambda (x)
+  ;;     (lambda (y)
+  ;;       ((lambda (x)
+  ;;          (x y))
+  ;;        x)))
+
+  ;; Exercise 2.31
+  (define-datatype prefix-exp prefix-exp?
+    (const-exp
+      (num integer?))
+    (diff-exp
+      (operand1 prefix-exp?)
+      (operand2 prefix-exp?)))
+
+  ;;   (diff-exp
+  ;;     (diff-exp
+  ;;       (const-exp 3)
+  ;;       (const-exp 2))
+  ;;     (diff-exp
+  ;;       (const-exp 4)
+  ;;       (diff-exp
+  ;;         (const-exp 12)
+  ;;         (const-exp 7))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter2/utils.scm b/collects/tests/eopl/chapter2/utils.scm
new file mode 100755
index 0000000000..63dadcf901
--- /dev/null
+++ b/collects/tests/eopl/chapter2/utils.scm
@@ -0,0 +1,20 @@
+(module utils (lib "eopl.ss" "eopl")
+
+  ;; a very simple macro for inline testing
+
+  (provide equal?? report-unit-tests-completed)
+
+  ;; simple-minded magic for tests
+  (define-syntax equal??
+    (syntax-rules ()
+      ((_ x y)
+       (let ((x^ x) (y^ y))
+         (if (not (equal? x y))
+           (eopl:error 'equal??
+             "~s is not equal to ~s" 'x 'y))))))
+
+  (define report-unit-tests-completed
+    (lambda (fn-name)
+      (eopl:printf "unit tests completed: ~s~%" fn-name)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/let-lang/data-structures.scm b/collects/tests/eopl/chapter3/let-lang/data-structures.scm
new file mode 100755
index 0000000000..3a25cc5668
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/data-structures.scm
@@ -0,0 +1,74 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for let-lang.
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?)))
+
+;;; extractors:
+
+  ;; expval->num : ExpVal -> Int
+  ;; Page: 70
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  ;; expval->bool : ExpVal -> Bool
+  ;; Page: 70
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;; example of a data type built without define-datatype
+
+  (define empty-env-record
+    (lambda () 
+      '()))
+
+  (define extended-env-record
+    (lambda (sym val old-env)
+      (cons (list sym val) old-env)))
+  
+  (define empty-env-record? null?)
+  
+  (define environment?
+    (lambda (x)
+      (or (empty-env-record? x)
+          (and (pair? x)
+               (symbol? (car (car x)))
+               (expval? (cadr (car x)))
+               (environment? (cdr x))))))
+
+  (define extended-env-record->sym
+    (lambda (r)
+      (car (car r))))
+
+  (define extended-env-record->val
+    (lambda (r)
+      (cadr (car r))))
+
+  (define extended-env-record->old-env
+    (lambda (r)
+      (cdr r)))
+
+)
diff --git a/collects/tests/eopl/chapter3/let-lang/drscheme-init.scm b/collects/tests/eopl/chapter3/let-lang/drscheme-init.scm
new file mode 100755
index 0000000000..cc0b80c3c1
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/drscheme-init.scm
@@ -0,0 +1,130 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+
+(module drscheme-init mzscheme
+
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter3/let-lang/environments.scm b/collects/tests/eopl/chapter3/let-lang/environments.scm
new file mode 100755
index 0000000000..65a89ac14c
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/environments.scm
@@ -0,0 +1,54 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define empty-env
+    (lambda ()
+      (empty-env-record)))
+  
+  (define empty-env? 
+    (lambda (x)
+      (empty-env-record? x)))
+
+  (define extend-env
+    (lambda (sym val old-env)
+      (extended-env-record sym val old-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (empty-env? env)
+	(eopl:error 'apply-env "No binding for ~s" search-sym)
+	(let ((sym (extended-env-record->sym env))
+	      (val (extended-env-record->val env))
+	      (old-env (extended-env-record->old-env env)))
+	  (if (eqv? search-sym sym)
+	    val
+	    (apply-env old-env search-sym))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/let-lang/interp.scm b/collects/tests/eopl/chapter3/let-lang/interp.scm
new file mode 100755
index 0000000000..290b96dd08
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/interp.scm
@@ -0,0 +1,71 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the LET language.  The \commentboxes are the
+  ;; latex code for inserting the rules into the code in the book.
+  ;; These are too complicated to put here, see the text, sorry.
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  ;; Page: 71
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 71
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) = (apply-env \r \x{})}
+        (var-exp (var) (apply-env env var))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((val1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var val1 env))))
+
+        )))
+
+
+  )
+
diff --git a/collects/tests/eopl/chapter3/let-lang/lang.scm b/collects/tests/eopl/chapter3/let-lang/lang.scm
new file mode 100755
index 0000000000..9d28fda782
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/lang.scm
@@ -0,0 +1,60 @@
+(module lang
+
+  ;; grammar for the LET language
+
+  (lib "eopl.ss" "eopl")                
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      ))
+  
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/let-lang/tests.scm b/collects/tests/eopl/chapter3/let-lang/tests.scm
new file mode 100755
index 0000000000..8b4309fb24
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/tests.scm
@@ -0,0 +1,59 @@
+(module tests mzscheme
+  
+  (provide test-list)
+
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/let-lang/top.scm b/collects/tests/eopl/chapter3/let-lang/top.scm
new file mode 100755
index 0000000000..2094737b14
--- /dev/null
+++ b/collects/tests/eopl/chapter3/let-lang/top.scm
@@ -0,0 +1,73 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  ;; since this is the top-level module, we don't really need to
+  ;; provide anything, but we do so just in case.  
+
+  (provide run run-all)
+
+  ;; here are some other things that could be provided:
+
+  ;;   (provide (all-defined))
+  ;;   (provide (all-from "interp.scm"))
+  ;;   (provide (all-from "lang.scm"))
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+  ;; Page: 71
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> unspecified
+  
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : symbol -> expval
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter3/letrec-lang/data-structures.scm b/collects/tests/eopl/chapter3/letrec-lang/data-structures.scm
new file mode 100755
index 0000000000..56ca3028d4
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/data-structures.scm
@@ -0,0 +1,72 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for letrec-lang.
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  ;; expval->num : ExpVal -> Int
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  ;; expval->bool : ExpVal -> Bool
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  ;; expval->proc : ExpVal -> Proc
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  ;; proc? : SchemeVal -> Bool
+  ;; procedure : Var * Exp * Env -> Proc
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+
+  ;; Page: 86
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-rec
+      (id symbol?)
+      (bvar symbol?)
+      (body expression?)
+      (saved-env environment?)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/letrec-lang/drscheme-init.scm b/collects/tests/eopl/chapter3/letrec-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter3/letrec-lang/environments.scm b/collects/tests/eopl/chapter3/letrec-lang/environments.scm
new file mode 100755
index 0000000000..893077de3c
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/environments.scm
@@ -0,0 +1,46 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; Page: 86
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (var val saved-env)
+	  (if (eqv? search-sym var)
+	    val
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec (p-name b-var p-body saved-env)
+          (if (eqv? search-sym p-name)
+            (proc-val (procedure b-var p-body env))          
+            (apply-env saved-env search-sym))))))
+    
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/letrec-lang/interp.scm b/collects/tests/eopl/chapter3/letrec-lang/interp.scm
new file mode 100755
index 0000000000..f16f226c88
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/interp.scm
@@ -0,0 +1,92 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the LETREC language.  The \commentboxes are the
+  ;; latex code for inserting the rules into the code in the book.
+  ;; These are too complicated to put here, see the text, sorry.
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 83
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) = (apply-env \r \x{})}
+        (var-exp (var) (apply-env env var))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((val1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var val1 env))))
+        
+        (proc-exp (var body)
+          (proc-val (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of rand env)))
+            (apply-procedure proc arg)))
+
+        (letrec-exp (p-name b-var p-body letrec-body)
+          (value-of letrec-body
+            (extend-env-rec p-name b-var p-body env)))
+
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+  
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter3/letrec-lang/lang.scm b/collects/tests/eopl/chapter3/letrec-lang/lang.scm
new file mode 100755
index 0000000000..e68c03e132
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/lang.scm
@@ -0,0 +1,72 @@
+(module lang (lib "eopl.ss" "eopl")                
+
+  ;; grammar for the LETREC language
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          identifier "(" identifier ")" "=" expression
+           "in" expression)
+        letrec-exp)
+      
+      ))
+  
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/letrec-lang/tests.scm b/collects/tests/eopl/chapter3/letrec-lang/tests.scm
new file mode 100755
index 0000000000..ceef83cf18
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/tests.scm
@@ -0,0 +1,101 @@
+(module tests mzscheme
+  
+  (provide test-list)
+
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;; alas, no multiplication in this language.  Exercise: define
+;; multiplication as a letrec and then use it to define factorial.
+;;      (fact-of-6  "letrec
+;;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;;  in (fact 6)" 
+;;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+      
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/letrec-lang/top.scm b/collects/tests/eopl/chapter3/letrec-lang/top.scm
new file mode 100755
index 0000000000..3c51054eaa
--- /dev/null
+++ b/collects/tests/eopl/chapter3/letrec-lang/top.scm
@@ -0,0 +1,66 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  ;; since this is the top-level module, we don't really need to
+  ;; provide anything, but we do so just in case.  
+
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/data-structures.scm b/collects/tests/eopl/chapter3/lexaddr-lang/data-structures.scm
new file mode 100755
index 0000000000..9afdd99b46
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/data-structures.scm
@@ -0,0 +1,94 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for LEXADDR language
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  ;; expval->num : ExpVal -> Int
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  ;; expval->bool : ExpVal -> Bool
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  ;; expval->proc : ExpVal -> Proc
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+
+  ;; proc? : SchemeVal -> Bool
+  ;; procedure : Exp * Nameless-env -> Proc
+  (define-datatype proc proc?
+    (procedure
+      ;; in LEXADDR, bound variables are replaced by %nameless-vars, so
+      ;; there is no need to declare bound variables.
+      ;; (bvar symbol?)
+      (body expression?)
+      ;; and the closure contains a nameless environment
+      (env nameless-environment?)))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; nameless-environment? : SchemeVal -> Bool
+  ;; Page: 99
+  (define nameless-environment?
+    (lambda (x)
+      ((list-of expval?) x)))
+
+  ;; empty-nameless-env : () -> Nameless-env
+  ;; Page: 99
+  (define empty-nameless-env
+    (lambda ()
+      '()))
+
+  ;; empty-nameless-env? : Nameless-env -> Bool
+  (define empty-nameless-env? 
+    (lambda (x)
+      (null? x)))
+
+  ;; extend-nameless-env : ExpVal * Nameless-env -> Nameless-env
+  ;; Page: 99
+  (define extend-nameless-env
+    (lambda (val nameless-env)
+      (cons val nameless-env)))
+
+   ;; apply-nameless-env : Nameless-env * Lexaddr -> ExpVal
+   ;; Page: 99
+   (define apply-nameless-env
+     (lambda (nameless-env n)
+       (list-ref nameless-env n)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/drscheme-init.scm b/collects/tests/eopl/chapter3/lexaddr-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/environments.scm b/collects/tests/eopl/chapter3/lexaddr-lang/environments.scm
new file mode 100755
index 0000000000..a88263a340
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/environments.scm
@@ -0,0 +1,26 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (provide init-nameless-env empty-nameless-env extend-nameless-env
+           apply-nameless-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Nameless-env
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-nameless-env
+    (lambda ()
+      (extend-nameless-env 
+       (num-val 1)			; was i
+       (extend-nameless-env
+        (num-val 5)			; was v
+        (extend-nameless-env
+         (num-val 10)			; was x
+         (empty-nameless-env))))))
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/interp.scm b/collects/tests/eopl/chapter3/lexaddr-lang/interp.scm
new file mode 100755
index 0000000000..cc02886896
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/interp.scm
@@ -0,0 +1,90 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the LEXADDR language.
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-translation value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-translation : Nameless-program -> ExpVal
+
+  (define value-of-translation
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-nameless-env))))))
+
+  ;; value-of-translation : Nameless-program -> ExpVal
+  ;; Page: 100
+  (define value-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-nameless-env))))))
+  
+  ;; value-of : Nameless-exp * Nameless-env -> ExpVal
+  (define value-of
+    (lambda (exp nameless-env)
+      (cases expression exp
+                (const-exp (num) (num-val num))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 nameless-env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 nameless-env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 nameless-env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 nameless-env))
+            (value-of exp1 nameless-env)
+            (value-of exp2 nameless-env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator nameless-env)))
+                (arg (value-of rand nameless-env)))
+	    (apply-procedure proc arg)))
+
+        (nameless-var-exp (n)
+          (apply-nameless-env nameless-env n))
+
+        (nameless-let-exp (exp1 body)
+          (let ((val (value-of exp1 nameless-env)))
+            (value-of body
+              (extend-nameless-env val nameless-env))))
+
+        (nameless-proc-exp (body)
+          (proc-val
+            (procedure body nameless-env)))
+
+        (else
+         (eopl:error 'value-of 
+	    "Illegal expression in translated code: ~s" exp))
+
+        )))
+
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (body saved-env)
+          (value-of body (extend-nameless-env arg saved-env))))))
+
+  )
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/lang.scm b/collects/tests/eopl/chapter3/lexaddr-lang/lang.scm
new file mode 100755
index 0000000000..1be7c83399
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/lang.scm
@@ -0,0 +1,76 @@
+(module lang
+
+  ;; grammar for the LEXADDR language
+
+  (lib "eopl.ss" "eopl")                
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression ("%nameless-var" number) nameless-var-exp)
+      (expression
+        ("%let" expression "in" expression)
+        nameless-let-exp)
+      (expression
+        ("%lexproc" expression)
+        nameless-proc-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/tests.scm b/collects/tests/eopl/chapter3/lexaddr-lang/tests.scm
new file mode 100755
index 0000000000..b329861435
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/tests.scm
@@ -0,0 +1,78 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+;      these aren't translatable. Exercise: make them translatable by
+;      providing a binding for foo.
+;       ;; and make sure the other arm doesn't get evaluated.
+;       (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+;       (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+      (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/top.scm b/collects/tests/eopl/chapter3/lexaddr-lang/top.scm
new file mode 100755
index 0000000000..3ba33d8758
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/top.scm
@@ -0,0 +1,67 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  (require "translator.scm")	   ; for translation-of-program
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+  ;; Page: 98
+  (define run
+    (lambda (string)
+      (value-of-translation
+	(translation-of-program
+	  (scan&parse string)))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter3/lexaddr-lang/translator.scm b/collects/tests/eopl/chapter3/lexaddr-lang/translator.scm
new file mode 100755
index 0000000000..c7511304a3
--- /dev/null
+++ b/collects/tests/eopl/chapter3/lexaddr-lang/translator.scm
@@ -0,0 +1,100 @@
+(module translator (lib "eopl.ss" "eopl")
+  
+  (require "lang.scm")
+
+  (provide translation-of-program)
+  ;;;;;;;;;;;;;;;; lexical address calculator ;;;;;;;;;;;;;;;;
+
+  ;; translation-of-program : Program -> Nameless-program
+  ;; Page: 96
+  (define translation-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (a-program                    
+            (translation-of exp1 (init-senv)))))))
+
+  ;; translation-of : Exp * Senv -> Nameless-exp
+  ;; Page 97
+  (define translation-of
+    (lambda (exp senv)
+      (cases expression exp
+        (const-exp (num) (const-exp num))
+        (diff-exp (exp1 exp2)
+          (diff-exp
+            (translation-of exp1 senv)
+            (translation-of exp2 senv)))
+        (zero?-exp (exp1)
+          (zero?-exp
+            (translation-of exp1 senv)))
+        (if-exp (exp1 exp2 exp3)
+          (if-exp
+            (translation-of exp1 senv)
+            (translation-of exp2 senv)
+            (translation-of exp3 senv)))
+        (var-exp (var)
+          (nameless-var-exp
+            (apply-senv senv var)))
+        (let-exp (var exp1 body)
+          (nameless-let-exp
+            (translation-of exp1 senv)            
+            (translation-of body
+              (extend-senv var senv))))
+        (proc-exp (var body)
+          (nameless-proc-exp
+            (translation-of body
+              (extend-senv var senv))))
+        (call-exp (rator rand)
+          (call-exp
+            (translation-of rator senv)
+            (translation-of rand senv)))
+        (else (report-invalid-source-expression exp))
+        )))
+
+  (define report-invalid-source-expression
+    (lambda (exp)
+      (eopl:error 'value-of 
+        "Illegal expression in source code: ~s" exp)))
+  
+   ;;;;;;;;;;;;;;;; static environments ;;;;;;;;;;;;;;;;
+  
+  ;;; Senv = Listof(Sym)
+  ;;; Lexaddr = N
+
+  ;; empty-senv : () -> Senv
+  ;; Page: 95
+  (define empty-senv
+    (lambda ()
+      '()))
+
+  ;; extend-senv : Var * Senv -> Senv
+  ;; Page: 95
+  (define extend-senv
+    (lambda (var senv)
+      (cons var senv)))
+  
+  ;; apply-senv : Senv * Var -> Lexaddr
+  ;; Page: 95
+  (define apply-senv
+    (lambda (senv var)
+      (cond
+        ((null? senv) (report-unbound-var var))
+        ((eqv? var (car senv))
+         0)
+        (else
+          (+ 1 (apply-senv (cdr senv) var))))))
+
+  (define report-unbound-var
+    (lambda (var)
+      (eopl:error 'translation-of "unbound variable in code: ~s" var)))
+
+  ;; init-senv : () -> Senv
+  ;; Page: 96
+  (define init-senv
+    (lambda ()
+      (extend-senv 'i
+        (extend-senv 'v
+          (extend-senv 'x
+            (empty-senv))))))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/data-structures.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/data-structures.scm
new file mode 100755
index 0000000000..44f11dfb75
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/data-structures.scm
@@ -0,0 +1,93 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for proc-lang/ds-rep
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  ;; expval->num : ExpVal -> Int
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  ;; expval->bool : ExpVal -> Bool
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  ;; expval->proc : ExpVal -> Proc
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  ;; proc? : SchemeVal -> Bool
+  ;; procedure : Var * Exp * Env -> Proc
+  (define-datatype proc proc?
+    (procedure
+      (var symbol?)
+      (body expression?)
+      (env environment?)))
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;; example of a data type built without define-datatype
+
+  (define empty-env-record
+    (lambda () 
+      '()))
+
+  (define extended-env-record
+    (lambda (sym val old-env)
+      (cons (list sym val) old-env)))
+  
+  (define empty-env-record? null?)
+  
+  (define environment?
+    (lambda (x)
+      (or (empty-env-record? x)
+          (and (pair? x)
+               (symbol? (car (car x)))
+               (expval? (cadr (car x)))
+               (environment? (cdr x))))))
+
+  (define extended-env-record->sym
+    (lambda (r)
+      (car (car r))))
+
+  (define extended-env-record->val
+    (lambda (r)
+      (cadr (car r))))
+
+  (define extended-env-record->old-env
+    (lambda (r)
+      (cdr r)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/drscheme-init.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/environments.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/environments.scm
new file mode 100755
index 0000000000..0fa4ac0700
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/environments.scm
@@ -0,0 +1,53 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define empty-env
+    (lambda ()
+      (empty-env-record)))
+  
+  (define empty-env? 
+    (lambda (x)
+      (empty-env-record? x)))
+
+  (define extend-env
+    (lambda (sym val old-env)
+      (extended-env-record sym val old-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (empty-env? env)
+	(eopl:error 'apply-env "No binding for ~s" search-sym)
+	(let ((sym (extended-env-record->sym env))
+	      (val (extended-env-record->val env))
+	      (old-env (extended-env-record->old-env env)))
+	  (if (eqv? search-sym sym)
+	    val
+	    (apply-env old-env search-sym))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/interp.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/interp.scm
new file mode 100755
index 0000000000..37f02eb600
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/interp.scm
@@ -0,0 +1,86 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the PROC language, using the data structure
+  ;; representation of procedures.
+
+  ;; The \commentboxes are the latex code for inserting the rules into
+  ;; the code in the book. These are too complicated to put here, see
+  ;; the text, sorry. 
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) = (apply-env \r \x{})}
+        (var-exp (var) (apply-env env var))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((val1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var val1 env))))
+        
+        (proc-exp (var body)
+          (proc-val (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of rand env)))
+            (apply-procedure proc arg)))
+
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  ;; Page: 79
+  (define apply-procedure
+    (lambda (proc1 val)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var val saved-env))))))
+
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/lang.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/lang.scm
new file mode 100755
index 0000000000..cd0d22099d
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/lang.scm
@@ -0,0 +1,66 @@
+(module lang (lib "eopl.ss" "eopl")                
+
+  ;; grammar for the PROC language
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/tests.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/tests.scm
new file mode 100755
index 0000000000..e40a243b4b
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/tests.scm
@@ -0,0 +1,77 @@
+(module tests mzscheme
+  
+  (provide test-list)
+
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+      (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/proc-lang/ds-rep/top.scm b/collects/tests/eopl/chapter3/proc-lang/ds-rep/top.scm
new file mode 100755
index 0000000000..6271ff9639
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/ds-rep/top.scm
@@ -0,0 +1,59 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/data-structures.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/data-structures.scm
new file mode 100755
index 0000000000..321b1315a0
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/data-structures.scm
@@ -0,0 +1,89 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+ ;; data structures for proc-lang/proc-rep
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  ;; expval->num : ExpVal -> Int
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  ;; expval->bool : ExpVal -> Bool
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  ;; expval->proc : ExpVal -> Proc
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  ;; proc? : SchemeVal -> Bool
+  ;; Page: 79
+  (define proc? procedure?)
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;; example of a data type built without define-datatype
+
+  (define empty-env-record
+    (lambda () 
+      '()))
+
+  (define extended-env-record
+    (lambda (sym val old-env)
+      (cons (list sym val) old-env)))
+  
+  (define empty-env-record? null?)
+  
+  (define environment?
+    (lambda (x)
+      (or (empty-env-record? x)
+          (and (pair? x)
+               (symbol? (car (car x)))
+               (expval? (cadr (car x)))
+               (environment? (cdr x))))))
+
+  (define extended-env-record->sym
+    (lambda (r)
+      (car (car r))))
+
+  (define extended-env-record->val
+    (lambda (r)
+      (cadr (car r))))
+
+  (define extended-env-record->old-env
+    (lambda (r)
+      (cdr r)))
+
+)
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/drscheme-init.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/environments.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/environments.scm
new file mode 100755
index 0000000000..6ebdfcb570
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/environments.scm
@@ -0,0 +1,53 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define empty-env
+    (lambda ()
+      (empty-env-record)))
+  
+  (define empty-env? 
+    (lambda (x)
+      (empty-env-record? x)))
+
+  (define extend-env
+    (lambda (sym val old-env)
+      (extended-env-record sym val old-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (empty-env? env)
+	(eopl:error 'apply-env "No binding for ~s" search-sym)
+	(let ((sym (extended-env-record->sym env))
+	      (val (extended-env-record->val env))
+	      (old-env (extended-env-record->old-env env)))
+	  (if (eqv? search-sym sym)
+	    val
+	    (apply-env old-env search-sym))))))
+
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/interp.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/interp.scm
new file mode 100755
index 0000000000..d46adfcaa0
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/interp.scm
@@ -0,0 +1,92 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the PROC language, using the procedural
+  ;; representation of procedures.
+
+  ;; The \commentboxes are the latex code for inserting the rules into
+  ;; the code in the book. These are too complicated to put here, see
+  ;; the text, sorry. 
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) = (apply-env \r \x{})}
+        (var-exp (var) (apply-env env var))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((val1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var val1 env))))
+        
+        (proc-exp (var body)
+          (proc-val (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of rand env)))
+            (apply-procedure proc arg)))
+
+        )))
+
+
+  ;; procedure : Var * Exp * Env -> Proc
+  ;; Page: 79
+  (define procedure
+    (lambda (var body env)
+      (lambda (val)
+        (value-of body (extend-env var val env)))))
+  
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  ;; Page: 79
+  (define apply-procedure
+    (lambda (proc val)
+      (proc val)))
+
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/lang.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/lang.scm
new file mode 100755
index 0000000000..cd0d22099d
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/lang.scm
@@ -0,0 +1,66 @@
+(module lang (lib "eopl.ss" "eopl")                
+
+  ;; grammar for the PROC language
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/tests.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/tests.scm
new file mode 100755
index 0000000000..d5cd73841d
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/tests.scm
@@ -0,0 +1,78 @@
+(module tests mzscheme
+  
+  (provide test-list)
+
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+       
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter3/proc-lang/proc-rep/top.scm b/collects/tests/eopl/chapter3/proc-lang/proc-rep/top.scm
new file mode 100755
index 0000000000..15dc52eec3
--- /dev/null
+++ b/collects/tests/eopl/chapter3/proc-lang/proc-rep/top.scm
@@ -0,0 +1,64 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : string -> expval
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : symbol -> expval
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter4/call-by-need/data-structures.scm b/collects/tests/eopl/chapter4/call-by-need/data-structures.scm
new file mode 100755
index 0000000000..70e53a2768
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/data-structures.scm
@@ -0,0 +1,126 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for call-by-need language
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+
+  (require "pairvals.scm")
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, a
+;;; reference, or a mutable pair. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    (mutpair-val
+      (p mutpair?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval->mutpair
+    (lambda (v)
+      (cases expval v
+	(mutpair-val (ref) ref)
+	(else (expval-extractor-error 'mutable-pair v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+;;;;;;;;;;;;;;;; environment data structures ;;;;;;;;;;;;;;;;
+
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval reference?)                 
+      (saved-env environment?))
+    (extend-env-rec*
+      (proc-names (list-of symbol?))
+      (b-vars (list-of symbol?))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)              ; val is a denoted value-- a
+                                        ; reference. 
+	    (env->list saved-env)))
+	(extend-env-rec* (p-names b-vars p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+;;;;;;;;;;;;;;;; thunks ;;;;;;;;;;;;;;;;
+
+  ;; a-thunk : Exp * Env -> Thunk
+  ;; thunk? : SchemeVal -> Bool
+  (define-datatype thunk thunk?
+    (a-thunk
+      (exp1 expression?)
+      (env environment?)))
+
+)
diff --git a/collects/tests/eopl/chapter4/call-by-need/drscheme-init.scm b/collects/tests/eopl/chapter4/call-by-need/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter4/call-by-need/environments.scm b/collects/tests/eopl/chapter4/call-by-need/environments.scm
new file mode 100755
index 0000000000..0befb36f13
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/environments.scm
@@ -0,0 +1,67 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+  (require "store.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; (init-env) builds an environment in which:
+  ;; i is bound to a location containing the expressed value 1, 
+  ;; v is bound to a location containing the expressed value 5, and 
+  ;; x is bound to a location containing the expressed value 10.  
+  (define init-env 
+    (lambda ()
+      (extend-env 
+        'i (newref (num-val 1))
+        (extend-env
+          'v (newref (num-val 5))
+          (extend-env
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec* (p-names b-vars p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (newref
+                    (proc-val
+                      (procedure 
+                        (list-ref b-vars n)
+                        (list-ref p-bodies n)
+                        env)))))
+            (else (apply-env saved-env search-sym)))))))
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+   (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-need/interp.scm b/collects/tests/eopl/chapter4/call-by-need/interp.scm
new file mode 100755
index 0000000000..57d94d5ee1
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/interp.scm
@@ -0,0 +1,167 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the CALL-BY-NEED language.  
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  (require "pairvals.scm")
+
+  (provide value-of-program value-of instrument-newref)
+
+;;; exercise: add instrumentation around let and procedure calls, as
+;;; in the call-by-reference language.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)             
+      (cases program pgm
+        (a-program (body)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 137 and 138
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) 
+          (let ((ref1 (apply-env env var)))
+            (let ((w (deref ref1)))
+              (if (expval? w)
+                w
+                (let ((v1 (value-of-thunk w)))
+                  (begin
+                    (setref! ref1 v1)   
+                    v1))))))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (value-of body
+              (extend-env var (newref val) env))))
+
+        (proc-exp (var body)
+	  (proc-val
+	    (procedure var body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of-operand rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (x e)
+          (begin
+            (setref!
+              (apply-env env x)
+              (value-of e env))
+            (num-val 27)))
+
+        (newpair-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (mutpair-val (make-pair v1 v2))))
+
+        (left-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (left p1))))
+
+        (setleft-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setleft p v2)
+                (num-val 82)))))
+
+        (right-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (right p1))))
+
+        (setright-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setright p v2)
+                (num-val 83)))))
+
+        )))
+
+  ;; apply-procedure : Proc * Ref -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body
+            (extend-env var arg saved-env))))))
+
+  ;; value-of-operand : Exp * Env -> Ref
+  ;; Page: 137
+  (define value-of-operand
+    (lambda (exp env)
+      (cases expression exp
+        (var-exp (var) (apply-env env var)) ; no deref!
+        (else
+          (newref (a-thunk exp env))))))
+
+  ;; value-of-thunk : Thunk -> ExpVal
+  (define value-of-thunk
+    (lambda (th)
+      (cases thunk th
+        (a-thunk (exp1 saved-env)
+          (value-of exp1 saved-env)))))
+
+  )
+  
+        
+        
+        
+        
+
+
+  
diff --git a/collects/tests/eopl/chapter4/call-by-need/lang.scm b/collects/tests/eopl/chapter4/call-by-need/lang.scm
new file mode 100755
index 0000000000..2deca9e8ae
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/lang.scm
@@ -0,0 +1,101 @@
+(module lang (lib "eopl.ss" "eopl")
+
+  ;; language for the CALL-BY-NEED language.  Based on MUTABLE-PAIRS
+  ;; language. 
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+           "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      (expression
+        ("newpair" "(" expression "," expression ")")
+        newpair-exp)
+
+      (expression
+        ("left" "(" expression ")")
+        left-exp)
+
+      (expression
+        ("setleft" expression "=" expression)
+        setleft-exp)
+
+      (expression
+        ("right" "(" expression ")")
+        right-exp)
+
+      (expression
+        ("setright" expression "=" expression)
+        setright-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-need/pairval1.scm b/collects/tests/eopl/chapter4/call-by-need/pairval1.scm
new file mode 100755
index 0000000000..703a2bb13c
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/pairval1.scm
@@ -0,0 +1,58 @@
+(module pairval1 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; represent a mutable pair as two references.
+
+  ;; Page: 124
+  (define-datatype mutpair mutpair? 
+    (a-pair
+      (left-loc reference?)
+      (right-loc reference?)))
+  
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 124
+  (define make-pair
+    (lambda (val1 val2)
+      (a-pair
+        (newref val1)
+        (newref val2))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 125
+  (define left
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref left-loc)))))
+  
+  ;; right : MutPair -> ExpVal
+  ;; Page: 125
+  (define right
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref right-loc)))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setleft
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! left-loc val)))))
+  
+  ;; setright : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setright
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! right-loc val)))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-need/pairval2.scm b/collects/tests/eopl/chapter4/call-by-need/pairval2.scm
new file mode 100755
index 0000000000..3760c1d5f4
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/pairval2.scm
@@ -0,0 +1,81 @@
+(module pairval2 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; model a mutable pair as two consecutive locations (left and
+  ;; right), and represent it as a reference to the first.
+  
+  ;; mutpair? : SchemeVal -> Bool
+  ;; Page: 129
+  ;;
+  ;; Not every reference is really a mutpair, but this test is good
+  ;; enough, because in the implicit-refs language, you
+  ;; can't get your hands on a reference otherwise.
+  (define mutpair?
+    (lambda (v)
+      (reference? v)))
+
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 129
+  (define make-pair
+    (lambda (val1 val2)
+      (let ((ref1 (newref val1)))
+        (let ((ref2 (newref val2)))
+          ref1))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 129
+  (define left                       
+    (lambda (p)
+      (deref p)))
+
+  ;; right : MutPair -> ExpVal
+  ;; Page: 129  
+  (define right
+    (lambda (p)
+      (deref (+ 1 p))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 129  
+  (define setleft
+    (lambda (p val)
+      (setref! p val)))
+  
+  ;; setright : MutPair * Expval -> Unspecified
+  ;; Page: 129  
+  (define setright
+    (lambda (p val)
+      (setref! (+ 1 p) val)))
+  
+  )
+
+
+
+;;   (define mutpair? reference?)          ; inaccurate
+
+;;   (define make-pair
+;;     (lambda (val1 val2)
+;;       (let ((ref1 (newref val1)))
+;;         (let ((ref2 (newref val2)))     ; guaranteed to be ref1 + 1
+;;           ref1))))
+  
+;;   (define left                       
+;;     (lambda (p)
+;;       (deref p)))
+  
+;;   (define right
+;;     (lambda (p)
+;;       (deref (+ 1 p))))
+  
+;;   (define setleft
+;;     (lambda (p val)
+;;       (setref! p val)))
+  
+;;   (define setright
+;;     (lambda (p val)
+;;       (setref! (+ 1 p) val)))
diff --git a/collects/tests/eopl/chapter4/call-by-need/pairvals.scm b/collects/tests/eopl/chapter4/call-by-need/pairvals.scm
new file mode 100755
index 0000000000..8f756042bb
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/pairvals.scm
@@ -0,0 +1,12 @@
+(module pairvals (lib "eopl.ss" "eopl")
+
+  ;; choose one of the following:
+  ;; (require "pairval1.scm")
+  ;; (provide (all-from "pairval1.scm"))
+
+  ;; or
+    (require "pairval2.scm")
+    (provide (all-from "pairval2.scm"))
+
+)
+
diff --git a/collects/tests/eopl/chapter4/call-by-need/store.scm b/collects/tests/eopl/chapter4/call-by-need/store.scm
new file mode 100755
index 0000000000..26fde20fe6
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/store.scm
@@ -0,0 +1,113 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  ;(require "data-structures.scm")
+  
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/call-by-need/tests.scm b/collects/tests/eopl/chapter4/call-by-need/tests.scm
new file mode 100755
index 0000000000..470258f7cb
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/tests.scm
@@ -0,0 +1,169 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;; alas, no multiplication in this language.  Exercise: define
+;; multiplication as a letrec and then use it to define factorial.
+;;      (fact-of-6  "letrec
+;;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;;  in (fact 6)" 
+;;                  720)
+
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      ;; extremely primitive testing for mutable variables
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+      
+     ;; even more primitive testing for mutable pairs
+
+      (simple-mutpair-left-1 "let p = newpair(22,33) in left(p)" 22)
+      (simple-mutpair-right-1 "let p = newpair(22,33) in right(p)" 33)
+
+      (simple-mutpair-setleft-1 "
+let p = newpair(22,33) in begin setleft p = 77; left(p) end" 77)
+
+      (simple-mutpair-setleft-2 "
+let p = newpair(22,33) in begin setleft p = 77; right(p) end" 33)
+
+
+      (simple-mutpair-setright-1 "
+let p = newpair(22,33) in begin setright p = 77; right(p) end" 77)
+
+      (simple-mutpair-setright-2 "
+let p = newpair(22,33) in begin setright p = 77; left(p) end" 22)
+
+
+
+      (gensym-using-mutable-pair-left
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setleft count = -(left(count), -1);
+               left(count)
+              end
+in -((g 22), (g 22))"
+-1)
+
+      (gensym-using-mutable-pair-right
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setright count = -(right(count), -1);
+               right(count)
+              end
+in -((g 22), (g 22))"
+-1)
+
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/call-by-need/top.scm b/collects/tests/eopl/chapter4/call-by-need/top.scm
new file mode 100755
index 0000000000..587d50aea6
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-need/top.scm
@@ -0,0 +1,63 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter4/call-by-reference/data-structures.scm b/collects/tests/eopl/chapter4/call-by-reference/data-structures.scm
new file mode 100755
index 0000000000..0992f7aee3
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/data-structures.scm
@@ -0,0 +1,117 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  ;; data structures for call-by-reference language
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+
+  (require "pairvals.scm")
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, a
+;;; reference, or a mutable pair. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    (mutpair-val
+      (p mutpair?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval->mutpair
+    (lambda (v)
+      (cases expval v
+	(mutpair-val (ref) ref)
+	(else (expval-extractor-error 'mutable-pair v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+;;;;;;;;;;;;;;;; environment data structures ;;;;;;;;;;;;;;;;
+
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval reference?)                 
+      (saved-env environment?))
+    (extend-env-rec*
+      (proc-names (list-of symbol?))
+      (b-vars (list-of symbol?))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)              ; val is a denoted value-- a
+                                        ; reference. 
+	    (env->list saved-env)))
+	(extend-env-rec* (p-names b-vars p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/call-by-reference/drscheme-init.scm b/collects/tests/eopl/chapter4/call-by-reference/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter4/call-by-reference/environments.scm b/collects/tests/eopl/chapter4/call-by-reference/environments.scm
new file mode 100755
index 0000000000..a27e5bd792
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/environments.scm
@@ -0,0 +1,64 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (require "store.scm")
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+
+  ;; init-env : () -> Env
+  ;; (init-env) builds an environment in which:
+  ;; i is bound to a location containing the expressed value 1, 
+  ;; v is bound to a location containing the expressed value 5, and 
+  ;; x is bound to a location containing the expressed value 10.  
+  (define init-env 
+    (lambda ()
+      (extend-env 
+        'i (newref (num-val 1))
+        (extend-env
+          'v (newref (num-val 5))
+          (extend-env
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec* (p-names b-vars p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (newref
+                    (proc-val
+                      (procedure 
+                        (list-ref b-vars n)
+                        (list-ref p-bodies n)
+                        env)))))
+            (else (apply-env saved-env search-sym)))))))
+
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-reference/interp.scm b/collects/tests/eopl/chapter4/call-by-reference/interp.scm
new file mode 100755
index 0000000000..8535a8add9
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/interp.scm
@@ -0,0 +1,208 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the CALL-BY-REFERENCE language
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  (require "pairvals.scm")
+
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)             
+      (cases program pgm
+        (a-program (body)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 132
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (deref (apply-env env var)))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+
+        ;; straightforward version of LET, without instrumentation
+        ;; (let-exp (id rhs body)       
+        ;;   (let ((val (value-of rhs env)))
+        ;;     (value-of body
+        ;;       (extend-env id (newref val) env))))
+
+        ;; LET with instrumentation
+       (let-exp (var exp1 body)       
+	  (if (instrument-let)
+	    (eopl:printf "entering let ~s~%" var))
+          (let ((val (value-of exp1 env)))
+	    (let ((new-env (extend-env var (newref val) env)))
+	      (if (instrument-let)
+		(begin
+		  (eopl:printf "entering body of let ~s with env =~%" var)
+		  (pretty-print (env->list new-env))
+		  (eopl:printf "store =~%")
+		  (pretty-print (store->readable (get-store-as-list)))
+		  (eopl:printf "~%")
+		  ))
+	      (value-of body new-env))))
+
+        (proc-exp (var body)
+	  (proc-val
+	    (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of-operand rand env)))
+            (apply-procedure proc arg)))
+
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (x e)
+          (begin
+            (setref!
+              (apply-env env x)
+              (value-of e env))
+            (num-val 27)))
+
+        (newpair-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (mutpair-val (make-pair v1 v2))))
+
+        (left-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (left p1))))
+
+        (setleft-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setleft p v2)
+                (num-val 82)))))
+
+        (right-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (right p1))))
+
+        (setright-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setright p v2)
+                (num-val 83)))))
+
+        )))
+
+  ;; apply-procedure : Proc * Ref -> ExpVal
+  ;; uninstrumented version
+  ;; Page: 132
+  ;;   (define apply-procedure
+  ;;     (lambda (proc1 val)
+  ;;       (cases proc proc1
+  ;;         (procedure (var body saved-env)
+  ;;           (value-of body
+  ;;             (extend-env var val saved-env))))))
+  
+
+  ;; apply-procedure : Proc * Ref -> ExpVal
+  ;; instrumented version
+  (define apply-procedure
+    (lambda (proc1 val)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (let ((new-env (extend-env var val saved-env)))
+	    (if (instrument-let)
+	      (begin
+	        (eopl:printf
+		  "entering body of proc ~s with env =~%"
+		   var)
+		(pretty-print (env->list new-env))
+                (eopl:printf "store =~%")
+                (pretty-print (store->readable (get-store-as-list)))
+		(eopl:printf "~%")))
+	      (value-of body new-env))))))
+
+
+  ;; value-of-rand : Exp * Env -> Ref
+  ;; Page: 132
+  ;; if the expression is a var-exp, then pass the reference.
+  ;; otherwise, evaluate the expression and pass a reference to a new
+  ;; cell. 
+
+  (define value-of-operand
+    (lambda (exp env)
+      (cases expression exp
+        (var-exp (var) (apply-env env var)) 
+        (else
+          (newref (value-of exp env))))))
+    
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (list
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter4/call-by-reference/lang.scm b/collects/tests/eopl/chapter4/call-by-reference/lang.scm
new file mode 100755
index 0000000000..b8f9a3799f
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/lang.scm
@@ -0,0 +1,100 @@
+(module lang (lib "eopl.ss" "eopl")                
+
+  ;; language for CALL-BY-REFERENCE.  Based on MUTABLE-PAIRS.
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+           "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      (expression
+        ("newpair" "(" expression "," expression ")")
+        newpair-exp)
+
+      (expression
+        ("left" "(" expression ")")
+        left-exp)
+
+      (expression
+        ("setleft" expression "=" expression)
+        setleft-exp)
+
+      (expression
+        ("right" "(" expression ")")
+        right-exp)
+
+      (expression
+        ("setright" expression "=" expression)
+        setright-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-reference/pairval1.scm b/collects/tests/eopl/chapter4/call-by-reference/pairval1.scm
new file mode 100755
index 0000000000..703a2bb13c
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/pairval1.scm
@@ -0,0 +1,58 @@
+(module pairval1 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; represent a mutable pair as two references.
+
+  ;; Page: 124
+  (define-datatype mutpair mutpair? 
+    (a-pair
+      (left-loc reference?)
+      (right-loc reference?)))
+  
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 124
+  (define make-pair
+    (lambda (val1 val2)
+      (a-pair
+        (newref val1)
+        (newref val2))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 125
+  (define left
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref left-loc)))))
+  
+  ;; right : MutPair -> ExpVal
+  ;; Page: 125
+  (define right
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref right-loc)))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setleft
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! left-loc val)))))
+  
+  ;; setright : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setright
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! right-loc val)))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/call-by-reference/pairval2.scm b/collects/tests/eopl/chapter4/call-by-reference/pairval2.scm
new file mode 100755
index 0000000000..3760c1d5f4
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/pairval2.scm
@@ -0,0 +1,81 @@
+(module pairval2 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; model a mutable pair as two consecutive locations (left and
+  ;; right), and represent it as a reference to the first.
+  
+  ;; mutpair? : SchemeVal -> Bool
+  ;; Page: 129
+  ;;
+  ;; Not every reference is really a mutpair, but this test is good
+  ;; enough, because in the implicit-refs language, you
+  ;; can't get your hands on a reference otherwise.
+  (define mutpair?
+    (lambda (v)
+      (reference? v)))
+
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 129
+  (define make-pair
+    (lambda (val1 val2)
+      (let ((ref1 (newref val1)))
+        (let ((ref2 (newref val2)))
+          ref1))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 129
+  (define left                       
+    (lambda (p)
+      (deref p)))
+
+  ;; right : MutPair -> ExpVal
+  ;; Page: 129  
+  (define right
+    (lambda (p)
+      (deref (+ 1 p))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 129  
+  (define setleft
+    (lambda (p val)
+      (setref! p val)))
+  
+  ;; setright : MutPair * Expval -> Unspecified
+  ;; Page: 129  
+  (define setright
+    (lambda (p val)
+      (setref! (+ 1 p) val)))
+  
+  )
+
+
+
+;;   (define mutpair? reference?)          ; inaccurate
+
+;;   (define make-pair
+;;     (lambda (val1 val2)
+;;       (let ((ref1 (newref val1)))
+;;         (let ((ref2 (newref val2)))     ; guaranteed to be ref1 + 1
+;;           ref1))))
+  
+;;   (define left                       
+;;     (lambda (p)
+;;       (deref p)))
+  
+;;   (define right
+;;     (lambda (p)
+;;       (deref (+ 1 p))))
+  
+;;   (define setleft
+;;     (lambda (p val)
+;;       (setref! p val)))
+  
+;;   (define setright
+;;     (lambda (p val)
+;;       (setref! (+ 1 p) val)))
diff --git a/collects/tests/eopl/chapter4/call-by-reference/pairvals.scm b/collects/tests/eopl/chapter4/call-by-reference/pairvals.scm
new file mode 100755
index 0000000000..8f756042bb
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/pairvals.scm
@@ -0,0 +1,12 @@
+(module pairvals (lib "eopl.ss" "eopl")
+
+  ;; choose one of the following:
+  ;; (require "pairval1.scm")
+  ;; (provide (all-from "pairval1.scm"))
+
+  ;; or
+    (require "pairval2.scm")
+    (provide (all-from "pairval2.scm"))
+
+)
+
diff --git a/collects/tests/eopl/chapter4/call-by-reference/store.scm b/collects/tests/eopl/chapter4/call-by-reference/store.scm
new file mode 100755
index 0000000000..26fde20fe6
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/store.scm
@@ -0,0 +1,113 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  ;(require "data-structures.scm")
+  
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/call-by-reference/tests.scm b/collects/tests/eopl/chapter4/call-by-reference/tests.scm
new file mode 100755
index 0000000000..a4aa2958e8
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/tests.scm
@@ -0,0 +1,240 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+      
+      (simple-mutpair-left-1 "let p = newpair(22,33) in left(p)" 22)
+      (simple-mutpair-right-1 "let p = newpair(22,33) in right(p)" 33)
+
+      (simple-mutpair-setleft-1 "
+let p = newpair(22,33) in begin setleft p = 77; left(p) end" 77)
+
+      (simple-mutpair-setleft-2 "
+let p = newpair(22,33) in begin setleft p = 77; right(p) end" 33)
+
+
+      (simple-mutpair-setright-1 "
+let p = newpair(22,33) in begin setright p = 77; right(p) end" 77)
+
+      (simple-mutpair-setright-2 "
+let p = newpair(22,33) in begin setright p = 77; left(p) end" 22)
+
+      (gensym-using-mutable-pair-left
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setleft count = -(left(count), -1);
+               left(count)
+              end
+in -((g 22), (g 22))"
+-1)
+
+      (gensym-using-mutable-pair-right
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setright count = -(right(count), -1);
+               right(count)
+              end
+in -((g 22), (g 22))"
+-1)
+      
+      ;; new for call-by-reference
+
+      (cbr-swap-1
+        "let swap = proc (x) proc (y)
+                      let temp = x
+                      in begin 
+                          set x = y;
+                          set y = temp
+                         end
+         in let a = 33
+         in let b = 44
+         in begin
+             ((swap a) b);
+             -(a,b)
+            end"
+        11)
+
+      (cbr-global-aliasing-1
+        "let p = proc (z) set z = 44
+         in let x = 33
+         in begin (p x); x end"
+        44)
+
+      (cbr-direct-aliasing-1
+        "let p = proc (x) proc (y)
+                   begin
+                    set x = 44;
+                    y
+                   end
+         in let b = 33
+         in ((p b) b)"
+        44)
+
+      (cbr-indirect-aliasing-1
+        ;; in this language, you can't return a reference.
+        "let p = proc (x) proc (y)
+                   begin
+                    set x = 44;
+                    y
+                   end
+         in let q = proc(z) z
+         in let b = 33
+         in ((p b) (q b))"
+        33)
+
+      (cbr-indirect-aliasing-2
+        ;; in this language, you can't return a reference.
+        "let p = proc (x) proc (y)
+                   begin
+                    set x = 44;
+                    y
+                   end
+         in let q = proc(z) z
+         in let b = 33
+         in ((p (q b)) b)"
+        33)
+
+      (cbr-sideeffect-a-passed-structure-1
+        "let f = proc (x) setleft x = -(left(x),-1)
+         in let p = newpair (44,newpair(55,66))
+         in begin
+              (f right(p));
+              left(right(p))
+            end"
+        56)
+
+      (cbr-example-for-book "
+let f = proc (x) set x = 44
+in let g = proc (y) (f y)
+in let z = 55
+in begin
+    (g z);
+    z
+  end"
+        44)
+
+
+      ))
+
+  
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/call-by-reference/top.scm b/collects/tests/eopl/chapter4/call-by-reference/top.scm
new file mode 100755
index 0000000000..f56b397217
--- /dev/null
+++ b/collects/tests/eopl/chapter4/call-by-reference/top.scm
@@ -0,0 +1,64 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter4/explicit-refs/data-structures.scm b/collects/tests/eopl/chapter4/explicit-refs/data-structures.scm
new file mode 100755
index 0000000000..cdb519884f
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/data-structures.scm
@@ -0,0 +1,103 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; reference. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-rec*
+      (proc-names (list-of symbol?))
+      (b-vars (list-of symbol?))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym (expval->printable val))
+	    (env->list saved-env)))
+	(extend-env-rec* (p-names b-vars p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/explicit-refs/drscheme-init.scm b/collects/tests/eopl/chapter4/explicit-refs/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter4/explicit-refs/environments.scm b/collects/tests/eopl/chapter4/explicit-refs/environments.scm
new file mode 100755
index 0000000000..d13ffbc08c
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/environments.scm
@@ -0,0 +1,63 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+
+
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec* (p-names b-vars p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (proc-val
+                    (procedure 
+                      (list-ref b-vars n)
+                      (list-ref p-bodies n)
+                      env))))
+            (else (apply-env saved-env search-sym)))))))
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/explicit-refs/interp.scm b/collects/tests/eopl/chapter4/explicit-refs/interp.scm
new file mode 100755
index 0000000000..1c6375bb01
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/interp.scm
@@ -0,0 +1,156 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the EXPLICIT-REFS language
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  ;; Page: 110
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)               ; new for explicit refs.
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 113
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) = (apply-env \r \x{})}
+        (var-exp (var) (apply-env env var))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+      
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((val1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var val1 env))))
+        
+        (proc-exp (var body)
+          (proc-val (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of rand env)))
+            (apply-procedure proc arg)))
+
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (newref-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (ref-val (newref v1))))
+
+        (deref-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((ref1 (expval->ref v1)))
+              (deref ref1))))
+
+        (setref-exp (exp1 exp2)
+          (let ((ref (expval->ref (value-of exp1 env))))
+            (let ((v2 (value-of exp2 env)))
+              (begin
+                (setref! ref v2)
+                (num-val 23)))))
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  ;; 
+  ;; uninstrumented version
+  ;;   (define apply-procedure
+  ;;    (lambda (proc1 arg)
+  ;;      (cases proc proc1
+  ;;        (procedure (bvar body saved-env)
+  ;;          (value-of body (extend-env bvar arg saved-env))))))
+
+  ;; instrumented version
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+	  (let ((r arg))
+	    (let ((new-env (extend-env var r saved-env)))
+	      (if (instrument-let)
+		(begin
+		  (eopl:printf
+		    "entering body of proc ~s with env =~%"
+		    var)
+		  (pretty-print (env->list new-env))
+                  (eopl:printf "store =~%")
+                  (pretty-print (store->readable (get-store-as-list)))
+                  (eopl:printf "~%")))
+              (value-of body new-env)))))))
+
+
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (cons
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+ 
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter4/explicit-refs/lang.scm b/collects/tests/eopl/chapter4/explicit-refs/lang.scm
new file mode 100755
index 0000000000..5e454be2c3
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/lang.scm
@@ -0,0 +1,90 @@
+(module lang (lib "eopl.ss" "eopl")                
+
+  ;; language for EXPLICIT-REFS
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+           "in" expression)
+        letrec-exp)
+      
+      ;; new for explicit-refs
+
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("newref" "(" expression ")")
+        newref-exp)
+
+      (expression
+        ("deref" "(" expression ")")
+        deref-exp)
+
+      (expression
+        ("setref" "(" expression "," expression ")")
+        setref-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter4/explicit-refs/store.scm b/collects/tests/eopl/chapter4/explicit-refs/store.scm
new file mode 100755
index 0000000000..f925bdcbda
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/store.scm
@@ -0,0 +1,110 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+   
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/explicit-refs/tests.scm b/collects/tests/eopl/chapter4/explicit-refs/tests.scm
new file mode 100755
index 0000000000..2c577959f3
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/tests.scm
@@ -0,0 +1,163 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      (gensym-test-1 
+"let g = let counter = newref(0) 
+         in proc (dummy) let d = setref(counter, -(deref(counter),-1))
+                    in deref(counter)
+in -((g 11),(g 22))"
+       -1)
+
+      (simple-store-test-1 "let x = newref(17) in deref(x)" 17)
+
+      (assignment-test-1 "let x = newref(17) 
+                          in begin setref(x,27); deref(x) end"
+        27)
+
+      (gensym-test-2 
+"let g = let counter = newref(0) 
+         in proc (dummy) begin
+                           setref(counter, -(deref(counter),-1));
+                           deref(counter)
+                         end
+ in -((g 11),(g 22))"
+       -1)
+
+     (even-odd-via-set-1 "
+let x = newref(0)
+in letrec even(d) = if zero?(deref(x)) 
+                   then 1
+                   else let d = setref(x, -(deref(x),1))
+                        in (odd d)
+          odd(d)  = if zero?(deref(x)) 
+                   then 0
+                   else let d = setref(x, -(deref(x),1))
+                        in (even d)
+   in let d = setref(x,13) in (odd -100)" 1)
+
+ (even-odd-via-set-1 "
+let x = newref(0)
+in letrec even(d) = if zero?(deref(x)) 
+                   then 1
+                   else let d = setref(x, -(deref(x),1))
+                        in (odd d)
+          odd(d)  = if zero?(deref(x)) 
+                   then 0
+                   else let d = setref(x, -(deref(x),1))
+                        in (even d)
+   in let d = setref(x,13) in (odd -100)" 1)
+
+ (show-allocation-1 "
+let x = newref(22)
+in let f = proc (z) let zz = newref(-(z,deref(x))) in deref(zz)
+   in -((f 66), (f 55))"
+   11)
+
+ (chains-1 "
+let x = newref(newref(0))
+in begin 
+    setref(deref(x), 11);
+    deref(deref(x))
+   end"
+   11)
+      
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/explicit-refs/top.scm b/collects/tests/eopl/chapter4/explicit-refs/top.scm
new file mode 100755
index 0000000000..f56b397217
--- /dev/null
+++ b/collects/tests/eopl/chapter4/explicit-refs/top.scm
@@ -0,0 +1,64 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter4/implicit-refs/data-structures.scm b/collects/tests/eopl/chapter4/implicit-refs/data-structures.scm
new file mode 100755
index 0000000000..84ae68533f
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/data-structures.scm
@@ -0,0 +1,103 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; reference. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+(define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval reference?)                 ; new for implicit-refs
+      (saved-env environment?))
+    (extend-env-rec*
+      (proc-names (list-of symbol?))
+      (b-vars (list-of symbol?))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)              ; val is a denoted value-- a
+                                        ; reference. 
+	    (env->list saved-env)))
+	(extend-env-rec* (p-names b-vars p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/implicit-refs/drscheme-init.scm b/collects/tests/eopl/chapter4/implicit-refs/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter4/implicit-refs/environments.scm b/collects/tests/eopl/chapter4/implicit-refs/environments.scm
new file mode 100755
index 0000000000..a8a17f1864
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/environments.scm
@@ -0,0 +1,63 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (require "store.scm")
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; (init-env) builds an environment in which:
+  ;; i is bound to a location containing the expressed value 1, 
+  ;; v is bound to a location containing the expressed value 5, and 
+  ;; x is bound to a location containing the expressed value 10.  
+  (define init-env 
+    (lambda ()
+      (extend-env 
+        'i (newref (num-val 1))
+        (extend-env
+          'v (newref (num-val 5))
+          (extend-env
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-var)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-var))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-var bvar)
+	    bval
+	    (apply-env saved-env search-var)))
+        (extend-env-rec* (p-names b-vars p-bodies saved-env)
+          (let ((n (location search-var p-names)))
+            ;; n : (maybe int)
+            (if n
+              (newref
+                (proc-val
+                  (procedure 
+                    (list-ref b-vars n)
+                    (list-ref p-bodies n)
+                    env)))
+              (apply-env saved-env search-var)))))))
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/implicit-refs/interp.scm b/collects/tests/eopl/chapter4/implicit-refs/interp.scm
new file mode 100755
index 0000000000..2336af0beb
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/interp.scm
@@ -0,0 +1,150 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the IMPLICIT-REFS language
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of exp1 (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 118, 119
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        ;\commentbox{ (value-of (const-exp \n{}) \r) = \n{}}
+        (const-exp (num) (num-val num))
+
+        ;\commentbox{ (value-of (var-exp \x{}) \r) 
+        ;              = (deref (apply-env \r \x{}))}
+        (var-exp (var) (deref (apply-env env var)))
+
+        ;\commentbox{\diffspec}
+        (diff-exp (exp1 exp2)
+          (let ((val1 (value-of exp1 env))
+                (val2 (value-of exp2 env)))
+            (let ((num1 (expval->num val1))
+                  (num2 (expval->num val2)))
+              (num-val
+                (- num1 num2)))))
+
+        ;\commentbox{\zerotestspec}
+        (zero?-exp (exp1)
+          (let ((val1 (value-of exp1 env)))
+            (let ((num1 (expval->num val1)))
+              (if (zero? num1)
+                (bool-val #t)
+                (bool-val #f)))))
+              
+        ;\commentbox{\ma{\theifspec}}
+        (if-exp (exp1 exp2 exp3)
+          (let ((val1 (value-of exp1 env)))
+            (if (expval->bool val1)
+              (value-of exp2 env)
+              (value-of exp3 env))))
+
+        ;\commentbox{\ma{\theletspecsplit}}
+        (let-exp (var exp1 body)       
+          (let ((v1 (value-of exp1 env)))
+            (value-of body
+              (extend-env var (newref v1) env))))
+        
+        (proc-exp (var body)
+          (proc-val (procedure var body env)))
+
+        (call-exp (rator rand)
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg (value-of rand env)))
+            (apply-procedure proc arg)))
+
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (var exp1)
+          (begin
+            (setref!
+              (apply-env env var)
+              (value-of exp1 env))
+            (num-val 27)))
+
+        )))
+
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  ;; Page: 119
+
+  ;; uninstrumented version
+  ;;  (define apply-procedure
+  ;;    (lambda (proc1 val)
+  ;;      (cases proc proc1
+  ;;        (procedure (var body saved-env)
+  ;;          (value-of body
+  ;;            (extend-env var (newref val) saved-env))))))
+  
+  ;; instrumented version
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (let ((r (newref arg)))
+            (let ((new-env (extend-env var r saved-env)))
+              (if (instrument-let)
+                (begin
+                  (eopl:printf
+                    "entering body of proc ~s with env =~%"
+                    var)
+                  (pretty-print (env->list new-env)) 
+                  (eopl:printf "store =~%")
+                  (pretty-print (store->readable (get-store-as-list)))
+                  (eopl:printf "~%")))
+              (value-of body new-env)))))))  
+
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (list
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter4/implicit-refs/lang.scm b/collects/tests/eopl/chapter4/implicit-refs/lang.scm
new file mode 100755
index 0000000000..15cd34385b
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/lang.scm
@@ -0,0 +1,82 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; language for IMPLICIT-REFS
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+           "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      ;; new for implicit-refs
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter4/implicit-refs/store.scm b/collects/tests/eopl/chapter4/implicit-refs/store.scm
new file mode 100755
index 0000000000..343d002484
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/store.scm
@@ -0,0 +1,110 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/implicit-refs/tests.scm b/collects/tests/eopl/chapter4/implicit-refs/tests.scm
new file mode 100755
index 0000000000..598367480e
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/tests.scm
@@ -0,0 +1,136 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      ;; extremely primitive testing for mutable variables
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+
+      (example-for-book-1 "
+let f = proc (x) proc (y) 
+                  begin
+                   set x = -(x,-1);
+                   -(x,y)
+                  end
+in ((f 44) 33)"
+	12)
+      
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/implicit-refs/top.scm b/collects/tests/eopl/chapter4/implicit-refs/top.scm
new file mode 100755
index 0000000000..0b03743921
--- /dev/null
+++ b/collects/tests/eopl/chapter4/implicit-refs/top.scm
@@ -0,0 +1,62 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/data-structures.scm b/collects/tests/eopl/chapter4/mutable-pairs/data-structures.scm
new file mode 100755
index 0000000000..0b27234de6
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/data-structures.scm
@@ -0,0 +1,115 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+
+  (require "pairvals.scm")
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; reference. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    (mutpair-val
+      (p mutpair?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval->mutpair
+    (lambda (v)
+      (cases expval v
+	(mutpair-val (ref) ref)
+	(else (expval-extractor-error 'mutable-pair v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+;;;;;;;;;;;;;;;; environment data structures ;;;;;;;;;;;;;;;;
+
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval reference?)                 ; new for implicit-refs
+      (saved-env environment?))
+    (extend-env-rec*
+      (proc-names (list-of symbol?))
+      (b-vars (list-of symbol?))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)              ; val is a denoted value-- a
+                                        ; reference. 
+	    (env->list saved-env)))
+	(extend-env-rec* (p-names b-vars p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/drscheme-init.scm b/collects/tests/eopl/chapter4/mutable-pairs/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/environments.scm b/collects/tests/eopl/chapter4/mutable-pairs/environments.scm
new file mode 100755
index 0000000000..b4e1fdf699
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/environments.scm
@@ -0,0 +1,60 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (require "store.scm")
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+        'i (newref (num-val 1))
+        (extend-env
+          'v (newref (num-val 5))
+          (extend-env
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec* (p-names b-vars p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (newref
+                    (proc-val
+                      (procedure 
+                        (list-ref b-vars n)
+                        (list-ref p-bodies n)
+                        env)))))
+            (else (apply-env saved-env search-sym)))))))
+
+
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+
+  )
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/interp.scm b/collects/tests/eopl/chapter4/mutable-pairs/interp.scm
new file mode 100755
index 0000000000..c5cd4a4268
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/interp.scm
@@ -0,0 +1,187 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; interpreter for the MUTABLE-PAIRS language
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  (require "pairvals.scm")
+
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)             
+      (cases program pgm
+        (a-program (body)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 126
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (deref (apply-env env var)))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+;;; Uninstrumented version
+;;;         (let-exp (id rhs body)       
+;;;           (let ((val (value-of rhs env)))
+;;;             (value-of body
+;;;               (extend-env id (newref val) env))))
+
+       (let-exp (var exp1 body)       
+	  (if (instrument-let)
+	    (eopl:printf "entering let ~s~%" var))
+          (let ((val (value-of exp1 env)))
+	    (let ((new-env (extend-env var (newref val) env)))
+	      (if (instrument-let)
+		(begin
+		  (eopl:printf "entering body of let ~s with env =~%" var)
+		  (pretty-print (env->list new-env))
+		  (eopl:printf "store =~%")
+		  (pretty-print (store->readable (get-store-as-list)))
+		  (eopl:printf "~%")
+		  ))
+	      (value-of body new-env))))
+
+        (proc-exp (var body)
+	  (proc-val
+	    (procedure var body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (x e)
+          (begin
+            (setref!
+              (apply-env env x)
+              (value-of e env))
+            (num-val 27)))
+
+        (newpair-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (mutpair-val (make-pair v1 v2))))
+
+        (left-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (left p1))))
+
+        (right-exp (exp1)
+          (let ((v1 (value-of exp1 env)))
+            (let ((p1 (expval->mutpair v1)))
+              (right p1))))
+
+        (setleft-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setleft p v2)
+                (num-val 82)))))
+
+        (setright-exp (exp1 exp2)
+          (let ((v1 (value-of exp1 env))
+                (v2 (value-of exp2 env)))
+            (let ((p (expval->mutpair v1)))
+              (begin
+                (setright p v2)
+                (num-val 83)))))
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+;;   (define apply-procedure
+;;     (lambda (proc1 arg)
+;;       (cases proc proc1
+;;         (procedure (bvar body saved-env)
+;;           (value-of body
+;;             (extend-env bvar (newref arg) saved-env))))))
+
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+	  (let ((r (newref arg)))
+	    (let ((new-env (extend-env var r saved-env)))
+	      (if (instrument-let)
+		(begin
+		  (eopl:printf
+		    "entering body of proc ~s with env =~%"
+		    var)
+		  (pretty-print (env->list new-env))
+                  (eopl:printf "store =~%")
+                  (pretty-print (store->readable (get-store-as-list)))
+		  (eopl:printf "~%")))
+	      (value-of body new-env)))))))
+
+  
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (list
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+  
+  )
+  
+
+  
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/lang.scm b/collects/tests/eopl/chapter4/mutable-pairs/lang.scm
new file mode 100755
index 0000000000..cff46d4d4e
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/lang.scm
@@ -0,0 +1,102 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; language for MUTABLE-PAIRS
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+           "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      ;; new for mutable-pairs
+
+      (expression
+        ("newpair" "(" expression "," expression ")")
+        newpair-exp)
+
+      (expression
+        ("left" "(" expression ")")
+        left-exp)
+
+      (expression
+        ("setleft" expression "=" expression)
+        setleft-exp)
+
+      (expression
+        ("right" "(" expression ")")
+        right-exp)
+
+      (expression
+        ("setright" expression "=" expression)
+        setright-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/pairval1.scm b/collects/tests/eopl/chapter4/mutable-pairs/pairval1.scm
new file mode 100755
index 0000000000..703a2bb13c
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/pairval1.scm
@@ -0,0 +1,58 @@
+(module pairval1 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; represent a mutable pair as two references.
+
+  ;; Page: 124
+  (define-datatype mutpair mutpair? 
+    (a-pair
+      (left-loc reference?)
+      (right-loc reference?)))
+  
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 124
+  (define make-pair
+    (lambda (val1 val2)
+      (a-pair
+        (newref val1)
+        (newref val2))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 125
+  (define left
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref left-loc)))))
+  
+  ;; right : MutPair -> ExpVal
+  ;; Page: 125
+  (define right
+    (lambda (p)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (deref right-loc)))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setleft
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! left-loc val)))))
+  
+  ;; setright : MutPair * ExpVal -> Unspecified
+  ;; Page: 125
+  (define setright
+    (lambda (p val)
+      (cases mutpair p
+        (a-pair (left-loc right-loc)
+          (setref! right-loc val)))))
+
+  )
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/pairval2.scm b/collects/tests/eopl/chapter4/mutable-pairs/pairval2.scm
new file mode 100755
index 0000000000..3760c1d5f4
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/pairval2.scm
@@ -0,0 +1,81 @@
+(module pairval2 (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "store.scm")
+  
+  (provide (all-defined))
+  
+  ;;;;;;;;;;;;;;;; mutable pairs ;;;;;;;;;;;;;;;;
+  
+  ;; model a mutable pair as two consecutive locations (left and
+  ;; right), and represent it as a reference to the first.
+  
+  ;; mutpair? : SchemeVal -> Bool
+  ;; Page: 129
+  ;;
+  ;; Not every reference is really a mutpair, but this test is good
+  ;; enough, because in the implicit-refs language, you
+  ;; can't get your hands on a reference otherwise.
+  (define mutpair?
+    (lambda (v)
+      (reference? v)))
+
+  ;; make-pair : ExpVal * ExpVal -> MutPair
+  ;; Page: 129
+  (define make-pair
+    (lambda (val1 val2)
+      (let ((ref1 (newref val1)))
+        (let ((ref2 (newref val2)))
+          ref1))))
+  
+  ;; left : MutPair -> ExpVal
+  ;; Page: 129
+  (define left                       
+    (lambda (p)
+      (deref p)))
+
+  ;; right : MutPair -> ExpVal
+  ;; Page: 129  
+  (define right
+    (lambda (p)
+      (deref (+ 1 p))))
+  
+  ;; setleft : MutPair * ExpVal -> Unspecified
+  ;; Page: 129  
+  (define setleft
+    (lambda (p val)
+      (setref! p val)))
+  
+  ;; setright : MutPair * Expval -> Unspecified
+  ;; Page: 129  
+  (define setright
+    (lambda (p val)
+      (setref! (+ 1 p) val)))
+  
+  )
+
+
+
+;;   (define mutpair? reference?)          ; inaccurate
+
+;;   (define make-pair
+;;     (lambda (val1 val2)
+;;       (let ((ref1 (newref val1)))
+;;         (let ((ref2 (newref val2)))     ; guaranteed to be ref1 + 1
+;;           ref1))))
+  
+;;   (define left                       
+;;     (lambda (p)
+;;       (deref p)))
+  
+;;   (define right
+;;     (lambda (p)
+;;       (deref (+ 1 p))))
+  
+;;   (define setleft
+;;     (lambda (p val)
+;;       (setref! p val)))
+  
+;;   (define setright
+;;     (lambda (p val)
+;;       (setref! (+ 1 p) val)))
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/pairvals.scm b/collects/tests/eopl/chapter4/mutable-pairs/pairvals.scm
new file mode 100755
index 0000000000..8f756042bb
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/pairvals.scm
@@ -0,0 +1,12 @@
+(module pairvals (lib "eopl.ss" "eopl")
+
+  ;; choose one of the following:
+  ;; (require "pairval1.scm")
+  ;; (provide (all-from "pairval1.scm"))
+
+  ;; or
+    (require "pairval2.scm")
+    (provide (all-from "pairval2.scm"))
+
+)
+
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/store.scm b/collects/tests/eopl/chapter4/mutable-pairs/store.scm
new file mode 100755
index 0000000000..47e9874050
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/store.scm
@@ -0,0 +1,112 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/tests.scm b/collects/tests/eopl/chapter4/mutable-pairs/tests.scm
new file mode 100755
index 0000000000..adc4b9050b
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/tests.scm
@@ -0,0 +1,179 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      ;; extremely primitive testing for mutable variables
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+      
+     ;; even more primitive testing for mutable pairs
+
+      (simple-mutpair-left-1 "let p = newpair(22,33) in left(p)" 22)
+      (simple-mutpair-right-1 "let p = newpair(22,33) in right(p)" 33)
+
+      (simple-mutpair-setleft-1 "
+let p = newpair(22,33) in begin setleft p = 77; left(p) end" 77)
+
+      (simple-mutpair-setleft-2 "
+let p = newpair(22,33) in begin setleft p = 77; right(p) end" 33)
+
+
+      (simple-mutpair-setright-1 "
+let p = newpair(22,33) in begin setright p = 77; right(p) end" 77)
+
+      (simple-mutpair-setright-2 "
+let p = newpair(22,33) in begin setright p = 77; left(p) end" 22)
+
+
+
+      (gensym-using-mutable-pair-left
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setleft count = -(left(count), -1);
+               left(count)
+              end
+in -((g 22), (g 22))"
+-1)
+
+      (gensym-using-mutable-pair-right
+"let g = let count = newpair(0,0) 
+         in proc (dummy) 
+              begin
+               setright count = -(right(count), -1);
+               right(count)
+              end
+in -((g 22), (g 22))"
+-1)
+
+      (example-for-mutable-pairs-section "
+let glo = newpair(11,22) 
+in let f = proc (loc) 
+            begin  % this is a comment
+             setright loc = left(loc);
+             setleft  glo = 99;
+             -(left(loc),right(loc))
+            end
+in (f glo)"
+        88)
+
+
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter4/mutable-pairs/top.scm b/collects/tests/eopl/chapter4/mutable-pairs/top.scm
new file mode 100755
index 0000000000..2fefb0cf12
--- /dev/null
+++ b/collects/tests/eopl/chapter4/mutable-pairs/top.scm
@@ -0,0 +1,64 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter5/exceptions/big-trace3.scm b/collects/tests/eopl/chapter5/exceptions/big-trace3.scm
new file mode 100755
index 0000000000..b33d4ec116
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/big-trace3.scm
@@ -0,0 +1,9100 @@
+;; full trace of example on pp 173-177.
+
+  (text-example-1.2
+      "let index 
+            = proc (n)
+               letrec inner2 (lst)
+                 % find position of n in lst else raise error
+                 % exception 
+                  = if null?(lst) then raise 99       
+                    else if zero?(-(car(lst),n)) then 0
+                    else let v = (inner2 cdr(lst))
+                         in -(v,-1)
+               in proc (lst)
+                   try (inner2 lst)
+                   catch (x) -1
+       in ((index 5) list(2, 3))"
+      -1)
+
+
+Welcome to DrScheme, version 299.400p1.
+Language: (module ...).
+drscheme-init.scm plt209.1.5 10feb2005
+lecture09/exceptions/interp.scm 15-Mar-06
+|(value-of/k
+   #(struct:let-exp
+     index
+     #(struct:proc-exp
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1)))))
+     #(struct:call-exp
+       #(struct:call-exp
+         #(struct:var-exp index)
+         #(struct:const-exp 5))
+       #(struct:const-list-exp (2 3))))
+   ((i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:end-cont))
+|(value-of/k
+   #(struct:call-exp
+     #(struct:proc-exp
+       index
+       #(struct:call-exp
+         #(struct:call-exp
+           #(struct:var-exp index)
+           #(struct:const-exp 5))
+         #(struct:const-list-exp (2 3))))
+     #(struct:proc-exp
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1))))))
+   ((i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:end-cont))
+|(value-of/k
+   #(struct:proc-exp
+     index
+     #(struct:call-exp
+       #(struct:call-exp
+         #(struct:var-exp index)
+         #(struct:const-exp 5))
+       #(struct:const-list-exp (2 3))))
+   ((i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:proc-exp
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1)))))
+     ((i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:proc-exp
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1)))))
+     ((i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont))
+   #(struct:proc-val
+     #(struct:procedure
+       index
+       #(struct:call-exp
+         #(struct:call-exp
+           #(struct:var-exp index)
+           #(struct:const-exp 5))
+         #(struct:const-list-exp (2 3)))
+       ((i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:proc-exp
+     n
+     #(struct:letrec-exp
+       inner2
+       lst
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:null?-unop)
+           #(struct:var-exp lst))
+         #(struct:raise-exp #(struct:const-exp 99))
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:zero?-unop)
+             #(struct:diff-exp
+               #(struct:unop-exp
+                 #(struct:car-unop)
+                 #(struct:var-exp lst))
+               #(struct:var-exp n)))
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))))
+       #(struct:proc-exp
+         lst
+         #(struct:try-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:var-exp lst))
+           x
+           #(struct:const-exp -1)))))
+   ((i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         index
+         #(struct:call-exp
+           #(struct:call-exp
+             #(struct:var-exp index)
+             #(struct:const-exp 5))
+           #(struct:const-list-exp (2 3)))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:end-cont)))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         index
+         #(struct:call-exp
+           #(struct:call-exp
+             #(struct:var-exp index)
+             #(struct:const-exp 5))
+           #(struct:const-list-exp (2 3)))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:end-cont))
+   #(struct:proc-val
+     #(struct:procedure
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1))))
+       ((i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:call-exp
+     #(struct:call-exp
+       #(struct:var-exp index)
+       #(struct:const-exp 5))
+     #(struct:const-list-exp (2 3)))
+   ((index
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10))))))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:end-cont))
+|(value-of/k
+   #(struct:call-exp #(struct:var-exp index) #(struct:const-exp 5))
+   ((index
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10))))))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:const-list-exp (2 3))
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:var-exp index)
+   ((index
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10))))))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:const-exp 5)
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:rator-cont
+       #(struct:const-list-exp (2 3))
+       ((index
+         #(struct:proc-val
+           #(struct:procedure
+             n
+             #(struct:letrec-exp
+               inner2
+               lst
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:null?-unop)
+                   #(struct:var-exp lst))
+                 #(struct:raise-exp #(struct:const-exp 99))
+                 #(struct:if-exp
+                   #(struct:unop-exp
+                     #(struct:zero?-unop)
+                     #(struct:diff-exp
+                       #(struct:unop-exp
+                         #(struct:car-unop)
+                         #(struct:var-exp lst))
+                       #(struct:var-exp n)))
+                   #(struct:const-exp 0)
+                   #(struct:diff-exp
+                     #(struct:call-exp
+                       #(struct:var-exp inner2)
+                       #(struct:unop-exp
+                         #(struct:cdr-unop)
+                         #(struct:var-exp lst)))
+                     #(struct:const-exp -1))))
+               #(struct:proc-exp
+                 lst
+                 #(struct:try-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:var-exp lst))
+                   x
+                   #(struct:const-exp -1))))
+             ((i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10))))))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:const-exp 5)
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:rator-cont
+       #(struct:const-list-exp (2 3))
+       ((index
+         #(struct:proc-val
+           #(struct:procedure
+             n
+             #(struct:letrec-exp
+               inner2
+               lst
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:null?-unop)
+                   #(struct:var-exp lst))
+                 #(struct:raise-exp #(struct:const-exp 99))
+                 #(struct:if-exp
+                   #(struct:unop-exp
+                     #(struct:zero?-unop)
+                     #(struct:diff-exp
+                       #(struct:unop-exp
+                         #(struct:car-unop)
+                         #(struct:var-exp lst))
+                       #(struct:var-exp n)))
+                   #(struct:const-exp 0)
+                   #(struct:diff-exp
+                     #(struct:call-exp
+                       #(struct:var-exp inner2)
+                       #(struct:unop-exp
+                         #(struct:cdr-unop)
+                         #(struct:var-exp lst)))
+                     #(struct:const-exp -1))))
+               #(struct:proc-exp
+                 lst
+                 #(struct:try-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:var-exp lst))
+                   x
+                   #(struct:const-exp -1))))
+             ((i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10))))))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:proc-val
+     #(struct:procedure
+       n
+       #(struct:letrec-exp
+         inner2
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         #(struct:proc-exp
+           lst
+           #(struct:try-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:var-exp lst))
+             x
+             #(struct:const-exp -1))))
+       ((i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:const-exp 5)
+   ((index
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10))))))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:rator-cont
+       #(struct:const-list-exp (2 3))
+       ((index
+         #(struct:proc-val
+           #(struct:procedure
+             n
+             #(struct:letrec-exp
+               inner2
+               lst
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:null?-unop)
+                   #(struct:var-exp lst))
+                 #(struct:raise-exp #(struct:const-exp 99))
+                 #(struct:if-exp
+                   #(struct:unop-exp
+                     #(struct:zero?-unop)
+                     #(struct:diff-exp
+                       #(struct:unop-exp
+                         #(struct:car-unop)
+                         #(struct:var-exp lst))
+                       #(struct:var-exp n)))
+                   #(struct:const-exp 0)
+                   #(struct:diff-exp
+                     #(struct:call-exp
+                       #(struct:var-exp inner2)
+                       #(struct:unop-exp
+                         #(struct:cdr-unop)
+                         #(struct:var-exp lst)))
+                     #(struct:const-exp -1))))
+               #(struct:proc-exp
+                 lst
+                 #(struct:try-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:var-exp lst))
+                   x
+                   #(struct:const-exp -1))))
+             ((i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10))))))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:rator-cont
+       #(struct:const-list-exp (2 3))
+       ((index
+         #(struct:proc-val
+           #(struct:procedure
+             n
+             #(struct:letrec-exp
+               inner2
+               lst
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:null?-unop)
+                   #(struct:var-exp lst))
+                 #(struct:raise-exp #(struct:const-exp 99))
+                 #(struct:if-exp
+                   #(struct:unop-exp
+                     #(struct:zero?-unop)
+                     #(struct:diff-exp
+                       #(struct:unop-exp
+                         #(struct:car-unop)
+                         #(struct:var-exp lst))
+                       #(struct:var-exp n)))
+                   #(struct:const-exp 0)
+                   #(struct:diff-exp
+                     #(struct:call-exp
+                       #(struct:var-exp inner2)
+                       #(struct:unop-exp
+                         #(struct:cdr-unop)
+                         #(struct:var-exp lst)))
+                     #(struct:const-exp -1))))
+               #(struct:proc-exp
+                 lst
+                 #(struct:try-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:var-exp lst))
+                   x
+                   #(struct:const-exp -1))))
+             ((i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10))))))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:num-val 5))
+|(value-of/k
+   #(struct:letrec-exp
+     inner2
+     lst
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:null?-unop)
+         #(struct:var-exp lst))
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))))
+     #(struct:proc-exp
+       lst
+       #(struct:try-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:var-exp lst))
+         x
+         #(struct:const-exp -1))))
+   ((n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:const-list-exp (2 3))
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:proc-exp
+     lst
+     #(struct:try-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:var-exp lst))
+       x
+       #(struct:const-exp -1)))
+   ((inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:const-list-exp (2 3))
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:const-list-exp (2 3))
+     ((index
+       #(struct:proc-val
+         #(struct:procedure
+           n
+           #(struct:letrec-exp
+             inner2
+             lst
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:null?-unop)
+                 #(struct:var-exp lst))
+               #(struct:raise-exp #(struct:const-exp 99))
+               #(struct:if-exp
+                 #(struct:unop-exp
+                   #(struct:zero?-unop)
+                   #(struct:diff-exp
+                     #(struct:unop-exp
+                       #(struct:car-unop)
+                       #(struct:var-exp lst))
+                     #(struct:var-exp n)))
+                 #(struct:const-exp 0)
+                 #(struct:diff-exp
+                   #(struct:call-exp
+                     #(struct:var-exp inner2)
+                     #(struct:unop-exp
+                       #(struct:cdr-unop)
+                       #(struct:var-exp lst)))
+                   #(struct:const-exp -1))))
+             #(struct:proc-exp
+               lst
+               #(struct:try-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:var-exp lst))
+                 x
+                 #(struct:const-exp -1))))
+           ((i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10))))))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont))
+   #(struct:proc-val
+     #(struct:procedure
+       lst
+       #(struct:try-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:var-exp lst))
+         x
+         #(struct:const-exp -1))
+       ((inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:const-list-exp (2 3))
+   ((index
+     #(struct:proc-val
+       #(struct:procedure
+         n
+         #(struct:letrec-exp
+           inner2
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           #(struct:proc-exp
+             lst
+             #(struct:try-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:var-exp lst))
+               x
+               #(struct:const-exp -1))))
+         ((i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10))))))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:try-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:var-exp lst))
+           x
+           #(struct:const-exp -1))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:end-cont)))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:try-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:var-exp lst))
+           x
+           #(struct:const-exp -1))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:end-cont))
+   #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+|(value-of/k
+   #(struct:try-exp
+     #(struct:call-exp
+       #(struct:var-exp inner2)
+       #(struct:var-exp lst))
+     x
+     #(struct:const-exp -1))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:end-cont))
+|(value-of/k
+   #(struct:call-exp
+     #(struct:var-exp inner2)
+     #(struct:var-exp lst))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:try-cont
+     x
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:var-exp inner2)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:var-exp lst)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:var-exp lst)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:proc-val
+     #(struct:procedure
+       lst
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:null?-unop)
+           #(struct:var-exp lst))
+         #(struct:raise-exp #(struct:const-exp 99))
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:zero?-unop)
+             #(struct:diff-exp
+               #(struct:unop-exp
+                 #(struct:car-unop)
+                 #(struct:var-exp lst))
+               #(struct:var-exp n)))
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))))
+       ((inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+|(value-of/k
+   #(struct:if-exp
+     #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:try-cont
+     x
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+|(apply-cont
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:bool-val #f))
+|(value-of/k
+   #(struct:if-exp
+     #(struct:unop-exp
+       #(struct:zero?-unop)
+       #(struct:diff-exp
+         #(struct:unop-exp
+           #(struct:car-unop)
+           #(struct:var-exp lst))
+         #(struct:var-exp n)))
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1)))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:try-cont
+     x
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:unop-exp
+     #(struct:zero?-unop)
+     #(struct:diff-exp
+       #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+       #(struct:var-exp n)))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:if-test-cont
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:diff-exp
+     #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+     #(struct:var-exp n))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:zero?-unop)
+     #(struct:if-test-cont
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:var-exp n)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:car-unop)
+     #(struct:diff1-cont
+       #(struct:var-exp n)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:unop-arg-cont
+         #(struct:zero?-unop)
+         #(struct:if-test-cont
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont)))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:car-unop)
+     #(struct:diff1-cont
+       #(struct:var-exp n)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:unop-arg-cont
+         #(struct:zero?-unop)
+         #(struct:if-test-cont
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont))))))
+   #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+|(apply-cont
+   #(struct:diff1-cont
+     #(struct:var-exp n)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:num-val 2))
+|(value-of/k
+   #(struct:var-exp n)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff2-cont
+     #(struct:num-val 2)
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(apply-cont
+   #(struct:diff2-cont
+     #(struct:num-val 2)
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:num-val 5))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:zero?-unop)
+     #(struct:if-test-cont
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:num-val -3))
+|(apply-cont
+   #(struct:if-test-cont
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont)))
+   #(struct:bool-val #f))
+|(value-of/k
+   #(struct:diff-exp
+     #(struct:call-exp
+       #(struct:var-exp inner2)
+       #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst)))
+     #(struct:const-exp -1))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:try-cont
+     x
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:call-exp
+     #(struct:var-exp inner2)
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst)))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:var-exp inner2)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:proc-val
+     #(struct:procedure
+       lst
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:null?-unop)
+           #(struct:var-exp lst))
+         #(struct:raise-exp #(struct:const-exp 99))
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:zero?-unop)
+             #(struct:diff-exp
+               #(struct:unop-exp
+                 #(struct:car-unop)
+                 #(struct:var-exp lst))
+               #(struct:var-exp n)))
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))))
+       ((inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:cdr-unop)
+     #(struct:rand-cont
+       #(struct:proc-val
+         #(struct:procedure
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           ((inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:cdr-unop)
+     #(struct:rand-cont
+       #(struct:proc-val
+         #(struct:procedure
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           ((inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:list-val (#(struct:num-val 3))))
+|(value-of/k
+   #(struct:if-exp
+     #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:list-val (#(struct:num-val 3))))
+|(apply-cont
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:bool-val #f))
+|(value-of/k
+   #(struct:if-exp
+     #(struct:unop-exp
+       #(struct:zero?-unop)
+       #(struct:diff-exp
+         #(struct:unop-exp
+           #(struct:car-unop)
+           #(struct:var-exp lst))
+         #(struct:var-exp n)))
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1)))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:unop-exp
+     #(struct:zero?-unop)
+     #(struct:diff-exp
+       #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+       #(struct:var-exp n)))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:if-test-cont
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:diff-exp
+     #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+     #(struct:var-exp n))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:zero?-unop)
+     #(struct:if-test-cont
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(value-of/k
+   #(struct:unop-exp #(struct:car-unop) #(struct:var-exp lst))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:var-exp n)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont)))))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:car-unop)
+     #(struct:diff1-cont
+       #(struct:var-exp n)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:unop-arg-cont
+         #(struct:zero?-unop)
+         #(struct:if-test-cont
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))
+           ((lst #(struct:list-val (#(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:diff1-cont
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:try-cont
+               x
+               #(struct:const-exp -1)
+               ((lst
+                 #(struct:list-val
+                   (#(struct:num-val 2) #(struct:num-val 3))))
+                (inner2
+                  lst
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:null?-unop)
+                      #(struct:var-exp lst))
+                    #(struct:raise-exp #(struct:const-exp 99))
+                    #(struct:if-exp
+                      #(struct:unop-exp
+                        #(struct:zero?-unop)
+                        #(struct:diff-exp
+                          #(struct:unop-exp
+                            #(struct:car-unop)
+                            #(struct:var-exp lst))
+                          #(struct:var-exp n)))
+                      #(struct:const-exp 0)
+                      #(struct:diff-exp
+                        #(struct:call-exp
+                          #(struct:var-exp inner2)
+                          #(struct:unop-exp
+                            #(struct:cdr-unop)
+                            #(struct:var-exp lst)))
+                        #(struct:const-exp -1)))))
+                (n #(struct:num-val 5))
+                (i #(struct:num-val 1))
+                (v #(struct:num-val 5))
+                (x #(struct:num-val 10)))
+               #(struct:end-cont))))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:car-unop)
+     #(struct:diff1-cont
+       #(struct:var-exp n)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:unop-arg-cont
+         #(struct:zero?-unop)
+         #(struct:if-test-cont
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))
+           ((lst #(struct:list-val (#(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:diff1-cont
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:try-cont
+               x
+               #(struct:const-exp -1)
+               ((lst
+                 #(struct:list-val
+                   (#(struct:num-val 2) #(struct:num-val 3))))
+                (inner2
+                  lst
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:null?-unop)
+                      #(struct:var-exp lst))
+                    #(struct:raise-exp #(struct:const-exp 99))
+                    #(struct:if-exp
+                      #(struct:unop-exp
+                        #(struct:zero?-unop)
+                        #(struct:diff-exp
+                          #(struct:unop-exp
+                            #(struct:car-unop)
+                            #(struct:var-exp lst))
+                          #(struct:var-exp n)))
+                      #(struct:const-exp 0)
+                      #(struct:diff-exp
+                        #(struct:call-exp
+                          #(struct:var-exp inner2)
+                          #(struct:unop-exp
+                            #(struct:cdr-unop)
+                            #(struct:var-exp lst)))
+                        #(struct:const-exp -1)))))
+                (n #(struct:num-val 5))
+                (i #(struct:num-val 1))
+                (v #(struct:num-val 5))
+                (x #(struct:num-val 10)))
+               #(struct:end-cont)))))))
+   #(struct:list-val (#(struct:num-val 3))))
+|(apply-cont
+   #(struct:diff1-cont
+     #(struct:var-exp n)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont))))))
+   #(struct:num-val 3))
+|(value-of/k
+   #(struct:var-exp n)
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff2-cont
+     #(struct:num-val 3)
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont)))))))
+|(apply-cont
+   #(struct:diff2-cont
+     #(struct:num-val 3)
+     #(struct:unop-arg-cont
+       #(struct:zero?-unop)
+       #(struct:if-test-cont
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1))
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont))))))
+   #(struct:num-val 5))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:zero?-unop)
+     #(struct:if-test-cont
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:num-val -2))
+|(apply-cont
+   #(struct:if-test-cont
+     #(struct:const-exp 0)
+     #(struct:diff-exp
+       #(struct:call-exp
+         #(struct:var-exp inner2)
+         #(struct:unop-exp
+           #(struct:cdr-unop)
+           #(struct:var-exp lst)))
+       #(struct:const-exp -1))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont))))
+   #(struct:bool-val #f))
+|(value-of/k
+   #(struct:diff-exp
+     #(struct:call-exp
+       #(struct:var-exp inner2)
+       #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst)))
+     #(struct:const-exp -1))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(value-of/k
+   #(struct:call-exp
+     #(struct:var-exp inner2)
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst)))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:var-exp inner2)
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rator-cont
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(apply-cont
+   #(struct:rator-cont
+     #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:proc-val
+     #(struct:procedure
+       lst
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:null?-unop)
+           #(struct:var-exp lst))
+         #(struct:raise-exp #(struct:const-exp 99))
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:zero?-unop)
+             #(struct:diff-exp
+               #(struct:unop-exp
+                 #(struct:car-unop)
+                 #(struct:var-exp lst))
+               #(struct:var-exp n)))
+           #(struct:const-exp 0)
+           #(struct:diff-exp
+             #(struct:call-exp
+               #(struct:var-exp inner2)
+               #(struct:unop-exp
+                 #(struct:cdr-unop)
+                 #(struct:var-exp lst)))
+             #(struct:const-exp -1))))
+       ((inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10))))))
+|(value-of/k
+   #(struct:unop-exp #(struct:cdr-unop) #(struct:var-exp lst))
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst #(struct:list-val (#(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:cdr-unop)
+     #(struct:rand-cont
+       #(struct:proc-val
+         #(struct:procedure
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           ((inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont)))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:cdr-unop)
+     #(struct:rand-cont
+       #(struct:proc-val
+         #(struct:procedure
+           lst
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:null?-unop)
+               #(struct:var-exp lst))
+             #(struct:raise-exp #(struct:const-exp 99))
+             #(struct:if-exp
+               #(struct:unop-exp
+                 #(struct:zero?-unop)
+                 #(struct:diff-exp
+                   #(struct:unop-exp
+                     #(struct:car-unop)
+                     #(struct:var-exp lst))
+                   #(struct:var-exp n)))
+               #(struct:const-exp 0)
+               #(struct:diff-exp
+                 #(struct:call-exp
+                   #(struct:var-exp inner2)
+                   #(struct:unop-exp
+                     #(struct:cdr-unop)
+                     #(struct:var-exp lst)))
+                 #(struct:const-exp -1))))
+           ((inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont))))))
+   #(struct:list-val (#(struct:num-val 3))))
+|(apply-cont
+   #(struct:rand-cont
+     #(struct:proc-val
+       #(struct:procedure
+         lst
+         #(struct:if-exp
+           #(struct:unop-exp
+             #(struct:null?-unop)
+             #(struct:var-exp lst))
+           #(struct:raise-exp #(struct:const-exp 99))
+           #(struct:if-exp
+             #(struct:unop-exp
+               #(struct:zero?-unop)
+               #(struct:diff-exp
+                 #(struct:unop-exp
+                   #(struct:car-unop)
+                   #(struct:var-exp lst))
+                 #(struct:var-exp n)))
+             #(struct:const-exp 0)
+             #(struct:diff-exp
+               #(struct:call-exp
+                 #(struct:var-exp inner2)
+                 #(struct:unop-exp
+                   #(struct:cdr-unop)
+                   #(struct:var-exp lst)))
+               #(struct:const-exp -1))))
+         ((inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:list-val ()))
+|(value-of/k
+   #(struct:if-exp
+     #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1))))
+   ((lst #(struct:list-val ()))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:unop-exp #(struct:null?-unop) #(struct:var-exp lst))
+   ((lst #(struct:list-val ()))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst #(struct:list-val ()))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(value-of/k
+   #(struct:var-exp lst)
+   ((lst #(struct:list-val ()))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst #(struct:list-val ()))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont)))))))
+|(apply-cont
+   #(struct:unop-arg-cont
+     #(struct:null?-unop)
+     #(struct:if-test-cont
+       #(struct:raise-exp #(struct:const-exp 99))
+       #(struct:if-exp
+         #(struct:unop-exp
+           #(struct:zero?-unop)
+           #(struct:diff-exp
+             #(struct:unop-exp
+               #(struct:car-unop)
+               #(struct:var-exp lst))
+             #(struct:var-exp n)))
+         #(struct:const-exp 0)
+         #(struct:diff-exp
+           #(struct:call-exp
+             #(struct:var-exp inner2)
+             #(struct:unop-exp
+               #(struct:cdr-unop)
+               #(struct:var-exp lst)))
+           #(struct:const-exp -1)))
+       ((lst #(struct:list-val ()))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst #(struct:list-val (#(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:diff1-cont
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:try-cont
+             x
+             #(struct:const-exp -1)
+             ((lst
+               #(struct:list-val
+                 (#(struct:num-val 2) #(struct:num-val 3))))
+              (inner2
+                lst
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:null?-unop)
+                    #(struct:var-exp lst))
+                  #(struct:raise-exp #(struct:const-exp 99))
+                  #(struct:if-exp
+                    #(struct:unop-exp
+                      #(struct:zero?-unop)
+                      #(struct:diff-exp
+                        #(struct:unop-exp
+                          #(struct:car-unop)
+                          #(struct:var-exp lst))
+                        #(struct:var-exp n)))
+                    #(struct:const-exp 0)
+                    #(struct:diff-exp
+                      #(struct:call-exp
+                        #(struct:var-exp inner2)
+                        #(struct:unop-exp
+                          #(struct:cdr-unop)
+                          #(struct:var-exp lst)))
+                      #(struct:const-exp -1)))))
+              (n #(struct:num-val 5))
+              (i #(struct:num-val 1))
+              (v #(struct:num-val 5))
+              (x #(struct:num-val 10)))
+             #(struct:end-cont))))))
+   #(struct:list-val ()))
+|(apply-cont
+   #(struct:if-test-cont
+     #(struct:raise-exp #(struct:const-exp 99))
+     #(struct:if-exp
+       #(struct:unop-exp
+         #(struct:zero?-unop)
+         #(struct:diff-exp
+           #(struct:unop-exp
+             #(struct:car-unop)
+             #(struct:var-exp lst))
+           #(struct:var-exp n)))
+       #(struct:const-exp 0)
+       #(struct:diff-exp
+         #(struct:call-exp
+           #(struct:var-exp inner2)
+           #(struct:unop-exp
+             #(struct:cdr-unop)
+             #(struct:var-exp lst)))
+         #(struct:const-exp -1)))
+     ((lst #(struct:list-val ()))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:bool-val #t))
+|(value-of/k
+   #(struct:raise-exp #(struct:const-exp 99))
+   ((lst #(struct:list-val ()))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(value-of/k
+   #(struct:const-exp 99)
+   ((lst #(struct:list-val ()))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:raise1-cont
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont))))))
+|(apply-cont
+   #(struct:raise1-cont
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst #(struct:list-val (#(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:diff1-cont
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:try-cont
+           x
+           #(struct:const-exp -1)
+           ((lst
+             #(struct:list-val
+               (#(struct:num-val 2) #(struct:num-val 3))))
+            (inner2
+              lst
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:null?-unop)
+                  #(struct:var-exp lst))
+                #(struct:raise-exp #(struct:const-exp 99))
+                #(struct:if-exp
+                  #(struct:unop-exp
+                    #(struct:zero?-unop)
+                    #(struct:diff-exp
+                      #(struct:unop-exp
+                        #(struct:car-unop)
+                        #(struct:var-exp lst))
+                      #(struct:var-exp n)))
+                  #(struct:const-exp 0)
+                  #(struct:diff-exp
+                    #(struct:call-exp
+                      #(struct:var-exp inner2)
+                      #(struct:unop-exp
+                        #(struct:cdr-unop)
+                        #(struct:var-exp lst)))
+                    #(struct:const-exp -1)))))
+            (n #(struct:num-val 5))
+            (i #(struct:num-val 1))
+            (v #(struct:num-val 5))
+            (x #(struct:num-val 10)))
+           #(struct:end-cont)))))
+   #(struct:num-val 99))
+|(apply-handler
+   #(struct:num-val 99)
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst #(struct:list-val (#(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:diff1-cont
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:try-cont
+         x
+         #(struct:const-exp -1)
+         ((lst
+           #(struct:list-val
+             (#(struct:num-val 2) #(struct:num-val 3))))
+          (inner2
+            lst
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:null?-unop)
+                #(struct:var-exp lst))
+              #(struct:raise-exp #(struct:const-exp 99))
+              #(struct:if-exp
+                #(struct:unop-exp
+                  #(struct:zero?-unop)
+                  #(struct:diff-exp
+                    #(struct:unop-exp
+                      #(struct:car-unop)
+                      #(struct:var-exp lst))
+                    #(struct:var-exp n)))
+                #(struct:const-exp 0)
+                #(struct:diff-exp
+                  #(struct:call-exp
+                    #(struct:var-exp inner2)
+                    #(struct:unop-exp
+                      #(struct:cdr-unop)
+                      #(struct:var-exp lst)))
+                  #(struct:const-exp -1)))))
+          (n #(struct:num-val 5))
+          (i #(struct:num-val 1))
+          (v #(struct:num-val 5))
+          (x #(struct:num-val 10)))
+         #(struct:end-cont)))))
+|(apply-handler
+   #(struct:num-val 99)
+   #(struct:diff1-cont
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:try-cont
+       x
+       #(struct:const-exp -1)
+       ((lst
+         #(struct:list-val
+           (#(struct:num-val 2) #(struct:num-val 3))))
+        (inner2
+          lst
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:null?-unop)
+              #(struct:var-exp lst))
+            #(struct:raise-exp #(struct:const-exp 99))
+            #(struct:if-exp
+              #(struct:unop-exp
+                #(struct:zero?-unop)
+                #(struct:diff-exp
+                  #(struct:unop-exp
+                    #(struct:car-unop)
+                    #(struct:var-exp lst))
+                  #(struct:var-exp n)))
+              #(struct:const-exp 0)
+              #(struct:diff-exp
+                #(struct:call-exp
+                  #(struct:var-exp inner2)
+                  #(struct:unop-exp
+                    #(struct:cdr-unop)
+                    #(struct:var-exp lst)))
+                #(struct:const-exp -1)))))
+        (n #(struct:num-val 5))
+        (i #(struct:num-val 1))
+        (v #(struct:num-val 5))
+        (x #(struct:num-val 10)))
+       #(struct:end-cont))))
+|(apply-handler
+   #(struct:num-val 99)
+   #(struct:try-cont
+     x
+     #(struct:const-exp -1)
+     ((lst
+       #(struct:list-val
+         (#(struct:num-val 2) #(struct:num-val 3))))
+      (inner2
+        lst
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:null?-unop)
+            #(struct:var-exp lst))
+          #(struct:raise-exp #(struct:const-exp 99))
+          #(struct:if-exp
+            #(struct:unop-exp
+              #(struct:zero?-unop)
+              #(struct:diff-exp
+                #(struct:unop-exp
+                  #(struct:car-unop)
+                  #(struct:var-exp lst))
+                #(struct:var-exp n)))
+            #(struct:const-exp 0)
+            #(struct:diff-exp
+              #(struct:call-exp
+                #(struct:var-exp inner2)
+                #(struct:unop-exp
+                  #(struct:cdr-unop)
+                  #(struct:var-exp lst)))
+              #(struct:const-exp -1)))))
+      (n #(struct:num-val 5))
+      (i #(struct:num-val 1))
+      (v #(struct:num-val 5))
+      (x #(struct:num-val 10)))
+     #(struct:end-cont)))
+|(value-of/k
+   #(struct:const-exp -1)
+   ((x #(struct:num-val 99))
+    (lst
+     #(struct:list-val (#(struct:num-val 2) #(struct:num-val 3))))
+    (inner2
+      lst
+      #(struct:if-exp
+        #(struct:unop-exp
+          #(struct:null?-unop)
+          #(struct:var-exp lst))
+        #(struct:raise-exp #(struct:const-exp 99))
+        #(struct:if-exp
+          #(struct:unop-exp
+            #(struct:zero?-unop)
+            #(struct:diff-exp
+              #(struct:unop-exp
+                #(struct:car-unop)
+                #(struct:var-exp lst))
+              #(struct:var-exp n)))
+          #(struct:const-exp 0)
+          #(struct:diff-exp
+            #(struct:call-exp
+              #(struct:var-exp inner2)
+              #(struct:unop-exp
+                #(struct:cdr-unop)
+                #(struct:var-exp lst)))
+            #(struct:const-exp -1)))))
+    (n #(struct:num-val 5))
+    (i #(struct:num-val 1))
+    (v #(struct:num-val 5))
+    (x #(struct:num-val 10)))
+   #(struct:end-cont))
+|(apply-cont #(struct:end-cont) #(struct:num-val -1))
+|#(struct:num-val -1)
+> 
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/exceptions/data-structures.scm b/collects/tests/eopl/chapter5/exceptions/data-structures.scm
new file mode 100755
index 0000000000..de88ceb711
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/data-structures.scm
@@ -0,0 +1,85 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; list of expvals.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (list-val
+      (lst (list-of expval?))))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->list
+    (lambda (v)
+      (cases expval v
+	(list-val (lst) lst)
+	(else (expval-extractor-error 'list v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;; ;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+;; moved to interp.scm
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;;; replaced by custom environment structure in environments.scm.
+;;; This represents an environment as an alist  ((id rhs) ...)
+;;; where rhs is either an expval or a list (bvar body)
+;;; expval is for extend-env; the list is for extend-env-rec.
+
+;;; this representation is designed to make the printed representation
+;;; of the environment more readable.
+
+;;; The code for this is in environments.scm, but we need environment?
+;;; for define-datatype proc, so we write an appoximation:
+
+  (define environment?
+    (list-of
+      (lambda (p)
+        (and 
+          (pair? p)
+          (symbol? (car p))))))
+
+  )
diff --git a/collects/tests/eopl/chapter5/exceptions/drscheme-init.scm b/collects/tests/eopl/chapter5/exceptions/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter5/exceptions/environments.scm b/collects/tests/eopl/chapter5/exceptions/environments.scm
new file mode 100755
index 0000000000..8cd3456c8d
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/environments.scm
@@ -0,0 +1,70 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (provide init-env empty-env extend-env extend-env-rec apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+;;; represent environment as an alist  ((id rhs) ...)
+
+;;; rhs is either an expval or a list (bvar body)
+;;; expval is for extend-env; the list is for extend-env-rec.
+
+;;; this representation is designed to make the printed representation
+;;; of the environment more readable.
+
+  (define empty-env
+    (lambda ()
+      '()))
+  
+  (define empty-env? 
+    (lambda (x) (null? x)))
+
+  (define extend-env
+    (lambda (sym val old-env)
+      (cons (list sym val) old-env)))
+
+  (define extend-env-rec
+    (lambda (p-name b-var p-body saved-env)
+      (cons 
+        (list p-name b-var p-body)
+        saved-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (null? env) 
+        (eopl:error 'apply-env "No binding for ~s" search-sym)
+        (let* ((binding (car env))
+               (id (list-ref binding 0))
+               (expval-or-bvar (list-ref binding 1)))
+          (cond
+            ((not (eqv? search-sym id))
+             (apply-env (cdr env) search-sym))
+            ((not (symbol? expval-or-bvar))
+            ;; this was built by extend-env
+             expval-or-bvar)
+            (else
+            ;; this was built by extend-env-rec
+              (let ((bvar (cadr binding))
+                    (body (caddr binding)))
+                (proc-val (procedure bvar body env)))))))))
+            
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/exceptions/interp.scm b/collects/tests/eopl/chapter5/exceptions/interp.scm
new file mode 100755
index 0000000000..7f8f0fd248
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/interp.scm
@@ -0,0 +1,210 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of/k)
+  (provide trace-apply-procedure)
+
+  (define trace-apply-procedure (make-parameter #f))
+
+;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+
+  (define-datatype continuation continuation?
+    (end-cont)                          ; []
+    (diff1-cont                       ; cont[(- [] (value-of e2 env))]
+      (exp2 expression?)
+      (env environment?)
+      (cont continuation?))
+    (diff2-cont                         ; cont[(- val1 [])]
+      (val1 expval?)
+      (cont continuation?))
+    (unop-arg-cont
+      (unop unary-op?)
+      (cont continuation?))
+    (if-test-cont
+      (exp2 expression?)
+      (exp3 expression?)
+      (env environment?)
+      (cont continuation?))
+    (rator-cont            ; cont[(apply-proc [] (value-of rand env))]
+      (rand expression?)
+      (env environment?)
+      (cont continuation?))
+    (rand-cont                          ; cont[(apply-proc val1 [])]
+      (val1 expval?)
+      (cont continuation?))
+    (try-cont
+      (var symbol?)
+      (handler-exp expression?)
+      (env environment?)
+      (cont continuation?))
+    (raise1-cont
+      (saved-cont continuation?))
+    )
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (body)
+          (value-of/k body (init-env) (end-cont))))))
+
+  ;; value-of/k : Exp * Env * Cont -> FinalAnswer
+  ;; Page: 173
+  (define value-of/k
+    (lambda (exp env cont)
+      (cases expression exp
+
+        (const-exp (num) (apply-cont cont (num-val num)))
+
+        (const-list-exp (nums)
+          (apply-cont cont
+            (list-val (map num-val nums))))
+
+        (var-exp (var) (apply-cont cont (apply-env env var)))
+
+        (diff-exp (exp1 exp2)
+          (value-of/k exp1 env
+            (diff1-cont exp2 env cont)))
+
+        (unop-exp (unop exp1)
+          (value-of/k exp1 env
+            (unop-arg-cont unop cont)))
+
+        (if-exp (exp1 exp2 exp3)
+          (value-of/k exp1 env
+            (if-test-cont exp2 exp3 env cont)))
+
+        (proc-exp (var body)
+          (apply-cont cont
+            (proc-val
+              (procedure var body env))))
+
+        (call-exp (rator rand)
+          (value-of/k rator env
+            (rator-cont rand env cont)))
+
+        ;; make let a macro, because I'm too lazy to add the extra
+        ;; continuation
+        (let-exp (var exp1 body)
+          (value-of/k
+            (call-exp (proc-exp var body) exp1)
+            env
+            cont))
+
+        (letrec-exp (p-name b-var p-body letrec-body)
+          (value-of/k
+            letrec-body
+            (extend-env-rec p-name b-var p-body env)
+            cont))
+
+        (try-exp (exp1 var handler-exp)
+          (value-of/k exp1 env
+            (try-cont var handler-exp env cont)))
+
+        (raise-exp (exp1)
+          (value-of/k exp1 env
+            (raise1-cont cont))))))
+
+  ;; apply-cont : continuation * expval -> final-expval
+
+  (define apply-cont
+    (lambda (cont val)
+      (cases continuation cont
+        (end-cont () val)
+        (diff1-cont (exp2 saved-env saved-cont)
+          (value-of/k exp2 saved-env (diff2-cont val saved-cont)))
+        (diff2-cont (val1 saved-cont)
+          (let ((n1 (expval->num val1))
+                (n2 (expval->num val)))
+            (apply-cont saved-cont
+              (num-val (- n1 n2)))))
+        (unop-arg-cont (unop cont)
+          (apply-cont cont
+            (apply-unop unop val)))
+        (if-test-cont (exp2 exp3 env cont)
+          (if (expval->bool val)
+            (value-of/k exp2 env cont)
+            (value-of/k exp3 env cont)))
+        (rator-cont (rand saved-env saved-cont)
+          (value-of/k rand saved-env
+            (rand-cont val saved-cont)))
+        (rand-cont (val1 saved-cont)
+          (let ((proc (expval->proc val1)))
+            (apply-procedure proc val saved-cont)))
+        ;; the body of the try finished normally-- don't evaluate the handler
+        (try-cont (var handler-exp saved-env saved-cont)
+          (apply-cont saved-cont val))
+        ;; val is the value of the argument to raise
+        (raise1-cont (saved-cont)
+          ;; we put the short argument first to make the trace more readable.
+          (apply-handler val saved-cont))
+        )))
+      
+  ;; apply-handler : ExpVal * Cont -> FinalAnswer
+  (define apply-handler
+    (lambda (val cont)
+      (cases continuation cont
+        ;; interesting cases
+        (try-cont (var handler-exp saved-env saved-cont)
+          (value-of/k handler-exp
+            (extend-env var val saved-env)
+            saved-cont))
+
+        (end-cont () (eopl:error 'apply-handler "uncaught exception!"))
+
+        ;; otherwise, just look for the handler...
+        (diff1-cont (exp2 saved-env saved-cont)
+          (apply-handler val saved-cont))
+        (diff2-cont (val1 saved-cont)
+          (apply-handler val saved-cont))
+        (if-test-cont (exp2 exp3 env saved-cont)
+          (apply-handler val saved-cont))
+        (unop-arg-cont (unop saved-cont)
+          (apply-handler val saved-cont))
+        (rator-cont (rand saved-env saved-cont)
+          (apply-handler val saved-cont))
+        (rand-cont (val1 saved-cont)
+          (apply-handler val saved-cont))
+        (raise1-cont (cont)
+          (apply-handler val cont))
+        )))
+
+
+  ;; apply-procedure : procedure * expval * cont -> final-expval
+
+  (define apply-procedure
+    (lambda (proc1 arg cont)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of/k body
+            (extend-env var arg saved-env)
+            cont)))))
+
+
+  (define apply-unop
+    (lambda (unop val)
+      (cases unary-op unop
+        (null?-unop ()
+          (bool-val
+            (null? (expval->list val))))
+        (car-unop ()
+          (car (expval->list val)))
+        (cdr-unop ()
+          (list-val (cdr (expval->list val))))
+        (zero?-unop ()
+          (bool-val
+            (zero? (expval->num val)))))))
+
+
+  ;; to get the detailed trace:
+  ;; (trace value-of/k apply-cont apply-handler)
+
+  )
diff --git a/collects/tests/eopl/chapter5/exceptions/lang.scm b/collects/tests/eopl/chapter5/exceptions/lang.scm
new file mode 100755
index 0000000000..c24598e17d
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/lang.scm
@@ -0,0 +1,96 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; grammar for the EXCEPTIONS language.  This is a somewhat cut-down
+  ;; version of the LETREC language.
+
+  ;; exercise: allow the "list" operator to take expressions instead
+  ;; of just numbers.
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+      
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)
+
+      (expression
+        ("letrec"
+          identifier "(" identifier ")" "=" expression
+           "in" expression)
+        letrec-exp)
+
+      ;; Lists.  We will have lists of literal numbers only.
+
+      (expression
+        ("list" "(" (separated-list number ",") ")")
+        const-list-exp)
+
+      (expression
+        (unary-op "(" expression ")")
+        unop-exp)
+
+      (expression
+        ("try" expression "catch" "(" identifier ")" expression)
+        try-exp)
+
+      (expression
+        ("raise" expression)
+        raise-exp)
+
+      (unary-op ("null?") null?-unop)
+      (unary-op ("car")   car-unop)
+      (unary-op ("cdr" )  cdr-unop)
+      (unary-op ("zero?") zero?-unop)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter5/exceptions/tests.scm b/collects/tests/eopl/chapter5/exceptions/tests.scm
new file mode 100755
index 0000000000..217dd0b200
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/tests.scm
@@ -0,0 +1,239 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+;;       (y-combinator-1 "
+;; let fix =  proc (f)
+;;             let d = proc (x) proc (z) ((f (x x)) z)
+;;             in proc (n) ((f (d d)) n)
+;; in let
+;;     t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+;; in let times4 = (fix t4m)
+;;    in (times4 3)" 12)
+
+
+       ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+
+   (twice "
+        (proc (twice)
+           ((twice proc (z) -(z,1)) 11)
+         proc (f) proc (x) (f (f x)))"
+      9)
+
+      ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      (lists-1
+        "list(2, 3, 4)"
+        (2 3 4))
+
+      (car-1
+        "car(list(2,3,4))"
+        2)
+      
+      (cdr-1
+        "cdr(list(2,3,4))"
+        (3 4))
+
+
+    ;; tests for try/catch
+    (simple-succeed
+      "try 33 
+       catch (m) 44"
+      33)
+
+    (dont-run-handler-til-failure
+      "try 33 
+       catch (m) foo"
+      33)
+
+    (simple-failure
+      "try -(1, raise 44) catch (m) m"
+      44)
+
+    (uncaught-exception
+      "-(22, raise 13)"
+      error)
+
+    (exceptions-have-dynamic-scope-1 
+      "let f = proc (x) -(x, -(raise 99, 1))   % no handler in lexical scope!
+       in try (f 33) 
+          catch (m) 44"
+      44)
+
+    (handler-in-non-tail-recursive-position 
+      "let f = proc (x) -(x, -(raise 99, 1))   % no handler in lexical scope!
+       in -(try (f 33) 
+            catch (m) -(m,55), 
+            1)"
+      43)
+
+    (propagate-error-1
+      "try try -(raise 23, 11)
+           catch (m) -(raise 22,1) 
+       catch (m) m"
+      22)
+
+    (propagate-error-2
+      "let f = proc (x) -(1, raise 99)
+       in
+          try
+             try (f 44)
+             catch (exc) (f 23)
+          catch (exc) 11"
+          
+      11)
+
+    (text-example-0.1
+      "let index 
+            = proc (n)
+               letrec inner2 (lst)
+                 % find position of n in lst else raise exception 
+                  = if null?(lst) then lst       
+                    else if zero?(-(car(lst),n)) then lst
+                    else let v = (inner2 cdr(lst))
+                         in v
+               in proc (lst)
+                   try (inner2 lst)
+                   catch (x) -1
+       in ((index 3) list(2, 3, 4))"
+      (3 4))
+
+    (text-example-0.2
+      "let index 
+            = proc (n)
+               letrec inner2 (lst)
+                 % find position of n in lst else raise exception 
+                  = if null?(lst) then lst       
+                    else if zero?(-(car(lst),n)) then lst
+                    else let v = (inner2 cdr(lst))
+                         in v
+               in proc (lst)
+                   try (inner2 lst)
+                   catch (x) -1
+       in ((index 3) list(2, 3, 4))"
+      (3 4))
+
+   (text-example-1.1
+      "let index 
+            = proc (n)
+               letrec inner2 (lst)
+                 % find position of n in lst else raise error
+                 % exception 
+                  = if null?(lst) then raise 99       
+                    else if zero?(-(car(lst),n)) then 0
+                    else let v = (inner2 cdr(lst))
+                         in -(v,-1)
+               in proc (lst)
+                   try (inner2 lst)
+                   catch (x) -1
+       in ((index 2) list(2, 3, 4))"
+      0)
+
+   (text-example-1.2
+      "let index 
+            = proc (n)
+               letrec inner2 (lst)
+                 % find position of n in lst else raise error
+                 % exception 
+                  = if null?(lst) then raise 99       
+                    else if zero?(-(car(lst),n)) then 0
+                    else -((inner2 cdr(lst)), -1)
+               in proc (lst)
+                   try (inner2 lst)
+                   catch (x) -1
+       in ((index 5) list(2, 3))"
+      -1)
+
+    ))
+
+
+  )
diff --git a/collects/tests/eopl/chapter5/exceptions/top.scm b/collects/tests/eopl/chapter5/exceptions/top.scm
new file mode 100755
index 0000000000..e71c7592f9
--- /dev/null
+++ b/collects/tests/eopl/chapter5/exceptions/top.scm
@@ -0,0 +1,73 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+
+  (require "interp.scm")           
+ 
+  (require "tests.scm")            ; for test-list
+  
+   
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        ((list? sloppy-val) (list-val (map sloppy->expval sloppy-val)))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; make sure this is initially off.
+  (trace-apply-procedure #f)
+
+  ;; (run-all)
+
+  ;; to generate the big trace in the text, say
+  ;; (trace-apply-procedure #t)
+  ;; (run-one 'text-example-1.2)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter5/letrec-lang/data-structures.scm b/collects/tests/eopl/chapter5/letrec-lang/data-structures.scm
new file mode 100755
index 0000000000..38bdeedbfd
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/data-structures.scm
@@ -0,0 +1,100 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+  ;; Page: 148
+  (define identifier? symbol?)
+
+  (define-datatype continuation continuation?
+    (end-cont)                 
+    (zero1-cont
+      (saved-cont continuation?))
+    (let-exp-cont
+      (var identifier?)
+      (body expression?)
+      (saved-env environment?)
+      (saved-cont continuation?))
+    (if-test-cont 
+      (exp2 expression?)
+      (exp3 expression?)
+      (saved-env environment?)
+      (saved-cont continuation?))
+    (diff1-cont                
+      (exp2 expression?)
+      (saved-env environment?)
+      (saved-cont continuation?))
+    (diff2-cont                
+      (val1 expval?)
+      (saved-cont continuation?))
+    (rator-cont            
+      (rand expression?)
+      (saved-env environment?)
+      (saved-cont continuation?))
+    (rand-cont             
+      (val1 expval?)
+      (saved-cont continuation?)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-rec
+      (p-name symbol?)
+      (b-var symbol?)
+      (p-body expression?)
+      (saved-env environment?)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/letrec-lang/drscheme-init-cps.scm b/collects/tests/eopl/chapter5/letrec-lang/drscheme-init-cps.scm
new file mode 100755
index 0000000000..94277cc451
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/drscheme-init-cps.scm
@@ -0,0 +1,207 @@
+;; drscheme-init-cps.scm - compatibility file for DrScheme
+
+;; usage: (require "drscheme-init-cps.scm")
+
+;;; like drscheme-init, but also provides a logged-print functionality
+;;; that can be used to check the correctness of printed output.
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init-cps.scm mzscheme
+  
+  (let ((version "plt360 2/25/07")
+        (filename "drscheme-mp5-init.scm"))
+    (printf "~a ~a~%" filename version))
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   )
+
+  (require (only mzscheme values let*-values)) 
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; Trace = [Listof b] | error
+  ;;
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) *  Trace  (b * b->bool)
+  ;;  -> (cons bool b) (cons bool [Listof b]) 
+  
+  ;; usage: (run-experiment fn args correct-trace equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-trace. First value 
+  ;; returned holds (bool b) where bool indicates whether the trace is correct. 
+  ;;
+  ;; Also, logs any output of fn (through logged:print). Compares logged output 
+  ;; to correct-trace using equal-answer?. The second value returned holds (bool 
+  ;; [Listof b]), where bool indicates whether the logged output matches 
+  ;; correct-trace.
+  (define run-experiment
+    (lambda (fn args correct-trace equal-answer?)
+      (let*
+          ( ;; init logged-stream
+           (dummy1 (initialize-logged-stream!))
+           (result (apply-safely fn args))
+           ;; get the list of values given to logged:print
+           (logged-prints (get-logged-stream))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result))
+           (correct-anwser?  (if (eqv? correct-trace 'error)
+                               error-thrown?
+                               (correct-trace? correct-trace 
+                                logged-prints equal-answer?))))
+                               
+
+          (values (cons correct-anwser? ans) 
+                  (cons correct-anwser? logged-prints)))))
+                   
+  ;; NumOrBool = Number | Boolean 
+  ;; Printval = (num-val n) | (bool-val b)
+  ;;
+  ;; correct-trace? : [Listof NumOrBool] [Listof Printval]
+  ;;                  (Printval NumOrBool -> Boolean) -> Boolean | Error
+  ;;
+  ;; usage : (correct-trace? a e test)
+  ;; produces : true if for all corresponding elements of a and e (test a e)=#t
+  ;;            false if one of (test a e) =#f  and error if (test a e) = error
+  (define correct-trace? 
+   (lambda (expected actual equal-answer?)
+    (if (= (length actual) (length expected))
+      (andmap equal-answer? actual expected)
+      (error 'correct-trace? 
+       "Trace mismatch. ~% actual trace = ~s ~% correct-trace = ~s ~%"
+       actual expected))))
+         
+    
+  
+  (define stop-after-first-error (make-parameter #f))
+  
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test) 
+  ;; -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the trace outcome is right, comparing values using equal-answer?.
+  ;;
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+ 
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-trace (caddr test-item)))
+           (printf "test: ~a~%~a~%" name pgm)
+           (let*-values (((result traces-result)
+                           (run-experiment
+                             run-fn (list pgm) correct-trace equal-answer? )))
+            (let ((correct? (car result))
+                  (correct-trace? (car traces-result))
+                  (actual-answer (cdr result))
+                  (actual-trace (cdr traces-result)))
+             ;;(printf "correct outcome: ~a~%" correct-answer)
+             ;;(printf "actual outcome:  ")
+             ;;(pretty-display actual-answer)
+             (printf "correct trace: ~a~%" correct-trace)
+             (printf "actual trace:  ~a~%" actual-trace)
+             (if correct-trace?
+               (printf "correct~%~%")
+               (begin
+                 (printf "incorrect~%~%")
+                 ;; stop on first error if stop-after-first? is set:
+                 (if (stop-after-first-error)
+                   (error name "incorrect outcome detected")) 
+                 (set! tests-failed
+                   (cons name tests-failed))))))))
+       tests)
+      (if (null? tests-failed)
+        (printf "no bugs found~%")
+        (printf "incorrect answers on tests: ~a~%"
+                (reverse tests-failed)))))
+
+
+
+;;skotthe@ccs.neu.edu 
+;;Sat Mar  4 18:21:05 EST 2006
+;;
+;; Provides logged:printf that can be used instead of eopl:printf.  
+;; logged:printf logs its arguments in logged-stream using mutation.  The 
+;; functions initialize-logged-stream! reset the logged data and get-logged-stream
+;; return the logged data as a scheme list. 
+
+  (provide logged-print)
+
+ ;; initialize-logged-stream! : -> void
+ ;; produces : Sets logged-stream to '()
+ (define initialize-logged-stream! 
+  (lambda ()
+   (set! logged-stream '())))
+
+ ;; get-logged-stream : -> [Listof Expval]
+ ;; produces : returns the logged expvals printed tou stdout
+ (define get-logged-stream 
+  (lambda ()
+   logged-stream))
+
+ (define logged-stream '())
+
+ ;; logged-print : a1 a2 ... -> void
+ ;; produces : Wrapper to eopl:printf. Logs the values passed to eopl:printf 
+ ;; excluding the format string (1st argument to eopl:printf). Then calls 
+ ;; eopl:printf. 
+ (define logged-print
+  (lambda args
+   (let ((fstr (car args))
+         (vals (cdr args)))
+    (begin 
+     (set! logged-stream (append logged-stream vals))
+     (apply printf args)))))
+     
+
+)  
+
+
+
diff --git a/collects/tests/eopl/chapter5/letrec-lang/drscheme-init.scm b/collects/tests/eopl/chapter5/letrec-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter5/letrec-lang/environments.scm b/collects/tests/eopl/chapter5/letrec-lang/environments.scm
new file mode 100755
index 0000000000..893077de3c
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/environments.scm
@@ -0,0 +1,46 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  ;; builds environment interface, using data structures defined in
+  ;; data-structures.scm. 
+
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> Env
+  ;; usage: (init-env) = [i=1, v=5, x=10]
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.
+  ;; Page: 69
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; Page: 86
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (var val saved-env)
+	  (if (eqv? search-sym var)
+	    val
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec (p-name b-var p-body saved-env)
+          (if (eqv? search-sym p-name)
+            (proc-val (procedure b-var p-body env))          
+            (apply-env saved-env search-sym))))))
+    
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/letrec-lang/eopl-without-exp.scm b/collects/tests/eopl/chapter5/letrec-lang/eopl-without-exp.scm
new file mode 100755
index 0000000000..07eba7fb6c
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/eopl-without-exp.scm
@@ -0,0 +1,8 @@
+(module eopl-without-exp (lib "eopl.ss" "eopl")
+
+  ;; remove "exp" from the eopl language level, because we use it as
+  ;; a mutable variable.
+
+  (provide (all-from-except (lib "eopl.ss" "eopl") exp))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/letrec-lang/interp-registers.scm b/collects/tests/eopl/chapter5/letrec-lang/interp-registers.scm
new file mode 100755
index 0000000000..bb62fb434d
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/interp-registers.scm
@@ -0,0 +1,192 @@
+(module interp-registers "eopl-without-exp.scm"
+  
+  ;; imperative cps interpreter for the LETREC language, using the
+  ;; data structure representation of continuations (Figure 5.3)
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of/k)
+
+  (provide trace-apply-procedure)
+
+  (define trace-apply-procedure (make-parameter #f))
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+;;; have the interpreter procedures communicate via registers
+
+  (define exp 'uninitialized)
+  (define env 'uninitialized)
+  (define cont 'uninitialized)
+  (define val 'uninitialized)
+  (define proc1 'uninitialized)         ; we've already used "proc".
+
+  ;; value-of-program : Program -> FinalAnswer
+  ;; Page: 167
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (body)
+          (set! cont (end-cont))
+          (set! exp body)
+          (set! env (init-env))
+          (value-of/k)))))
+
+  ;; value-of : Exp * Env * Cont -> FinalAnswer
+  ;; value-of/k : () -> FinalAnswer
+  ;; usage : relies on registers 
+  ;;      exp  : Exp
+  ;;      env  : Env
+  ;;      cont : Cont
+  ;; Page 167 and 168
+  ;;
+  ;; The code from the corresponding portions of interp.scm is shown
+  ;; as comments.
+  (define value-of/k
+    (lambda ()                         
+      (cases expression exp
+        (const-exp (num)
+          ;; (apply-cont cont (num-val num)))                   
+          (set! val (num-val num))
+          ;; cont is unchanged          
+          (apply-cont))
+        (var-exp (var)
+          ;; (apply-cont cont (apply-env env id)))                 
+          (set! val (apply-env env var))
+          ;; cont is unchanged          
+          (apply-cont))
+        (proc-exp (var body)
+          ;; (apply-cont cont (proc-val (procedure bvar body env))
+          (set! val (proc-val (procedure var body env)))
+          (apply-cont))
+        (letrec-exp (p-name b-var p-body letrec-body)
+          ;; (value-of/k letrec-body
+          ;;   (extend-env-rec proc-name bvar proc-body env)
+          ;;   cont)
+          (set! exp letrec-body)
+          (set! env
+            (extend-env-rec p-name b-var p-body env))
+          (value-of/k))
+        (zero?-exp (exp1)
+          ;; (value-of/k exp1 env (zero1-cont cont))
+          (set! cont (zero1-cont cont))
+          (set! exp exp1)
+          (value-of/k))
+        (let-exp (var exp1 body) 
+          ;; (value-of/k rhs env (let-exp-cont id body env cont)) 
+          (set! cont (let-exp-cont var body env cont))
+          (set! exp exp1)
+          (value-of/k))
+        (if-exp (exp1 exp2 exp3)
+          ;; (value-of/k exp0 env (if-test-cont exp2 exp3 env cont))
+          (set! cont (if-test-cont exp2 exp3 env cont))
+          (set! exp exp1)
+          (value-of/k))
+        (diff-exp (exp1 exp2)
+          ;; (value-of/k exp1 env (diff1-cont exp2 env cont))              
+          (set! cont (diff1-cont exp2 env cont))
+          (set! exp exp1)
+          ;; env is unchanged          
+          (value-of/k))
+        (call-exp (rator rand)
+          ;; (value-of/k rator env (rator-cont rand env cont))
+          (set! cont (rator-cont rand env cont))
+          (set! exp rator)
+          (value-of/k))
+        )))
+
+  ;; apply-cont : Cont * ExpVal -> FinalAnswer
+  ;; usage : reads registers
+  ;;     cont : Cont
+  ;;     val  : ExpVal
+  ;; Page 169 and 170
+  (define apply-cont
+    (lambda ()                          
+      (cases continuation cont
+          
+        (end-cont ()
+          (eopl:printf "End of computation.~%")
+          val)
+        ;; or (logged-print val)  ; if you use drscheme-init-cps.scm
+        (zero1-cont (saved-cont)
+          ;; (apply-cont cont
+          ;;   (bool-val
+          ;;     (zero? (expval->num val))))
+          (set! cont saved-cont)
+          (set! val (bool-val (zero? (expval->num val))))
+          (apply-cont))
+        (let-exp-cont (var body saved-env saved-cont)
+          ;; (value-of/k body (extend-env id val env) cont)                     
+          (set! cont saved-cont)
+          (set! exp body)
+          (set! env (extend-env var val saved-env))
+          (value-of/k))
+        (if-test-cont (exp2 exp3 saved-env saved-cont)
+          (set! cont saved-cont)
+          (if (expval->bool val)
+            (set! exp exp2)
+            (set! exp exp3))
+          (set! env saved-env)
+          (value-of/k))
+        (diff1-cont (exp2 saved-env saved-cont)
+          ;; (value-of/k exp2 env (diff2-cont val cont)))
+          (set! cont (diff2-cont val saved-cont))
+          (set! exp exp2)
+          (set! env saved-env)
+          (value-of/k))
+        (diff2-cont (val1 saved-cont)
+          ;; (apply-cont cont (num-val (- num1 num2)))))
+          (let ((num1 (expval->num val1))
+                (num2 (expval->num val)))
+            (set! cont saved-cont)
+            (set! val (num-val (- num1 num2)))
+            (apply-cont)))
+        (rator-cont (rand saved-env saved-cont)
+          ;; (value-of/k rand env (rand-cont val cont))
+          (set! cont (rand-cont val saved-cont))
+          (set! exp rand)
+          (set! env saved-env)
+          (value-of/k))
+        (rand-cont (rator-val saved-cont)
+          (let ((rator-proc (expval->proc rator-val)))
+            ;; (apply-procedure rator-proc rator-val cont)
+            (set! cont saved-cont)
+            (set! proc1 rator-proc)
+            (set! val val)
+            (apply-procedure/k)))
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  ;; apply-procedure/k : () -> FinalAnswer}
+  ;; usage : relies on registers
+  ;;     proc1 : Proc
+  ;;       val : ExpVal
+  ;;      cont : Cont
+  ;; Page 170
+  (define apply-procedure/k
+    (lambda ()                          
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (set! exp body)
+          (set! env (extend-env var val saved-env))
+          (value-of/k)))))
+
+  ;; instrumented version
+  ;; (define apply-procedure/k
+  ;;   (lambda ()                       ; (proc1 val cont)
+  ;;     (if (trace-apply-procedure)
+  ;;       (begin
+  ;;         (eopl:printf
+  ;;           "~%entering apply-procedure:~%proc1=~s~%val=~s~%cont=~s~%" 
+  ;;           proc1 val cont)))
+  ;;     (cases proc proc1
+  ;;       (procedure (var body saved-env)
+  ;;         (set! exp body)
+  ;;         (set! env (extend-env var val saved-env))
+  ;;         (value-of/k)))))
+
+  )
diff --git a/collects/tests/eopl/chapter5/letrec-lang/interp.scm b/collects/tests/eopl/chapter5/letrec-lang/interp.scm
new file mode 100755
index 0000000000..5d442e37c3
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/interp.scm
@@ -0,0 +1,112 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  ;; cps interpreter for the LETREC language, using the data structure
+  ;; representation of continuations (Figure 5.3).
+
+  ;; exercise: rewrite this using the procedural representation of
+  ;; continuations (Figure 5.2).
+
+  ;; exercise: rewrite this using a trampoline (page 159).
+
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of/k)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> FinalAnswer
+  ;; Page: 143 and 154
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of/k exp1 (init-env) (end-cont))))))  
+
+  ;; value-of/k : Exp * Env * Cont -> FinalAnswer
+  ;; Page: 143--146, and 154
+  (define value-of/k
+    (lambda (exp env cont)
+      (cases expression exp
+        (const-exp (num) (apply-cont cont (num-val num)))
+        (var-exp (var) (apply-cont cont (apply-env env var)))
+        (proc-exp (var body)
+          (apply-cont cont 
+            (proc-val (procedure var body env))))
+        (letrec-exp (p-name b-var p-body letrec-body)
+          (value-of/k letrec-body
+            (extend-env-rec p-name b-var p-body env)
+            cont))
+        (zero?-exp (exp1)
+          (value-of/k exp1 env
+            (zero1-cont cont)))
+        (let-exp (var exp1 body)
+          (value-of/k exp1 env
+            (let-exp-cont var body env cont)))
+        (if-exp (exp1 exp2 exp3)
+          (value-of/k exp1 env
+            (if-test-cont exp2 exp3 env cont)))
+        (diff-exp (exp1 exp2)
+          (value-of/k exp1 env
+            (diff1-cont exp2 env cont)))        
+        (call-exp (rator rand) 
+          (value-of/k rator env
+            (rator-cont rand env cont)))
+   )))
+
+  ;; apply-cont : Cont * ExpVal -> FinalAnswer
+  ;; Page: 148
+  (define apply-cont
+    (lambda (cont val)
+      (cases continuation cont
+        (end-cont () 
+          (begin
+            (eopl:printf
+              "End of computation.~%")
+            val))
+        ;; or (logged-print val)  ; if you use drscheme-init-cps.scm
+        (zero1-cont (saved-cont)
+          (apply-cont saved-cont
+            (bool-val
+              (zero? (expval->num val)))))
+        (let-exp-cont (var body saved-env saved-cont)
+          (value-of/k body
+            (extend-env var val saved-env) saved-cont))
+        (if-test-cont (exp2 exp3 saved-env saved-cont)
+          (if (expval->bool val)
+             (value-of/k exp2 saved-env saved-cont)
+             (value-of/k exp3 saved-env saved-cont)))
+        (diff1-cont (exp2 saved-env saved-cont)
+          (value-of/k exp2
+            saved-env (diff2-cont val saved-cont)))
+        (diff2-cont (val1 saved-cont)
+          (let ((num1 (expval->num val1))
+                (num2 (expval->num val)))
+            (apply-cont saved-cont
+              (num-val (- num1 num2)))))
+        (rator-cont (rand saved-env saved-cont)
+          (value-of/k rand saved-env
+            (rand-cont val saved-cont)))
+        (rand-cont (val1 saved-cont)
+          (let ((proc (expval->proc val1)))
+            (apply-procedure/k proc val saved-cont)))
+        )))
+
+  ;; apply-procedure/k : Proc * ExpVal * Cont -> FinalAnswer
+  ;; Page 152 and 155
+  (define apply-procedure/k
+    (lambda (proc1 arg cont)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of/k body
+            (extend-env var arg saved-env)
+            cont)))))
+  
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter5/letrec-lang/lang.scm b/collects/tests/eopl/chapter5/letrec-lang/lang.scm
new file mode 100755
index 0000000000..1173257625
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/lang.scm
@@ -0,0 +1,72 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; grammar for the LETREC language
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          identifier "(" identifier ")" "=" expression
+           "in" expression)
+        letrec-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter5/letrec-lang/tests.scm b/collects/tests/eopl/chapter5/letrec-lang/tests.scm
new file mode 100755
index 0000000000..5f600e67f6
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/tests.scm
@@ -0,0 +1,98 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+      
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/letrec-lang/top-interp-registers.scm b/collects/tests/eopl/chapter5/letrec-lang/top-interp-registers.scm
new file mode 100755
index 0000000000..6b0c1e5a0b
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/top-interp-registers.scm
@@ -0,0 +1,64 @@
+(module top-interp-registers (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp-registers.scm")   ; or use register version.
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Symbol -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter5/letrec-lang/top-interp.scm b/collects/tests/eopl/chapter5/letrec-lang/top-interp.scm
new file mode 100755
index 0000000000..0d183b084d
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/top-interp.scm
@@ -0,0 +1,64 @@
+(module top-interp (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide (all-defined))
+  (provide (all-from "interp.scm"))
+  (provide (all-from "lang.scm"))
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  )
+
+
diff --git a/collects/tests/eopl/chapter5/letrec-lang/top.scm b/collects/tests/eopl/chapter5/letrec-lang/top.scm
new file mode 100755
index 0000000000..b172f40c16
--- /dev/null
+++ b/collects/tests/eopl/chapter5/letrec-lang/top.scm
@@ -0,0 +1,17 @@
+(module top (lib "eopl.ss" "eopl")
+
+  ;; require both recursive and register versions.
+  ;; test with  (interp-run-all) or (registers-run-all)
+  ;; (run-all) will run both.
+
+  (require (prefix interp- "top-interp.scm"))
+  (require (prefix registers- "top-interp-registers.scm"))
+  
+  (provide interp-run registers-run run-all)
+
+  (define run-all
+    (lambda ()
+      (interp-run-all)
+      (registers-run-all)))
+  
+  )
diff --git a/collects/tests/eopl/chapter5/test-all.scm b/collects/tests/eopl/chapter5/test-all.scm
new file mode 100755
index 0000000000..2f59de26f2
--- /dev/null
+++ b/collects/tests/eopl/chapter5/test-all.scm
@@ -0,0 +1,10 @@
+(module test-all scheme
+
+;; loads each of the languages in this chapter and tests them.
+
+ ; (require (prefix-in letrec "./letrec-lang/top.scm"))
+  (require  (prefix-in letrec- "letrec-lang/top.scm"))
+ ; (letrec-stop-after-first-error #t)
+  (letrec-run-all)
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/thread-lang/data-structures.scm b/collects/tests/eopl/chapter5/thread-lang/data-structures.scm
new file mode 100755
index 0000000000..3e0b0858e0
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/data-structures.scm
@@ -0,0 +1,225 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")
+  ;; (provide (all-from "lang.scm"))
+  (provide (all-defined))               ; too many things to list
+
+
+  ;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (list-val
+      (lst (list-of expval?)))
+    (mutex-val
+      (mutex mutex?))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->list
+    (lambda (v)
+      (cases expval v
+	(list-val (lst) lst)
+	(else (expval-extractor-error 'list v)))))
+
+  (define expval->mutex
+    (lambda (v)
+      (cases expval v
+        (mutex-val (l) l)
+	(else (expval-extractor-error 'mutex v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+  
+;;;;;;;;;;;;;;;; mutexes ;;;;;;;;;;;;;;;;
+
+  (define-datatype mutex mutex?
+    (a-mutex
+      (ref-to-closed?    reference?)    ; ref to bool
+      (ref-to-wait-queue reference?)))  ; ref to (listof thread)
+  
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+
+  ;; used by begin-exp
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+
+  (define-datatype continuation continuation?
+
+    (end-main-thread-cont)           
+    (end-subthread-cont)
+
+    (diff1-cont                       ; cont[(- [] (value-of e2 env))]
+      (exp2 expression?)
+      (env environment?)
+      (cont continuation?))
+    (diff2-cont                         ; cont[(- val1 [])]
+      (val1 expval?)
+      (cont continuation?))
+    (if-test-cont
+      (exp2 expression?)
+      (exp3 expression?)
+      (env environment?)
+      (cont continuation?))
+    (rator-cont            ; cont[(apply-proc [] (value-of rand env))]
+      (rand expression?)
+      (env environment?)
+      (cont continuation?))
+    (rand-cont                          ; cont[(apply-proc val1 [])]
+      (val1 expval?)
+      (cont continuation?))
+    (set-rhs-cont
+      (loc reference?)
+      (cont continuation?))
+
+    (spawn-cont 
+      (saved-cont continuation?))
+    (wait-cont 
+      (saved-cont continuation?))
+    (signal-cont 
+      (saved-cont continuation?))
+
+    (unop-arg-cont
+      (unop1 unop?)
+      (cont continuation?))
+    )
+  
+  ;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
+
+;;; represent environment as a list of bindings.
+;;; binding ::= (id expval) 
+;;;           | ((list-of id) (list-of bvar) (list-of expression))
+
+;;; The first binding for extend-env, the second is for
+;;; extend-env-rec. 
+
+;;; this representation is designed to make the printed representation
+;;; of the environment more readable.
+
+;;; This should probably be factored out into a module called
+;;; environments.scm, like it is in most of the other interpreters.
+
+  (define empty-env
+    (lambda ()
+      '()))
+  
+  (define empty-env? 
+    (lambda (x) (null? x)))
+
+  (define extend-env
+    (lambda (sym val old-env)
+      (cons (list sym val) old-env)))
+
+  (define extend-env-rec*
+    (lambda (p-names b-vars p-bodies saved-env)
+      (cons 
+        (list p-names b-vars p-bodies)
+        saved-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (null? env) 
+        (eopl:error 'apply-env "No binding for ~s" search-sym)
+        (let* ((binding (car env))
+               (saved-env (cdr env)))
+          (if (symbol? (car binding))
+            ;; ok, this is an extend-env
+            (if (eqv? search-sym (car binding))
+              (cadr binding)
+              (apply-env saved-env search-sym))
+            ;; no, this is an extend-env-rec
+            (let ((pos (locate search-sym (car binding)))
+                  (b-vars (cadr binding))
+                  (p-bodies (caddr binding)))
+              (if pos
+                (newref 
+                  (proc-val
+                    (procedure
+                      (list-ref b-vars pos)
+                      (list-ref p-bodies pos)
+                      env)))
+                (apply-env saved-env search-sym))))))))
+
+  ;; returns position of sym in los, else #f
+  (define locate
+    (lambda (sym los)
+      (let loop ((pos 0) (los los))
+        ;; los is at position pos of the original los
+        (cond
+          ((null? los) #f)
+          ((eqv? sym (car los)) pos)
+          (else (loop (+ pos 1) (cdr los)))))))
+
+  (define init-env
+    (lambda ()
+      (letrec
+        ((make-init-env
+           ;; entry ::= (id expval)
+           (lambda (entries)
+             (if (null? entries)
+               (empty-env)
+               (extend-env 
+                 (car (car entries))
+                 (newref (cadr (car entries)))
+                 (make-init-env (cdr entries)))))))
+        (make-init-env
+          (list
+            (list 'i (num-val 1))
+            (list 'v (num-val 5))
+            (list 'x (num-val 10)))))))
+
+;; not precise, but will do.
+  (define environment?
+    (list-of
+      (lambda (p)
+        (and 
+          (pair? p)
+          (or
+            (symbol? (car p))
+            ((list-of symbol?) (car p)))))))
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/thread-lang/drscheme-init.scm b/collects/tests/eopl/chapter5/thread-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter5/thread-lang/interp.scm b/collects/tests/eopl/chapter5/thread-lang/interp.scm
new file mode 100755
index 0000000000..40cfc57e3e
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/interp.scm
@@ -0,0 +1,224 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "store.scm")
+  (require "scheduler.scm")
+  (require "semaphores.scm")     
+  
+  (provide value-of-program trace-interp)
+
+  (define trace-interp (make-parameter #f))
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program * Int -> ExpVal
+  ;; Page: 185    
+  (define value-of-program
+    (lambda (timeslice pgm)
+      (initialize-store!)
+      (initialize-scheduler! timeslice)
+      (cases program pgm
+        (a-program (exp1)
+          (value-of/k
+            exp1
+            (init-env)
+            (end-main-thread-cont))))))
+   
+  ;; value-of/k : Exp * Env * Cont -> FinalAnswer
+  ;; Page 182
+  (define value-of/k                    
+    (lambda (exp env cont)
+
+      (if (trace-interp)
+        (eopl:printf "value-of/k: ~s~%" exp))
+
+      (cases expression exp
+
+        (const-exp (num) (apply-cont cont (num-val num)))
+
+        (const-list-exp (nums)
+          (apply-cont cont
+            (list-val (map num-val nums))))
+
+        (var-exp (var) (apply-cont cont (deref (apply-env env var))))
+  
+        (diff-exp (exp1 exp2)
+          (value-of/k exp1 env
+            (diff1-cont exp2 env cont)))
+
+        (if-exp (exp1 exp2 exp3)
+          (value-of/k exp1 env
+            (if-test-cont exp2 exp3 env cont)))
+
+        (proc-exp (var body)
+          (apply-cont cont
+            (proc-val
+              (procedure var body env))))
+
+        (call-exp (rator rand)
+          (value-of/k rator env
+            (rator-cont rand env cont)))
+
+        (let-exp (var exp1 body)          ; implemented like a macro!
+          (value-of/k
+            (call-exp
+              (proc-exp var body)
+              exp1)
+            env
+            cont))
+        
+        (begin-exp (exp exps)           ; this one, too
+          (if (null? exps)
+            (value-of/k exp env cont)
+            (value-of/k
+              (call-exp
+                (proc-exp 
+                  (fresh-identifier 'dummy)
+                  (begin-exp (car exps) (cdr exps)))
+                exp)
+              env
+              cont)))
+        
+        (letrec-exp (p-names b-vars p-bodies letrec-body)
+          (value-of/k
+            letrec-body
+            (extend-env-rec* p-names b-vars p-bodies env)
+            cont))
+
+        (set-exp (id exp)
+          (value-of/k exp env
+            (set-rhs-cont (apply-env env id) cont)))
+
+        (spawn-exp (exp)
+          (value-of/k exp env
+            (spawn-cont cont)))
+
+        (yield-exp ()
+          (place-on-ready-queue!
+            (lambda () (apply-cont cont (num-val 99))))
+          (run-next-thread))
+
+        (mutex-exp ()
+          (apply-cont cont (mutex-val (new-mutex))))  
+
+        (wait-exp (exp)
+          (value-of/k exp env
+            (wait-cont cont)))
+
+        (signal-exp (exp)
+          (value-of/k exp env
+            (signal-cont cont)))
+
+        (unop-exp (unop1 exp)
+          (value-of/k exp env
+            (unop-arg-cont unop1 cont)))
+
+        )))
+
+  ;; apply-cont : Cont * Exp -> FinalAnswer
+  ;; Page: 182 and 186
+  (define apply-cont                    
+    (lambda (cont val)
+      (if (time-expired?)
+        (begin
+          (place-on-ready-queue!
+            (lambda () (apply-cont cont val)))
+          (run-next-thread))
+        (begin
+
+          (decrement-timer!)
+
+          (cases continuation cont
+
+            (end-main-thread-cont ()
+              (set-final-answer! val)
+              (run-next-thread))
+  
+            (end-subthread-cont ()
+              (run-next-thread))
+               
+            (diff1-cont (exp2 saved-env saved-cont)
+              (value-of/k exp2 saved-env (diff2-cont val saved-cont)))
+            (diff2-cont (val1 saved-cont)
+              (let ((n1 (expval->num val1))
+                    (n2 (expval->num val)))
+                (apply-cont saved-cont
+                  (num-val (- n1 n2)))))
+            (if-test-cont (exp2 exp3 env cont)
+              (if (expval->bool val)
+                (value-of/k exp2 env cont)
+                (value-of/k exp3 env cont)))
+            (rator-cont (rand saved-env saved-cont)
+              (value-of/k rand saved-env
+                (rand-cont val saved-cont)))
+            (rand-cont (val1 saved-cont)
+              (let ((proc (expval->proc val1)))
+                (apply-procedure proc val saved-cont)))
+            (set-rhs-cont (loc cont)
+              (begin
+                (setref! loc val)
+                (apply-cont cont (num-val 26))))
+
+            (spawn-cont (saved-cont)
+              (let ((proc1 (expval->proc val)))
+                (place-on-ready-queue!
+                  (lambda ()
+                    (apply-procedure proc1
+                      (num-val 28)
+                      (end-subthread-cont))))
+              (apply-cont saved-cont (num-val 73))))
+
+            (wait-cont (saved-cont)
+              (wait-for-mutex
+                (expval->mutex val)
+                (lambda () (apply-cont saved-cont (num-val 52)))))
+
+            (signal-cont (saved-cont)
+              (signal-mutex
+                (expval->mutex val)
+                (lambda () (apply-cont saved-cont (num-val 53)))))
+
+            (unop-arg-cont (unop1 cont)
+              (apply-unop unop1 val cont))
+
+            )))))
+
+  (define apply-procedure
+    (lambda (proc1 arg cont)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of/k body
+            (extend-env var (newref arg) saved-env)
+            cont)))))
+
+  (define apply-unop
+    (lambda (unop1 arg cont)
+      (cases unop unop1
+
+        (zero?-unop ()
+          (apply-cont cont
+            (bool-val
+              (zero? (expval->num arg)))))
+
+        (car-unop ()
+          (let ((lst (expval->list arg)))
+            (apply-cont cont (car lst))))
+        (cdr-unop ()
+          (let ((lst (expval->list arg)))
+            (apply-cont cont (list-val (cdr lst)))))
+
+        (null?-unop ()
+          (apply-cont cont 
+            (bool-val (null? (expval->list arg)))))
+
+        (print-unop ()
+          (begin
+            (eopl:printf "~a~%" (expval->num arg))
+            (apply-cont cont (num-val 1))))
+
+        )))
+
+  )
+
diff --git a/collects/tests/eopl/chapter5/thread-lang/lang.scm b/collects/tests/eopl/chapter5/thread-lang/lang.scm
new file mode 100755
index 0000000000..a195c2e19d
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/lang.scm
@@ -0,0 +1,113 @@
+(module lang (lib "eopl.ss" "eopl")     
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+
+      ;; like list(n1,...,nk) in exceptions language. Sorry about that.
+      (expression 
+        ("[" (separated-list number ",") "]")
+        const-list-exp)
+                  
+      (expression (identifier) var-exp)   
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression
+        ("proc" "(" identifier ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression expression ")")
+        call-exp)
+
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)
+      
+      (expression 
+        ;; arbitrary number of unary procedures
+        ("letrec"
+          (arbno identifier "(" identifier ")" "=" expression)
+          "in" expression)
+        letrec-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        set-exp)
+      
+      (expression
+        ("spawn" "(" expression ")")
+        spawn-exp)
+
+      (expression 
+        ("yield" "(" ")")
+        yield-exp)
+
+      (expression
+        ("mutex" "(" ")")
+        mutex-exp)
+
+      (expression
+        ("wait" "(" expression ")")
+        wait-exp)
+      
+      (expression
+        ("signal" "(" expression ")")
+        signal-exp)
+
+      ;; other unary operators
+
+      (expression
+        (unop "(" expression ")")
+        unop-exp)
+
+      (unop ("car") car-unop)
+      (unop ("cdr") cdr-unop)
+      (unop ("null?") null?-unop)
+      (unop ("zero?") zero?-unop)
+      (unop ("print") print-unop)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter5/thread-lang/queues.scm b/collects/tests/eopl/chapter5/thread-lang/queues.scm
new file mode 100755
index 0000000000..4c52ea6f33
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/queues.scm
@@ -0,0 +1,27 @@
+(module queues (lib "eopl.ss" "eopl")
+
+  (provide (all-defined))
+  
+  ;; queues
+
+  ;; We maintain the queue by adding to the end and dequeuing from the
+  ;; front. 
+
+  ;; exercise: enqueue is expensive, since it uses append.  Do
+  ;; something better than this.
+
+  (define empty-queue
+    (lambda ()
+      '()))
+
+  (define empty? null?)
+
+  (define enqueue
+    (lambda (q val)
+      (append q (list val))))
+
+  (define dequeue
+    (lambda (q f)
+      (f (car q) (cdr q))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/thread-lang/scheduler.scm b/collects/tests/eopl/chapter5/thread-lang/scheduler.scm
new file mode 100755
index 0000000000..895225ec62
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/scheduler.scm
@@ -0,0 +1,79 @@
+(module scheduler (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  (require "queues.scm")
+  (require "data-structures.scm")       ; for continuation?
+  (require "lang.scm")                  ; for expval?
+  
+  (provide
+    initialize-scheduler!
+    set-final-answer! 
+    
+    time-expired?
+    decrement-timer!
+
+    place-on-ready-queue!
+    run-next-thread
+
+    )
+  
+  ;;;;;;;;;;;;;;;; the state ;;;;;;;;;;;;;;;;
+  
+  ;; components of the scheduler state:
+  
+  (define the-ready-queue   'uninitialized)         
+  (define the-final-answer  'uninitialized)
+  
+  (define the-max-time-slice    'uninitialized)
+  (define the-time-remaining    'uninitialized)
+
+  ;; initialize-scheduler! : Int -> Unspecified
+  (define initialize-scheduler!
+    (lambda (ticks)
+      (set! the-ready-queue (empty-queue))
+      (set! the-final-answer 'uninitialized)
+      (set! the-max-time-slice ticks)
+      (set! the-time-remaining the-max-time-slice) 
+      ))
+  
+  ;;;;;;;;;;;;;;;; the final answer ;;;;;;;;;;;;;;;;
+
+  ;; place-on-ready-queue! : Thread -> Unspecified
+  ;; Page: 184  
+  (define place-on-ready-queue!
+    (lambda (th)
+      (set! the-ready-queue
+        (enqueue the-ready-queue th))))
+
+  ;; run-next-thread : () -> FinalAnswer
+  ;; Page: 184    
+  (define run-next-thread
+    (lambda ()
+      (if (empty? the-ready-queue)
+        the-final-answer
+        (dequeue the-ready-queue
+          (lambda (first-ready-thread other-ready-threads)
+            (set! the-ready-queue other-ready-threads)            
+            (set! the-time-remaining the-max-time-slice) 
+            (first-ready-thread)
+            )))))
+
+  ;; set-final-answer! : ExpVal -> Unspecified
+  ;; Page: 184    
+  (define set-final-answer!
+    (lambda (val)
+      (set! the-final-answer val)))
+
+  ;; time-expired? : () -> Bool
+  ;; Page: 184    
+  (define time-expired?
+    (lambda ()
+      (zero? the-time-remaining)))
+
+  ;; decrement-timer! : () -> Unspecified
+  ;; Page: 184    
+  (define decrement-timer!
+    (lambda ()
+      (set! the-time-remaining (- the-time-remaining 1))))
+
+  )
diff --git a/collects/tests/eopl/chapter5/thread-lang/semaphores.scm b/collects/tests/eopl/chapter5/thread-lang/semaphores.scm
new file mode 100755
index 0000000000..46a097467e
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/semaphores.scm
@@ -0,0 +1,61 @@
+(module semaphores (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "store.scm")                    ; for store ops
+  (require "data-structures.scm")          ; for lock, a-lock
+  (require "scheduler.scm")                ; for os calls
+  (require "queues.scm")
+
+  (provide (all-defined))
+
+  ;; implements binary semaphores (mutexes).
+
+  (define instrument-mutexes (make-parameter #f))
+
+  ;; new-mutex () -> Mutex
+  ;; Page: 188
+  (define new-mutex
+    (lambda ()
+      (a-mutex
+        (newref #f)                     
+        (newref '()))))                 
+
+  ; wait queue, initially empty
+
+  ;; wait-for-mutex : Mutex * Thread -> FinalAnswer
+  ;; waits for mutex to be open, then closes it.
+  ;; Page: 190
+  (define wait-for-mutex
+    (lambda (m th)
+      (cases mutex m
+        (a-mutex (ref-to-closed? ref-to-wait-queue)
+          (cond
+            ((deref ref-to-closed?)                  
+             (setref! ref-to-wait-queue
+               (enqueue (deref ref-to-wait-queue) th))
+             (run-next-thread))
+            (else
+              (setref! ref-to-closed? #t)
+              (th)))))))
+
+  ;; signal-mutex : Mutex * Thread -> FinalAnswer
+  ;; Page 190
+  (define signal-mutex
+    (lambda (m th)
+      (cases mutex m
+        (a-mutex (ref-to-closed? ref-to-wait-queue)
+          (let ((closed? (deref ref-to-closed?))
+                (wait-queue (deref ref-to-wait-queue)))
+            (if closed?
+              (if (empty? wait-queue)
+                (setref! ref-to-closed? #f)
+                (dequeue wait-queue
+                  (lambda (first-waiting-th other-waiting-ths)
+                    (place-on-ready-queue!
+                      first-waiting-th)
+                    (setref!
+                      ref-to-wait-queue
+                      other-waiting-ths)))))
+            (th))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/thread-lang/store.scm b/collects/tests/eopl/chapter5/thread-lang/store.scm
new file mode 100755
index 0000000000..47e9874050
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/store.scm
@@ -0,0 +1,112 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+  
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter5/thread-lang/tests.scm b/collects/tests/eopl/chapter5/thread-lang/tests.scm
new file mode 100755
index 0000000000..3c64b9e4cc
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/tests.scm
@@ -0,0 +1,396 @@
+(module tests (lib "eopl.ss" "eopl")
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+
+      ;; many more tests imported from previous test suite:
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+
+      ;; from implicit-refs:
+
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      ;; extremely primitive testing for mutable variables
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      ;; this one requires letrec2
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+
+      (example-for-book-1 "
+let f = proc (x) proc (y) 
+                  begin
+                   set x = -(x,-1);
+                   -(x,y)
+                  end
+in ((f 44) 33)"
+	12)
+
+      (begin-1 "begin 33 end" 33)
+
+      (begin-2 "begin 33; 44 end" 44)
+
+
+ 
+      (insanely-simple-spawn "begin spawn(proc(d) 3); 44 end" 44)
+
+      ;; could we do these without lists? ans: yes, but the programs
+      ;; wouldn't be so clear.
+
+      (two-threads "
+letrec 
+  noisy (l) = if null?(l) 
+              then 0 
+              else begin print(car(l)); yield() ; (noisy cdr(l)) end
+in
+   begin
+    spawn(proc (d) (noisy [1,2,3,4,5])) ;
+    spawn(proc (d) (noisy [6,7,8,9,10]));
+    print(100);
+    33
+   end
+"
+        33)
+
+      (producer-consumer "
+let buffer = 0
+in let
+    producer = proc (n) 
+              letrec 
+                waitloop(k) = if zero?(k) 
+                          then set buffer = n
+                          else begin
+                                       print(-(k,-100));
+                                       yield();
+                                       (waitloop -(k,1))
+                               end
+              in (waitloop 5)
+in let consumer = proc (d) letrec
+                     busywait (k) = if zero?(buffer)
+                                   then begin
+                                         print(-(k,-200));
+                                         yield();
+                                         (busywait -(k,-1))
+                                        end
+                                   else buffer
+                in (busywait 0)
+in
+ begin
+  spawn(proc (d) (producer 44));
+  (consumer 88)
+ end
+"
+        44)
+
+
+      (two-non-cooperating-threads "
+letrec 
+  noisy (l) = if null?(l) 
+              then 0 
+              else begin print(car(l)); (noisy cdr(l)) end
+in
+   begin
+    spawn(proc (d) (noisy [1,2,3,4,5])) ;
+    spawn(proc (d) (noisy [6,7,8,9,10])) ;
+    print(100);
+    33
+   end
+"
+        33)
+
+      (unyielding-producer-consumer "
+let buffer = 0
+in let
+  producer = proc (n) 
+              letrec 
+                waitloop(k) = if zero?(k) 
+                          then set buffer = n
+                          else begin
+                                       print(-(k,-200));
+                                       (waitloop -(k,1))
+                               end
+              in (waitloop 5)
+in let consumer = proc (d) letrec
+                     busywait (k) = if zero?(buffer)
+                                   then begin
+                                         print(-(k,-100));
+                                         (busywait -(k,-1))
+                                        end
+                                   else buffer
+                in (busywait 0)
+in
+ begin
+  spawn(proc (d) (producer 44));
+  print(300);
+  (consumer 86)
+ end
+"
+        44)
+ 
+;;       ;; > (set! the-time-slice 50)
+;;       ;; > (run-one 'unyielding-producer-consumer)
+;;       ;; 200
+;;       ;; 105
+;;       ;; 104
+;;       ;; 201
+;;       ;; 202
+;;       ;; 103
+;;       ;; 102
+;;       ;; 203
+;;       ;; 204
+;;       ;; 101
+;;       ;; 205
+;;       ;; 44
+;;       ;; > (set! the-time-slice 100)
+;;       ;; > (run-one 'unyielding-producer-consumer)
+;;       ;; 200
+;;       ;; 201
+;;       ;; 202
+;;       ;; 105
+;;       ;; 104
+;;       ;; 103
+;;       ;; 102
+;;       ;; 203
+;;       ;; 204
+;;       ;; 205
+;;       ;; 206
+;;       ;; 101
+;;       ;; 207
+;;       ;; 44
+;;       ;; > 
+
+      (unsafe-ctr
+        "let ctr = let x = 0
+             in proc (n) proc (d)
+                  begin
+                   print(n); 
+                   print(x);
+                   set x = -(x,-1);
+                   print(n); 
+                   print(x)
+                  end
+   in begin
+       spawn((ctr 100));
+       spawn((ctr 200));
+       spawn((ctr 300));
+       999
+      end"
+        999)
+
+      ;; 3 guys trying to increment ctr, but ctr ends at 2 instead of 3 when
+      ;; timeslice is 10.
+
+;;       ;; > (set! the-time-slice 20)
+;;       ;; > (run-one 'unsafe-ctr)
+;;       ;; 100
+;;       ;; 0
+;;       ;; 100
+;;       ;; 1
+;;       ;; 200
+;;       ;; 1
+;;       ;; 300
+;;       ;; 1
+;;       ;; 200
+;;       ;; 2
+;;       ;; 300
+;;       ;; 2
+;;       ;; 999
+;;       ;; > 
+
+
+
+
+      (safe-ctr
+        "let ctr = let x = 0 in let mut = mutex()
+             in proc (n) proc (d)
+                  begin
+                   wait(mut);
+                   print(n); 
+                   print(x);
+                   set x = -(x,-1);
+                   print(n); 
+                   print(x);
+                   signal(mut)
+                  end
+   in begin
+       spawn((ctr 100));
+       spawn((ctr 200));
+       spawn((ctr 300));
+       999
+      end"
+        999)
+
+;;       ;; > (set! the-time-slice 20)
+;;       ;; > (run-one 'safe-ctr)
+;;       ;; 100
+;;       ;; 0
+;;       ;; 100
+;;       ;; 1
+;;       ;; 200
+;;       ;; 1
+;;       ;; 200
+;;       ;; 2
+;;       ;; 300
+;;       ;; 2
+;;       ;; 300
+;;       ;; 3
+;;       ;; 999
+;;       ;; > 
+
+      (producer-consumer-with-mutex "
+let buffer = 0 
+in let   mut = mutex()  % mutex open means the buffer is non-empty
+in let
+  producer = proc (n) 
+              letrec 
+                waitloop(k) 
+                 = if zero?(k) 
+                   then 
+                    begin
+                     set buffer = n;
+                     signal(mut)  % give it up
+                    end
+                   else 
+                    begin
+                        print(-(k,-200));
+                        (waitloop -(k,1))
+                    end
+              in (waitloop 5)
+in let consumer = proc (d)
+                     begin
+                      wait(mut);
+                      buffer
+                     end
+in
+ begin
+  wait(mut);   % grab the mutex before the consumer starts
+  spawn(proc (d) (producer 44));
+  print(300);
+  (consumer 86)
+ end
+"
+        44)
+
+ 
+      ))
+  )
+
+
+
diff --git a/collects/tests/eopl/chapter5/thread-lang/top.scm b/collects/tests/eopl/chapter5/thread-lang/top.scm
new file mode 100755
index 0000000000..55ee4f4b01
--- /dev/null
+++ b/collects/tests/eopl/chapter5/thread-lang/top.scm
@@ -0,0 +1,59 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all N), where N is the size of the
+  ;; time slice.
+
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")   
+  (require "lang.scm")                  ; for scan&parse
+  (require "interp.scm")                ; for value-of-program
+  (require "tests.scm")                 ; for test-list
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  (define run
+    (lambda (timeslice string)
+      (value-of-program timeslice (scan&parse string))))
+  
+  (define run-all
+    (lambda (timeslice)
+      (run-tests! 
+        (lambda (string) (run timeslice string))
+        equal-answer? test-list)))
+  
+  (define run-one
+    (lambda (timeslice test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run timeslice (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        ((list? sloppy-val) (list-val (map sloppy->expval sloppy-val)))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+
+
+  ;; (stop-after-first-error #t)
+  ;; (run-all 5)
+  ;; (run-one 1000 'producer-consumer)
+
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter6/cps-lang/cps-in-lang.scm b/collects/tests/eopl/chapter6/cps-lang/cps-in-lang.scm
new file mode 100755
index 0000000000..a2236c5c41
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/cps-in-lang.scm
@@ -0,0 +1,79 @@
+(module cps-in-lang (lib "eopl.ss" "eopl")                
+  
+  ;; input language for the CPS converter.
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("+" "(" (separated-list expression ",") ")")
+        sum-exp)
+
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression
+        ("letrec" 
+          (arbno identifier "(" (arbno identifier) ")"
+            "=" expression)
+          "in"
+          expression)
+        letrec-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" (arbno identifier) ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression (arbno expression) ")")
+       call-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter6/cps-lang/cps-out-lang.scm b/collects/tests/eopl/chapter6/cps-lang/cps-out-lang.scm
new file mode 100755
index 0000000000..f4192a5e88
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/cps-out-lang.scm
@@ -0,0 +1,94 @@
+(module cps-out-lang (lib "eopl.ss" "eopl")                
+  
+  ;; output language from the cps converter
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define cps-out-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+ 
+ (define cps-out-grammar
+
+    '((cps-out-program (tfexp) cps-a-program)
+
+      (simple-expression (number) cps-const-exp)
+
+      (simple-expression (identifier) cps-var-exp)
+
+      (simple-expression
+        ("-" "(" simple-expression "," simple-expression ")")
+        cps-diff-exp)
+      
+      (simple-expression
+       ("zero?" "(" simple-expression ")")
+       cps-zero?-exp)
+
+      (simple-expression
+        ("+" "(" (separated-list simple-expression ",") ")")
+        cps-sum-exp)
+
+      (simple-expression
+       ("proc" "(" (arbno identifier) ")" tfexp)
+       cps-proc-exp)
+
+      (tfexp
+        (simple-expression)
+        simple-exp->exp)   
+
+      (tfexp
+       ("let" identifier "=" simple-expression "in" tfexp)
+       cps-let-exp)   
+
+      (tfexp
+        ("letrec" 
+          (arbno identifier "(" (arbno identifier) ")"
+            "=" tfexp)
+          "in"
+          tfexp)
+        cps-letrec-exp)
+
+      (tfexp
+       ("if" simple-expression "then" tfexp "else" tfexp)
+       cps-if-exp)
+
+      (tfexp
+       ("(" simple-expression (arbno simple-expression) ")")      
+       cps-call-exp)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes cps-out-lexical-spec cps-out-grammar)
+  
+  (define cps-show-the-datatypes
+    (lambda ()
+      (sllgen:list-define-datatypes cps-out-lexical-spec cps-out-grammar)))
+  
+  (define cps-out-scan&parse
+    (sllgen:make-string-parser cps-out-lexical-spec cps-out-grammar))
+  
+  (define cps-out-just-scan
+    (sllgen:make-string-scanner cps-out-lexical-spec cps-out-grammar))
+  
+  ;;;;;;;;;;;;;;;; a primitive pretty-printer ;;;;;;;;;;;;;;;;
+
+  ;; exercise: Write a pretty-printer for programs in CPS-OUT.
+
+;;   (define cps-program->string
+;;     (lambda (pgm)
+;;       (cases cps-out-program pgm
+;;         (cps-a-program (exp1) (tfexp->string exp1 0)))))
+
+  )
diff --git a/collects/tests/eopl/chapter6/cps-lang/cps.scm b/collects/tests/eopl/chapter6/cps-lang/cps.scm
new file mode 100755
index 0000000000..15c8085ff1
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/cps.scm
@@ -0,0 +1,260 @@
+(module cps (lib "eopl.ss" "eopl")                
+  
+  (require "drscheme-init.scm")
+  (require "cps-in-lang.scm")
+  (require "cps-out-lang.scm")
+
+  (provide cps-of-program)
+
+  ;; cps-of-program : InpExp -> TfExp
+  ;; Page: 224
+  (define cps-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (cps-a-program
+            (cps-of-exps (list exp1)
+              (lambda (new-args) 
+                (simple-exp->exp (car new-args)))))))))
+
+  ;; cps-of-exp : Exp * SimpleExp -> TfExp
+  ;; Page: 222
+  (define cps-of-exp
+    (lambda (exp cont)
+      (cases expression exp
+        (const-exp (num) (make-send-to-cont cont (cps-const-exp num)))
+        (var-exp (var) (make-send-to-cont cont (cps-var-exp var)))
+        (proc-exp (vars body) 
+          (make-send-to-cont cont
+            (cps-proc-exp (append vars (list 'k%00))
+              (cps-of-exp body (cps-var-exp 'k%00)))))
+        (zero?-exp (exp1)
+          (cps-of-zero?-exp exp1 cont))
+        (diff-exp (exp1 exp2)
+          (cps-of-diff-exp exp1 exp2 cont))
+        (sum-exp (exps)
+          (cps-of-sum-exp exps cont))
+        (if-exp (exp1 exp2 exp3)
+          (cps-of-if-exp exp1 exp2 exp3 cont))
+        (let-exp (var exp1 body)
+          (cps-of-let-exp var exp1 body cont))
+        (letrec-exp (ids bidss proc-bodies body)
+          (cps-of-letrec-exp ids bidss proc-bodies body cont))
+        (call-exp (rator rands)
+          (cps-of-call-exp rator rands cont)))))
+
+  ;; cps-of-exps : Listof(InpExp) * (Listof(InpExp) -> TfExp) 
+  ;;                -> TfExp
+  ;; Page: 219
+  ;; usage: 
+  ;;   -- assume e_i's are non-simple, b_i's are simple
+  ;;   -- then 
+  ;;        (cps-of-exps '(b1 b2 e1 b3 e2 e3) F) ==
+  ;;        [e1](\v1.[e2](\v2.[e3](\v3.(F `(,<b1> ,<b2> ,v1 ,<b3> ,v2 ,v3)))))
+  ;;      where <b> is cps-of-simple-exp of b.
+  (define cps-of-exps
+    (lambda (exps builder)
+      (let cps-of-rest ((exps exps))
+        ;; cps-of-rest : Listof(InpExp) -> TfExp
+        (let ((pos (list-index
+                     (lambda (exp)
+                       (not (inp-exp-simple? exp)))
+                     exps)))
+          (if (not pos)
+            (builder (map cps-of-simple-exp exps))
+            (let ((var (fresh-identifier 'var)))
+              (cps-of-exp
+                (list-ref exps pos)
+                (cps-proc-exp (list var)
+                  (cps-of-rest
+                    (list-set exps pos (var-exp var)))))))))))
+
+  ;; inp-exp-simple? : InpExp -> Bool
+  ;; returns #t or #f, depending on whether exp would be a 
+  ;; simple-exp if reparsed using the CPS-OUT language.
+  (define inp-exp-simple?
+    (lambda (exp)
+      (cases expression exp
+        (const-exp (num) #t)
+        (var-exp (var) #t)
+        (diff-exp (exp1 exp2)
+          (and
+            (inp-exp-simple? exp1)
+            (inp-exp-simple? exp2)))
+        (zero?-exp (exp1)
+          (inp-exp-simple? exp1))
+        (proc-exp (ids exp) #t)
+        (sum-exp (exps)
+          (all-simple? exps))
+        (else #f))))
+
+  (define all-simple?
+    (lambda (exps)
+      (if (null? exps)
+        #t
+        (and (inp-exp-simple? (car exps))
+          (all-simple? (cdr exps))))))
+              
+
+  ;; takes a list of expressions and finds the position of the first
+  ;; one that is not a simple-exp, else returns #f
+  (define index-of-first-non-simple
+    (lambda (exps)
+      (cond
+        ((null? exps) #f)
+        ((inp-exp-simple? (car exps))
+         (let ((pos (index-of-first-non-simple (cdr exps))))
+           (if pos
+             (+ pos 1) #f)))
+        (else 0))))
+      
+  ;; cps-of-simple-exp : InpExp -> SimpleExp
+  ;; Page: 220
+  ;; assumes (inp-exp-simple? exp).
+  (define cps-of-simple-exp
+    (lambda (exp)
+      (cases expression exp
+        (const-exp (num) (cps-const-exp num))
+        (var-exp (var) (cps-var-exp var))
+        (diff-exp (exp1 exp2)
+          (cps-diff-exp
+            (cps-of-simple-exp exp1)
+            (cps-of-simple-exp exp2)))
+        (zero?-exp (exp1)
+          (cps-zero?-exp
+            (cps-of-simple-exp exp1)))
+        (proc-exp (ids exp) 
+          (cps-proc-exp (append ids (list 'k%00))
+            (cps-of-exp exp (cps-var-exp 'k%00))))
+        (sum-exp (exps)
+          (cps-sum-exp
+            (map cps-of-simple-exp exps)))
+        (else 
+          (report-invalid-exp-to-cps-of-simple-exp exp)))))
+
+  (define report-invalid-exp-to-cps-of-simple-exp
+    (lambda (exp)
+      (eopl:error 'cps-simple-of-exp
+        "non-simple expression to cps-of-simple-exp: ~s"
+        exp)))
+
+  ;; make-send-to-cont : SimpleExp * SimpleExp -> TfExp
+  ;; Page: 214
+  (define make-send-to-cont
+    (lambda (cont bexp)
+      (cps-call-exp cont (list bexp))))
+
+  ;; cps-of-zero?-exp : InpExp * SimpleExp -> TfExp
+  ;; Page: 222
+  (define cps-of-zero?-exp
+    (lambda (exp1 k-exp)
+      (cps-of-exps (list exp1)
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-zero?-exp 
+              (car new-rands)))))))
+
+  ;; cps-of-sum-exp : Listof (InpExp) * SimpleExp -> TfExp
+  ;; Page: 219
+  (define cps-of-sum-exp
+    (lambda (exps k-exp)
+      (cps-of-exps exps
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-sum-exp new-rands))))))
+
+  ;; cps-of-diff-exp : InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-diff-exp
+    (lambda (exp1 exp2 k-exp)
+      (cps-of-exps
+        (list exp1 exp2)
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-diff-exp
+              (car new-rands)
+              (cadr new-rands)))))))
+
+  ;; cps-of-if-exp : InpExp * InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-if-exp
+    (lambda (exp1 exp2 exp3 k-exp)
+      (cps-of-exps (list exp1)
+        (lambda (new-rands)
+          (cps-if-exp (car new-rands)
+            (cps-of-exp exp2 k-exp)
+            (cps-of-exp exp3 k-exp))))))
+
+  ;; cps-of-let-exp : Var * InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 222
+  (define cps-of-let-exp
+    (lambda (id rhs body k-exp)
+      (cps-of-exps (list rhs)
+        (lambda (new-rands)
+          (cps-let-exp id 
+            (car new-rands)
+            (cps-of-exp body k-exp))))))
+
+  ;; cps-of-letrec-exp :
+  ;; Listof(Listof(Var)) * Listof(InpExp) * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-letrec-exp
+    (lambda (proc-names idss proc-bodies body k-exp)
+      (cps-letrec-exp
+        proc-names
+        (map
+          (lambda (ids) (append ids (list 'k%00)))
+          idss)
+        (map
+          (lambda (exp) (cps-of-exp exp (cps-var-exp 'k%00)))
+          proc-bodies)
+        (cps-of-exp body k-exp))))
+
+  ;; cps-of-call-exp : InpExp * Listof(InpExp) * SimpleExp -> TfExp
+  ;; Page: 220
+  (define cps-of-call-exp
+    (lambda (rator rands k-exp)
+      (cps-of-exps (cons rator rands)
+        (lambda (new-rands)
+          (cps-call-exp
+            (car new-rands)
+            (append (cdr new-rands) (list k-exp)))))))
+
+  ;;;;;;;;;;;;;;;; utilities ;;;;;;;;;;;;;;;;
+
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  ;; list-set : SchemeList * Int * SchemeVal -> SchemeList
+  ;; returns a list lst1 that is just like lst, except that 
+  ;; (listref lst1 n) = val.
+  (define list-set
+    (lambda (lst n val)
+      (cond
+        ((null? lst) (eopl:error 'list-set "ran off end"))
+        ((zero? n) (cons val (cdr lst)))
+        (else (cons (car lst) (list-set (cdr lst) (- n 1) val))))))
+
+  ;; list-index : (SchemeVal -> Bool) * SchemeList -> Maybe(Int)
+  ;; returns the smallest number n such that (pred (listref lst n))
+  ;; is true.  If pred is false on every element of lst, then returns
+  ;; #f. 
+  (define list-index
+    (lambda (pred lst)
+      (cond
+        ((null? lst) #f)
+        ((pred (car lst)) 0)
+        ((list-index pred (cdr lst)) => (lambda (n) (+ n 1)))
+        (else #f))))
+        
+  )
diff --git a/collects/tests/eopl/chapter6/cps-lang/data-structures.scm b/collects/tests/eopl/chapter6/cps-lang/data-structures.scm
new file mode 100755
index 0000000000..3027c312a1
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/data-structures.scm
@@ -0,0 +1,154 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "cps-out-lang.scm")          ; for tfexp?
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+  ;; the interpreter is tail-recursive, so it really doesn't do
+  ;; anything with the continuation.  So all we need is one
+  ;; continuation value.
+
+  (define-datatype continuation continuation?
+    (end-cont)                     
+    )
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (vars (list-of symbol?))
+      (body tfexp?)
+      (env environment?)))
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;;; represent environment as a list of bindings.
+;;; binding ::= ('let    (list-of id) (list-of expval)) 
+;;;           | ('letrec (list-of id) (list-of bvar) (list-of expression))
+
+;;; The first binding for extend-env*, the second is for
+;;; extend-env-rec**. 
+
+;;; this representation is designed to make the printed representation
+;;; of the environment more readable.
+
+  (define empty-env
+    (lambda ()
+      '()))
+  
+  (define empty-env? 
+    (lambda (x) (null? x)))
+
+  (define extend-env*
+    (lambda (syms vals old-env)
+      (cons (list 'let syms vals) old-env)))
+
+  (define extend-env-rec**
+    (lambda (p-names b-varss p-bodies saved-env)
+      (cons 
+        (list 'letrec p-names b-varss p-bodies)
+        saved-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (null? env) 
+        (eopl:error 'apply-env "No binding for ~s" search-sym)
+        (let* ((binding (car env))
+               (saved-env (cdr env)))
+          (let ((pos (list-index search-sym (cadr binding))))
+            (if pos
+              (case (car binding)
+                ((let)
+                 (list-ref (caddr binding) pos))
+                ((letrec)
+                 (let ((bvars (caddr binding))
+                       (bodies (cadddr binding)))
+                     (proc-val
+                       (procedure
+                         (list-ref bvars pos)
+                         (list-ref bodies pos)
+                         env)))))
+              (apply-env saved-env search-sym)))))))
+
+  ;; returns position of sym in los, else #f
+  (define list-index
+    (lambda (sym los)
+      (let loop ((pos 0) (los los))
+        ;; los is at position pos of the original los
+        (cond
+          ((null? los) #f)
+          ((eqv? sym (car los)) pos)
+          (else (loop (+ pos 1) (cdr los)))))))
+
+;; not precise, but will do.
+  (define environment?
+    (list-of
+      (lambda (p)
+        (and 
+          (pair? p)
+          (or (eqv? (car p) 'let) (eqv? (car p) 'letrec))))))
+
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (let ((extend-env1
+            (lambda (sym val env)
+              (extend-env* (list sym) (list val) env))))    
+      (lambda ()
+        (extend-env1
+          'i (num-val 1)
+          (extend-env1
+            'v (num-val 5)
+            (extend-env1
+              'x (num-val 10)
+              (empty-env)))))))
+
+  ;; exercise:  Improve this code by getting rid of extend-env1.
+
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-lang/drscheme-init.scm b/collects/tests/eopl/chapter6/cps-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter6/cps-lang/interp.scm b/collects/tests/eopl/chapter6/cps-lang/interp.scm
new file mode 100755
index 0000000000..3e679ae51e
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/interp.scm
@@ -0,0 +1,120 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "cps-out-lang.scm")
+  (require "data-structures.scm")       ; this includes environments
+
+  (provide value-of-program value-of/k)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+
+  (define value-of-program 
+    (lambda (pgm)
+      (cases cps-out-program pgm
+        (cps-a-program (exp1)
+          (value-of/k exp1 (init-env) (end-cont))))))
+
+  (define value-of-simple-exp
+    (lambda (exp env)
+      (cases simple-expression exp
+        (cps-const-exp (num) (num-val num))
+        (cps-var-exp (var) (apply-env env var))
+
+        (cps-diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of-simple-exp exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of-simple-exp exp2 env))))
+            (num-val
+	      (- val1 val2))))
+
+        (cps-zero?-exp (exp1)
+          (bool-val
+            (zero?
+              (expval->num
+                (value-of-simple-exp exp1 env)))))
+
+        (cps-sum-exp (exps)
+          (let ((nums (map
+                        (lambda (exp)
+                          (expval->num
+                            (value-of-simple-exp exp env)))
+                        exps)))
+            (num-val
+              (let sum-loop ((nums nums))
+                (if (null? nums) 0
+                  (+ (car nums) (sum-loop (cdr nums))))))))
+
+        (cps-proc-exp (vars body)
+          (proc-val
+            (procedure vars body env)))
+
+        )))
+  
+  ;; value-of/k : TfExp * Env * Cont -> FinalAnswer
+  ;; Page: 209
+  (define value-of/k
+    (lambda (exp env cont)
+      (cases tfexp exp
+        (simple-exp->exp (simple)
+          (apply-cont cont
+            (value-of-simple-exp simple env)))
+        (cps-let-exp (var rhs body)
+         (let ((val (value-of-simple-exp rhs env)))
+            (value-of/k body
+              (extend-env* (list var) (list val) env)
+              cont)))
+        (cps-letrec-exp (p-names b-varss p-bodies letrec-body)
+          (value-of/k letrec-body
+            (extend-env-rec** p-names b-varss p-bodies env)
+            cont))
+        (cps-if-exp (simple1 body1 body2)
+          (if (expval->bool (value-of-simple-exp simple1 env))
+            (value-of/k body1 env cont)
+            (value-of/k body2 env cont)))
+        (cps-call-exp (rator rands)
+          (let ((rator-proc
+                  (expval->proc
+                    (value-of-simple-exp rator env)))
+                (rand-vals
+                  (map
+                    (lambda (simple)
+                      (value-of-simple-exp simple env))
+                    rands)))
+            (apply-procedure/k rator-proc rand-vals cont))))))
+
+  ;; apply-cont : Cont * ExpVal -> Final-ExpVal
+  ;; there's only one continuation, and it only gets invoked once, at
+  ;; the end of the computation.
+  (define apply-cont
+    (lambda (cont val)
+      (cases continuation cont
+        (end-cont () val))))
+      
+  ;; apply-procedure/k : Proc * ExpVal * Cont -> ExpVal
+  ;; Page: 209 
+  (define apply-procedure/k
+    (lambda (proc1 args cont)
+      (cases proc proc1
+        (procedure (vars body saved-env)
+          (value-of/k body
+            (extend-env* vars args saved-env)
+            cont)))))
+
+  '(define apply-procedure/k
+    (lambda (proc1 args cont)
+      (cases proc proc1
+        (procedure (vars body saved-env)
+          (value-of/k body
+            (extend-env* vars args saved-env)
+            cont)))))
+
+  ;; trace has to be in the module where the procedure is defined.
+  ;; (trace value-of/k apply-cont)
+
+  )
diff --git a/collects/tests/eopl/chapter6/cps-lang/tests.scm b/collects/tests/eopl/chapter6/cps-lang/tests.scm
new file mode 100755
index 0000000000..7b3e4aad46
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/tests.scm
@@ -0,0 +1,155 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+
+      (nested-procs-not-in-cps "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+
+      (nested-procs-in-tf "(proc (x y) -(x,y)  5 6)" -1)
+
+      (nested-procs2 "let f = proc(x y) -(x,y) in (f -(10,5) 6)"
+        -1)
+      
+      (y-combinator-1-not-in-tf "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+     
+
+      ;; this one is not in cps
+    (twice "
+        (proc (twice)
+           ((twice proc (z) -(z,1)) 11)
+         proc (f) proc (x) (f (f x)))"
+      9)
+
+    (twice-cps "
+      let twice = proc(f x k)
+                    (f x  proc (z) (f z k))
+      in (twice 
+          proc (x k) (k -(x,1))
+          11
+          proc(z) z)"
+      9)
+
+    (cps-both-simple "
+       let f = proc (x) -(x,1)
+       in (f 27)"
+      26)
+
+    (cps-simple-rator "
+       let f = proc (x) -(x,1)
+       in (f (f 27))"
+      25)
+
+    (cps-simple-rand "
+       let f = proc (x) proc (y) -(x,y)
+       in ((f 27) 4)"
+      23)
+
+    (cps-neither-simple "
+      let f = proc (x) proc (y) -(x, y)
+      in let g = proc (z) -(z, 1)
+      in ((f 27) (g 11))"
+      17)
+
+    (cps-serious-zero-test "
+      let f = proc (x) -(x, 1)
+      in if zero?((f 1)) then 11 else 22"
+      11)
+
+    (sum-test-1 "+()" 0)
+    (sum-test-2 "+(2,3,4)" 9)
+
+    (letrec-test-1 "letrec f(x) = 17 in 34" 34)
+
+    (letrec-test-2 "letrec f(x y) = -(x,y) in -(34, 2)" 32)
+
+    (letrec-test-3 "
+       letrec even(x) = if zero?(x) then zero?(0) else (odd -(x,1))
+              odd (x) = if zero?(x) then zero?(1) else (even -(x,1))
+       in (even 5)"
+      #f)
+
+    (letrec-test-4 "
+      letrec fib(n) = if zero?(n) then 1
+                      else if zero?(-(n,1)) then 1
+                      else -((fib -(n,1)), -(0, (fib -(n,2))))
+      in (fib 5)"
+      8)
+
+    (letrec-sum-test-5 "
+      letrec fib(n) = if zero?(n) then 1
+                      else if zero?(-(n,1)) then 1
+                      else -((fib -(n,1)), -(0, (fib -(n,2))))
+      in +((fib 1), 12, (fib 5))"
+      21)
+
+    ))
+
+
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-lang/top.scm b/collects/tests/eopl/chapter6/cps-lang/top.scm
new file mode 100755
index 0000000000..9fe5e8d103
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-lang/top.scm
@@ -0,0 +1,74 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")        ; for expval constructors
+  (require "cps-in-lang.scm")            ; for scan&parse
+  (require "cps.scm")                    ; for cps transformer
+  (require "interp.scm")                 ; for value-of-program
+  (require "tests.scm")                  ; for test-list
+
+  (require "cps-out-lang.scm")              ; for cps-program->string 
+  
+  (provide (all-defined))
+  (provide (all-from "interp.scm"))
+
+  (define instrument-cps (make-parameter #f))  
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (let ((cpsed-pgm
+             (cps-of-program (scan&parse string))))
+        (if (instrument-cps) (pretty-print cpsed-pgm))
+        (value-of-program cpsed-pgm))))
+
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+          (eopl:error 'sloppy->expval 
+            "Can't convert sloppy value to expval: ~s"
+            sloppy-val)))))
+    
+  ;; run-one : Symbol -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+
+  ;; (stop-after-first-error #t)
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-in-lang.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-in-lang.scm
new file mode 100755
index 0000000000..04f5c33990
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-in-lang.scm
@@ -0,0 +1,95 @@
+(module cps-in-lang (lib "eopl.ss" "eopl")                
+  
+ ;; input language for the CPS converter, based on EXPLICIT-REFS
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("+" "(" (separated-list expression ",") ")")
+        sum-exp)
+
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression
+        ("letrec" 
+          (arbno identifier "(" (arbno identifier) ")"
+            "=" expression)
+          "in"
+          expression)
+        letrec-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" (arbno identifier) ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression (arbno expression) ")")
+       call-exp)
+
+      (expression
+        ("print" "(" expression ")")
+        print-exp)
+
+      (expression
+        ("newref" "(" expression ")")
+        newref-exp)
+
+      (expression
+        ("deref" "(" expression ")")
+        deref-exp)
+
+      (expression
+        ("setref" "(" expression "," expression ")")
+        setref-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-out-lang.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-out-lang.scm
new file mode 100755
index 0000000000..53566b7ab8
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps-out-lang.scm
@@ -0,0 +1,101 @@
+(module cps-out-lang (lib "eopl.ss" "eopl")                
+  
+  ;; output language from the cps converter, including explicit references
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define cps-out-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+ 
+ (define cps-out-grammar
+    '((cps-out-program (tfexp) cps-a-program)
+
+      (simple-expression (number) cps-const-exp)
+
+      (simple-expression (identifier) cps-var-exp)
+
+      (simple-expression
+        ("-" "(" simple-expression "," simple-expression ")")
+        cps-diff-exp)
+      
+      (simple-expression
+       ("zero?" "(" simple-expression ")")
+       cps-zero?-exp)
+
+      (simple-expression
+        ("+" "(" (separated-list simple-expression ",") ")")
+        cps-sum-exp)
+
+      (simple-expression
+       ("proc" "(" (arbno identifier) ")" tfexp)
+       cps-proc-exp)
+
+      (tfexp
+        (simple-expression)
+        simple-exp->exp)   
+
+      (tfexp
+       ("let" identifier "=" simple-expression "in" tfexp)
+       cps-let-exp)   
+
+      (tfexp
+        ("letrec" 
+          (arbno identifier "(" (arbno identifier) ")"
+            "=" tfexp)
+          "in"
+          tfexp)
+        cps-letrec-exp)
+
+      (tfexp
+       ("if" simple-expression "then" tfexp "else" tfexp)
+       cps-if-exp)
+
+      (tfexp
+       ("(" simple-expression (arbno simple-expression) ")")      
+       cps-call-exp)
+      
+      (tfexp
+        ("printk" "(" simple-expression ")" ";" tfexp)
+        cps-printk-exp)
+
+      (tfexp
+        ("newrefk" "(" simple-expression "," simple-expression ")")
+        cps-newrefk-exp)
+
+      (tfexp
+        ("derefk" "(" simple-expression  "," simple-expression ")")
+        cps-derefk-exp)
+
+      (tfexp
+        ("setrefk"
+          "(" simple-expression "," simple-expression ")" ";"
+          tfexp )
+        cps-setrefk-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes cps-out-lexical-spec cps-out-grammar)
+  
+  (define cps-out-show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes cps-out-lexical-spec cps-out-grammar)))
+  
+  (define cps-out-scan&parse
+    (sllgen:make-string-parser cps-out-lexical-spec cps-out-grammar))
+  
+  (define cps-just-scan
+    (sllgen:make-string-scanner cps-out-lexical-spec cps-out-grammar))
+
+  )
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/cps.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps.scm
new file mode 100755
index 0000000000..21fcfeb7f6
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/cps.scm
@@ -0,0 +1,296 @@
+(module cps (lib "eopl.ss" "eopl")                
+  
+  (require "drscheme-init.scm")
+  (require "cps-in-lang.scm")
+  (require "cps-out-lang.scm")
+
+  (provide cps-of-program)
+
+  ;; cps-of-program : InpExp -> TfExp
+  ;; Page: 224
+  (define cps-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (cps-a-program
+            (cps-of-exps (list exp1)
+              (lambda (new-args) 
+                (simple-exp->exp (car new-args)))))))))
+
+  ;; cps-of-exp : Exp * SimpleExp -> TfExp
+  ;; Page: 222, 228, 231
+  (define cps-of-exp
+    (lambda (exp k-exp)
+      (cases expression exp
+        (const-exp (num) (make-send-to-cont k-exp (cps-const-exp num)))
+        (var-exp (var) (make-send-to-cont k-exp (cps-var-exp var)))
+        (proc-exp (vars body) 
+          (make-send-to-cont k-exp
+            (cps-proc-exp (append vars (list 'k%00))
+              (cps-of-exp body (cps-var-exp 'k%00)))))
+        (zero?-exp (exp1)
+          (cps-of-zero?-exp exp1 k-exp))
+        (diff-exp (exp1 exp2)
+          (cps-of-diff-exp exp1 exp2 k-exp))
+        (sum-exp (exps)
+          (cps-of-sum-exp exps k-exp))
+        (if-exp (exp1 exp2 exp3)
+          (cps-of-if-exp exp1 exp2 exp3 k-exp))
+        (let-exp (var exp1 body)
+          (cps-of-let-exp var exp1 body k-exp))
+        (letrec-exp (ids bidss proc-bodies body)
+          (cps-of-letrec-exp ids bidss proc-bodies body k-exp))
+        (call-exp (rator rands)
+          (cps-of-call-exp rator rands k-exp))
+ 
+        ;; new for cps-side-effects-lang
+        ;; Page: 228
+        (print-exp (rator)
+          (cps-of-exps (list rator)
+            (lambda (simples)
+              (cps-printk-exp
+                (car simples)
+                (make-send-to-cont k-exp (cps-const-exp 38))))))
+
+        ;; Page 231
+        (newref-exp (exp1)
+          (cps-of-exps (list exp1)
+            (lambda (simples)
+              (cps-newrefk-exp (car simples) k-exp))))
+
+        (deref-exp (exp1)
+          (cps-of-exps (list exp1)
+            (lambda (simples)
+              (cps-derefk-exp (car simples) k-exp))))
+
+        (setref-exp (exp1 exp2)
+          (cps-of-exps (list exp1 exp2)
+            (lambda (simples)
+              (cps-setrefk-exp 
+                (car simples)
+                (cadr simples)
+                ;; the third argument will be evaluated tail-recursively.
+                ;; returns 23, just like in explicit-refs
+                (make-send-to-cont k-exp (cps-const-exp 23))))))
+
+        )))
+
+  ;; cps-of-exps : (list-of expression) * 
+  ;;                      ((list-of cps-simple-expression) -> cps-expression)
+  ;;                      -> cps-expression
+  ;; Page: 219
+  ;; usage: 
+  ;;   -- assume e_i's are non-simple, b_i's are simple
+  ;;   -- then 
+  ;;        (cps-of-exps '(b1 b2 e1 b3 e2 e3) F) ==
+  ;;        [e1](\v1.[e2](\v2.[e3](\v3.(F `(,<b1> ,<b2> ,v1 ,<b3> ,v2 ,v3)))))
+  ;;      where <b> is cps-of-simple-exp of b.
+  (define cps-of-exps
+    (lambda (exps builder)
+      (let cps-of-rest ((exps exps))
+        ;; cps-of-rest : Listof(InpExp) -> TfExp
+        (let ((pos (list-index
+                     (lambda (exp)
+                       (not (inp-exp-simple? exp)))
+                     exps)))
+          (if (not pos)
+            (builder (map cps-of-simple-exp exps))
+            (let ((var (fresh-identifier 'var)))
+              (cps-of-exp
+                (list-ref exps pos)
+                (cps-proc-exp (list var)
+                  (cps-of-rest
+                    (list-set exps pos (var-exp var)))))))))))
+
+  ;; inp-exp-simple? : InpExp -> Bool
+  ;; returns #t or #f, depending on whether exp would be a 
+  ;; simple-exp if reparsed using the CPS-OUT language.
+  (define inp-exp-simple?
+    (lambda (exp)
+      (cases expression exp
+        (const-exp (num) #t)
+        (var-exp (var) #t)
+        (diff-exp (exp1 exp2)
+          (and
+            (inp-exp-simple? exp1)
+            (inp-exp-simple? exp2)))
+        (zero?-exp (exp1)
+          (inp-exp-simple? exp1))
+        (proc-exp (ids exp) #t)
+        (sum-exp (exps)
+          (all-simple? exps))
+        (else #f))))
+
+  (define all-simple?
+    (lambda (exps)
+      (if (null? exps)
+        #t
+        (and (inp-exp-simple? (car exps))
+          (all-simple? (cdr exps))))))
+              
+
+  ;; takes a list of expressions and finds the position of the first
+  ;; one that is not a simple-exp, else returns #f
+  (define index-of-first-non-simple
+    (lambda (exps)
+      (cond
+        ((null? exps) #f)
+        ((inp-exp-simple? (car exps))
+         (let ((pos (index-of-first-non-simple (cdr exps))))
+           (if pos
+             (+ pos 1) #f)))
+        (else 0))))
+      
+  ;; cps-of-simple-exp : InpExp -> SimpleExp
+  ;; Page: 220
+  ;; assumes (inp-exp-simple? exp).
+  (define cps-of-simple-exp
+    (lambda (exp)
+      (cases expression exp
+        (const-exp (num) (cps-const-exp num))
+        (var-exp (var) (cps-var-exp var))
+        (diff-exp (exp1 exp2)
+          (cps-diff-exp
+            (cps-of-simple-exp exp1)
+            (cps-of-simple-exp exp2)))
+        (zero?-exp (exp1)
+          (cps-zero?-exp
+            (cps-of-simple-exp exp1)))
+        (proc-exp (ids exp) 
+          (cps-proc-exp (append ids (list 'k%00))
+            (cps-of-exp exp (cps-var-exp 'k%00))))
+        (sum-exp (exps)
+          (cps-sum-exp
+            (map cps-of-simple-exp exps)))
+        (else 
+          (report-invalid-exp-to-cps-of-simple-exp exp)))))
+
+  (define report-invalid-exp-to-cps-of-simple-exp
+    (lambda (exp)
+      (eopl:error 'cps-simple-of-exp
+        "non-simple expression to cps-of-simple-exp: ~s"
+        exp)))
+
+  ;; make-send-to-cont : SimpleExp * SimpleExp -> TfExp
+  ;; Page: 214
+  (define make-send-to-cont
+    (lambda (cont bexp)
+      (cps-call-exp cont (list bexp))))
+
+
+  ;; cps-of-zero?-exp : InpExp * SimpleExp -> TfExp
+  ;; Page: 222
+  (define cps-of-zero?-exp
+    (lambda (exp1 k-exp)
+      (cps-of-exps (list exp1)
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-zero?-exp 
+              (car new-rands)))))))
+
+  ;; cps-of-sum-exp : Listof (InpExp) * SimpleExp -> TfExp
+  ;; Page: 219
+  (define cps-of-sum-exp
+    (lambda (exps k-exp)
+      (cps-of-exps exps
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-sum-exp new-rands))))))
+
+  ;; cps-of-diff-exp : InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-diff-exp
+    (lambda (exp1 exp2 k-exp)
+      (cps-of-exps
+        (list exp1 exp2)
+        (lambda (new-rands)
+          (make-send-to-cont
+            k-exp
+            (cps-diff-exp
+              (car new-rands)
+              (cadr new-rands)))))))
+
+
+  ;; cps-of-if-exp : InpExp * InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-if-exp
+    (lambda (exp1 exp2 exp3 k-exp)
+      (cps-of-exps (list exp1)
+        (lambda (new-rands)
+          (cps-if-exp (car new-rands)
+            (cps-of-exp exp2 k-exp)
+            (cps-of-exp exp3 k-exp))))))
+
+  ;; cps-of-let-exp : Var * InpExp * InpExp * SimpleExp -> TfExp
+  ;; Page: 222
+  (define cps-of-let-exp
+    (lambda (id rhs body k-exp)
+      (cps-of-exps (list rhs)
+        (lambda (new-rands)
+          (cps-let-exp id 
+            (car new-rands)
+            (cps-of-exp body k-exp))))))
+
+  ;; cps-of-letrec-exp :
+  ;; Listof(Listof(Var)) * Listof(InpExp) * InpExp * SimpleExp -> TfExp
+  ;; Page: 223
+  (define cps-of-letrec-exp
+    (lambda (proc-names idss proc-bodies body k-exp)
+      (cps-letrec-exp
+        proc-names
+        (map
+          (lambda (ids) (append ids (list 'k%00)))
+          idss)
+        (map
+          (lambda (exp) (cps-of-exp exp (cps-var-exp 'k%00)))
+          proc-bodies)
+        (cps-of-exp body k-exp))))
+
+  ;; cps-of-call-exp : InpExp * Listof(InpExp) * SimpleExp -> TfExp
+  ;; Page: 220
+  (define cps-of-call-exp
+    (lambda (rator rands k-exp)
+      (cps-of-exps (cons rator rands)
+        (lambda (new-rands)
+          (cps-call-exp
+            (car new-rands)
+            (append (cdr new-rands) (list k-exp)))))))
+
+ ;;;;;;;;;;;;;;;; utilities ;;;;;;;;;;;;;;;;
+
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  ;; list-set : SchemeList * Int * SchemeVal -> SchemeList
+  ;; returns a list lst1 that is just like lst, except that 
+  ;; (listref lst1 n) = val.
+  (define list-set
+    (lambda (lst n val)
+      (cond
+        ((null? lst) (eopl:error 'list-set "ran off end"))
+        ((zero? n) (cons val (cdr lst)))
+        (else (cons (car lst) (list-set (cdr lst) (- n 1) val))))))
+
+  ;; list-index : (SchemeVal -> Bool) * SchemeList -> Maybe(Int)
+  ;; returns the smallest number n such that (pred (listref lst n))
+  ;; is true.  If pred is false on every element of lst, then returns
+  ;; #f. 
+  (define list-index
+    (lambda (pred lst)
+      (cond
+        ((null? lst) #f)
+        ((pred (car lst)) 0)
+        ((list-index pred (cdr lst)) => (lambda (n) (+ n 1)))
+        (else #f))))
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/data-structures.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/data-structures.scm
new file mode 100755
index 0000000000..d2171dc52a
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/data-structures.scm
@@ -0,0 +1,164 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "cps-out-lang.scm")          ; for tfexp?
+  (require "store.scm")                 ; for reference?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+     (ref-val
+      (ref reference?))
+     )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; continuations ;;;;;;;;;;;;;;;;
+
+  ;; the interpreter is tail-recursive, so it really doesn't do
+  ;; anything with the continuation.  So all we need is one
+  ;; continuation value.
+
+  (define-datatype continuation continuation?
+    (end-cont)                     
+    )
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (vars (list-of symbol?))
+      (body tfexp?)
+      (env environment?)))
+
+;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
+
+;;; represent environment as a list of bindings.
+;;; binding ::= ('let    (list-of id) (list-of expval)) 
+;;;           | ('letrec (list-of id) (list-of bvar) (list-of tfexp))
+
+;;; The first binding for extend-env, the second is for
+;;; extend-env-rec**. 
+
+;;; this representation is designed to make the printed representation
+;;; of the environment more readable.
+
+  (define empty-env
+    (lambda ()
+      '()))
+  
+  (define empty-env? 
+    (lambda (x) (null? x)))
+
+  (define extend-env*
+    (lambda (syms vals old-env)
+      (cons (list 'let syms vals) old-env)))
+
+  (define extend-env-rec**
+    (lambda (p-names b-varss p-bodies saved-env)
+      (cons 
+        (list 'letrec p-names b-varss p-bodies)
+        saved-env)))
+
+  (define apply-env
+    (lambda (env search-sym)
+      (if (null? env) 
+        (eopl:error 'apply-env "No binding for ~s" search-sym)
+        (let* ((binding (car env))
+               (saved-env (cdr env)))
+          (let ((pos (list-index search-sym (cadr binding))))
+            (if pos
+              (case (car binding)
+                ((let)
+                 (list-ref (caddr binding) pos))
+                ((letrec)
+                 (let ((bvars (caddr binding))
+                       (bodies (cadddr binding)))
+                     (proc-val
+                       (procedure
+                         (list-ref bvars pos)
+                         (list-ref bodies pos)
+                         env)))))
+              (apply-env saved-env search-sym)))))))
+
+  ;; returns position of sym in los, else #f
+  (define list-index
+    (lambda (sym los)
+      (let loop ((pos 0) (los los))
+        ;; los is at position pos of the original los
+        (cond
+          ((null? los) #f)
+          ((eqv? sym (car los)) pos)
+          (else (loop (+ pos 1) (cdr los)))))))
+
+;; not precise, but will do.
+  (define environment?
+    (list-of
+      (lambda (p)
+        (and 
+          (pair? p)
+          (or (eqv? (car p) 'let) (eqv? (car p) 'letrec))))))
+
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (let ((extend-env1
+            (lambda (sym val env)
+              (extend-env* (list sym) (list val) env))))    
+      (lambda ()
+        (extend-env1
+          'i (num-val 1)
+          (extend-env1
+            'v (num-val 5)
+            (extend-env1
+              'x (num-val 10)
+              (empty-env)))))))
+
+  ;; exercise:  Improve this code by getting rid of extend-env1.
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/drscheme-init.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/interp-tests.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/interp-tests.scm
new file mode 100755
index 0000000000..e7fba36eec
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/interp-tests.scm
@@ -0,0 +1,207 @@
+(module interp-tests mzscheme
+  
+  ;; this consists entirely of expressions that are already in cps.
+
+  ;; exercise: for each expression that is marked "not in cps",
+  ;; explain why it is not cps.
+
+  (provide tests-for-interp)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define tests-for-interp
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      (cps-nested-arith-left "let x = -(44,33) in -(x,22)" -11)
+      (cps-nested-arith-right "let y = -(22,11) in -(55, y)" 44)
+
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "let x = -(11,11) in if zero?(x) then 3 else 4" 3)
+      (if-eval-test-false "let x = -(11,12)in if zero?(x) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+      ;; (nested-procs-not-in-cps "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+
+      (nested-procs-in-tf "(proc (x y) -(x,y)  5 6)" -1)
+
+      (nested-procs2 "let f = proc(x y) -(x,y) in (f -(10,5) 6)"
+        -1)
+      
+;;       (y-combinator-1-not-in-tf "
+;; let fix =  proc (f)
+;;             let d = proc (x) proc (z) ((f (x x)) z)
+;;             in proc (n) ((f (d d)) n)
+;; in let
+;;     t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+;; in let times4 = (fix t4m)
+;;    in (times4 3)" 12)
+     
+
+;;       ;; this one is not in cps
+;;     (twice "
+;;         (proc (twice)
+;;            ((twice proc (z) -(z,1)) 11)
+;;          proc (f) proc (x) (f (f x)))"
+;;       9)
+
+    (twice-in-cps "
+      let twice = proc(f x k)
+                    (f x  proc (z) (f z k))
+      in (twice 
+          proc (x k) (k -(x,1))
+          11
+          proc(z) z)"
+      9)
+
+    (cps-both-simple "
+       let f = proc (x) -(x,1)
+       in (f 27)"
+      26)
+
+    (sum-test-1 "+()" 0)
+    (sum-test-2 "+(2,3,4)" 9)
+
+    (letrec-test-1 "letrec f(x) = 17 in 34" 34)
+
+    (letrec-test-2 "letrec f(x y) = -(x,y) in -(34, 2)" 32)
+
+    (letrec-test-3 "
+       letrec even(x) = if zero?(x) then zero?(0) else (odd -(x,1))
+              odd (x) = if zero?(x) then zero?(1) else (even -(x,1))
+       in (even 5)"
+      #f)
+
+;; not in cps
+;;     (cps-simple-rator "
+;;        let f = proc (x) -(x,1)
+;;        in (f (f 27))"
+;;       25)
+
+;;     (cps-simple-rand "
+;;        let f = proc (x) proc (y) -(x,y)
+;;        in ((f 27) 4)"
+;;       23)
+
+;;     (cps-neither-simple "
+;;       let f = proc (x) proc (y) -(x, y)
+;;       in let g = proc (z) -(z, 1)
+;;       in ((f 27) (g 11))"
+;;       17)
+
+;;     (cps-serious-zero-test "
+;;       let f = proc (x) -(x, 1)
+;;       in if zero?((f 1)) then 11 else 22"
+;;       11)
+
+    (print-test-1
+      "let x = 3 in printk(-(x,1)); 33"
+      33)
+
+    (store-test-0
+      "newrefk(33, proc (loc1) 44)"
+      44)
+
+    (store-test-1
+      "newrefk(33, proc (loc1)
+                    newrefk(44, proc (loc2)
+                                 derefk(loc1, proc(ans)ans)))"
+      33)
+
+    (store-test-2 "
+      newrefk(33, proc (loc1)
+                   newrefk(44, proc (loc2)
+                                setrefk(loc1, 22);
+                                derefk(loc1, proc(ans)ans)))"
+      22)
+
+    (store-test-2a "
+      newrefk(33, proc (loc1)
+                   newrefk(44, proc (loc2)
+                                setrefk(loc1, 22);
+                                derefk(loc1, proc (ans) -(ans,1))))"
+      21)
+
+    (store-test-3  "
+      newrefk(33, proc (loc1)
+                   newrefk(44, proc (loc2)
+                                setrefk(loc2, 22);
+                                derefk(loc1, proc(ans)ans)))"
+      33)
+ 
+    (gensym-cps "
+       newrefk(0,
+        proc(ctr)
+         let g = proc(k) derefk(ctr,
+                                proc(v) setrefk(ctr, -(v,-1)); (k v))
+         in (g 
+            proc (x) (g 
+                      proc (y) -(x,y))))"
+      -1)
+
+    ;; in the example above, ctr is public.  Here it is local.
+    (gensym-cps-2 "
+      let makeg = proc (k1)
+                   newrefk(0, proc (ctr)
+                    (k1  proc (k) 
+                          derefk(ctr, 
+                                 proc (v) 
+                                  setrefk(ctr,-(v,-1));(k v))))
+      in (makeg
+          proc(g)
+           (g 
+            proc (x) (g 
+                      proc (y) -(x,y))))"
+      -1)
+
+    ))
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/interp.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/interp.scm
new file mode 100755
index 0000000000..ac80d735df
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/interp.scm
@@ -0,0 +1,137 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "cps-out-lang.scm")
+  (require "data-structures.scm")
+  (require "store.scm")
+
+  (provide value-of-program value-of/k)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)
+      (cases cps-out-program pgm
+        (cps-a-program (body)
+          (value-of/k body (init-env) (end-cont))))))
+
+  (define value-of-simple-exp
+    (lambda (exp env)
+
+      (cases simple-expression exp
+        (cps-const-exp (num) (num-val num))
+        (cps-var-exp (var) (apply-env env var))
+        (cps-diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of-simple-exp exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of-simple-exp exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        (cps-zero?-exp (exp1)
+          (bool-val
+            (zero?
+              (expval->num
+                (value-of-simple-exp exp1 env)))))
+        (cps-sum-exp (exps)
+          (let ((nums (map
+                        (lambda (exp)
+                          (expval->num
+                            (value-of-simple-exp exp env)))
+                        exps)))
+            (num-val
+              (let sum-loop ((nums nums))
+                (if (null? nums) 0
+                  (+ (car nums) (sum-loop (cdr nums))))))))
+        (cps-proc-exp (vars body)
+          (proc-val
+            (procedure vars body env)))
+        )))
+
+  ;; value-of/k : Exp * Env * Cont -> FinalAnswer
+  ;; Page: 228 and 230-231
+  (define value-of/k
+    (lambda (exp env cont)
+      (cases tfexp exp
+        (simple-exp->exp (bexp)
+          (apply-cont cont
+            (value-of-simple-exp bexp env)))
+        (cps-let-exp (var exp1 body)
+          (let ((val (value-of-simple-exp exp1 env)))
+            (value-of/k body
+              (extend-env* (list var) (list val) env)
+              cont)))
+        (cps-letrec-exp (p-names b-varss p-bodies letrec-body)
+          (value-of/k letrec-body
+            (extend-env-rec** p-names b-varss p-bodies env)
+            cont))
+        (cps-if-exp (exp1 exp2 exp3)
+          (value-of/k
+            (if (expval->bool (value-of-simple-exp exp1 env))
+              exp2
+              exp3)
+            env
+            cont))
+        (cps-call-exp (rator rands)
+          (let ((rator-proc (expval->proc (value-of-simple-exp rator env)))
+                (rand-vals (map 
+                             (lambda (bexp) (value-of-simple-exp bexp
+                                              env))
+                             rands)))
+            (apply-procedure/k rator-proc rand-vals cont)))
+
+        (cps-printk-exp (simple body)
+          (begin
+            (eopl:printf "~s~%" (value-of-simple-exp simple env))
+            (value-of/k body env cont)))
+            
+        (cps-newrefk-exp (simple1 simple2)
+          (let ((val1 (value-of-simple-exp simple1 env))
+                (val2 (value-of-simple-exp simple2 env)))
+            (let ((newval (ref-val (newref val1))))
+              (apply-procedure/k
+                (expval->proc val2)
+                (list newval)
+                cont))))
+
+        (cps-derefk-exp (simple1 simple2)
+          (apply-procedure/k
+            (expval->proc (value-of-simple-exp simple2 env))
+            (list
+              (deref
+                (expval->ref
+                  (value-of-simple-exp simple1 env))))
+            cont))
+
+       (cps-setrefk-exp (simple1 simple2 body)
+          (let ((ref (expval->ref (value-of-simple-exp simple1 env)))
+                (val (value-of-simple-exp simple2 env)))
+             (begin
+                (setref! ref val)
+                (value-of/k body env cont))))
+        )))
+
+  ;; apply-cont : Cont * ExpVal -> Final-ExpVal
+  ;; there's only one continuation, and it only gets invoked once, at
+  ;; the end of the computation.
+  (define apply-cont
+    (lambda (cont val)
+      (cases continuation cont
+        (end-cont () val))))      
+
+  ;; apply-procedure/k : Proc * ExpVal * Cont -> ExpVal
+  ;; Page: 209 
+  (define apply-procedure/k
+    (lambda (proc1 args cont)
+      (cases proc proc1
+        (procedure (vars body saved-env)
+          (value-of/k body
+            (extend-env* vars args saved-env)
+            cont)))))
+
+  )
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/store.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/store.scm
new file mode 100755
index 0000000000..f925bdcbda
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/store.scm
@@ -0,0 +1,110 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+   
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/tests.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/tests.scm
new file mode 100755
index 0000000000..b9c6f6db87
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/tests.scm
@@ -0,0 +1,206 @@
+(module tests mzscheme
+  
+  ;; tests for cps converter, including explicit references.
+
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+
+      (nested-procs-not-in-cps "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+
+      (nested-procs-in-tf "(proc (x y) -(x,y)  5 6)" -1)
+
+      (nested-procs2 "let f = proc(x y) -(x,y) in (f -(10,5) 6)"
+        -1)
+      
+      (y-combinator-1-not-in-tf "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+     
+
+      ;; this one is not in cps
+    (twice "
+        (proc (twice)
+           ((twice proc (z) -(z,1)) 11)
+         proc (f) proc (x) (f (f x)))"
+      9)
+
+    (twice-cps "
+      let twice = proc(f x k)
+                    (f x  proc (z) (f z k))
+      in (twice 
+          proc (x k) (k -(x,1))
+          11
+          proc(z) z)"
+      9)
+
+    (cps-both-simple "
+       let f = proc (x) -(x,1)
+       in (f 27)"
+      26)
+
+    (cps-simple-rator "
+       let f = proc (x) -(x,1)
+       in (f (f 27))"
+      25)
+
+    (cps-simple-rand "
+       let f = proc (x) proc (y) -(x,y)
+       in ((f 27) 4)"
+      23)
+
+    (cps-neither-simple "
+      let f = proc (x) proc (y) -(x, y)
+      in let g = proc (z) -(z, 1)
+      in ((f 27) (g 11))"
+      17)
+
+    (cps-serious-zero-test "
+      let f = proc (x) -(x, 1)
+      in if zero?((f 1)) then 11 else 22"
+      11)
+
+    (sum-test-1 "+()" 0)
+    (sum-test-2 "+(2,3,4)" 9)
+
+    (letrec-test-1 "letrec f(x) = 17 in 34" 34)
+
+    (letrec-test-2 "letrec f(x y) = -(x,y) in -(34, 2)" 32)
+
+    (letrec-test-3 "
+       letrec even(x) = if zero?(x) then zero?(0) else (odd -(x,1))
+              odd (x) = if zero?(x) then zero?(1) else (even -(x,1))
+       in (even 5)"
+      #f)
+
+    (letrec-test-4 "
+      letrec fib(n) = if zero?(n) then 1
+                      else if zero?(-(n,1)) then 1
+                      else -((fib -(n,1)), -(0, (fib -(n,2))))
+      in (fib 5)"
+      8)
+
+    (letrec-sum-test-5 "
+      letrec fib(n) = if zero?(n) then 1
+                      else if zero?(-(n,1)) then 1
+                      else -((fib -(n,1)), -(0, (fib -(n,2))))
+      in +((fib 1), 12, (fib 5))"
+      21)
+
+    ;; tests from explicit-refs
+      (gensym-test-1 
+"let g = let counter = newref(0) 
+         in proc (dummy) let d = setref(counter, -(deref(counter),-1))
+                    in deref(counter)
+in -((g 11),(g 22))"
+       -1)
+
+      (simple-store-test-1 "let x = newref(17) in deref(x)" 17)
+
+      (assignment-test-1 "let x = newref(17) 
+                          in let y = setref(x,27) in deref(x)"
+        27)
+
+      (gensym-test-2 
+"let g = let counter = newref(0) 
+         in proc (dummy) 
+             let dummy1 = setref(counter, -(deref(counter),-1))
+             in deref(counter)
+ in -((g 11),(g 22))"
+       -1)
+
+     (even-odd-via-set-1 "
+let x = newref(0)
+in letrec even(d) = if zero?(deref(x)) 
+                   then 1
+                   else let d = setref(x, -(deref(x),1))
+                        in (odd d)
+          odd(d)  = if zero?(deref(x)) 
+                   then 0
+                   else let d = setref(x, -(deref(x),1))
+                        in (even d)
+   in let d = setref(x,13) in (odd -100)" 1)
+
+ (even-odd-via-set-1 "
+let x = newref(0)
+in letrec even(d) = if zero?(deref(x)) 
+                   then 1
+                   else let d = setref(x, -(deref(x),1))
+                        in (odd d)
+          odd(d)  = if zero?(deref(x)) 
+                   then 0
+                   else let d = setref(x, -(deref(x),1))
+                        in (even d)
+   in let d = setref(x,13) in (odd -100)" 1)
+
+ (show-allocation-1 "
+let x = newref(22)
+in let f = proc (z) let zz = newref(-(z,deref(x))) in deref(zz)
+   in -((f 66), (f 55))"
+   11)
+
+    ))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter6/cps-side-effects-lang/top.scm b/collects/tests/eopl/chapter6/cps-side-effects-lang/top.scm
new file mode 100755
index 0000000000..1e9a393bec
--- /dev/null
+++ b/collects/tests/eopl/chapter6/cps-side-effects-lang/top.scm
@@ -0,0 +1,87 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Test the interpreter alone with (interpret-all)
+  ;; Test the cps converter and interprter with (run-all)
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")        ; for expval constructors
+  (require "cps-in-lang.scm")            ; for scan&parse
+  (require "cps.scm")                    ; for cps transformer
+  (require "interp.scm")                 ; for value-of-program
+  (require "interp-tests.scm")           ; for tests-for-interp
+  (require "tests.scm")                  ; for test-list
+
+  (require "cps-out-lang.scm")          ; for cps-program->string 
+  
+  (provide (all-defined))
+  (provide (all-from "interp.scm"))
+
+  (define instrument-cps (make-parameter #f))  
+  
+  ;;;;;;;;;;;;;;;; test the interpreter alone ;;;;;;;;;;;;;;;;
+  
+  ;; interpret : cps-out-lang string -> expval
+  (define interpret
+    (lambda (string)
+      (value-of-program (cps-out-scan&parse string))))
+  
+  ;; interpret-all : () -> unspecified
+  ;; runs all the tests in tests-for-interp, comparing the results with
+  ;; equal-answer?  
+  (define interpret-all
+    (lambda ()
+      (run-tests! interpret equal-answer? tests-for-interp)))
+
+  ;;;;;;;;;;;;;;;; test the converter and interpreter ;;;;;;;;;;;;;;;;
+
+  ;; run : cps-in-lang String -> ExpVal
+  (define run
+    (lambda (string)
+      (let ((cpsed-pgm
+             (cps-of-program (scan&parse string))))
+        (if (instrument-cps) (pretty-print cpsed-pgm))
+        (value-of-program cpsed-pgm))))
+
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  ;;;;;;;;;;;;;;;; auxiliaries ;;;;;;;;;;;;;;;;
+
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+          (eopl:error 'sloppy->expval 
+            "Can't convert sloppy value to expval: ~s"
+            sloppy-val)))))
+    
+  ;; run-one : Symbol -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+
+  ;; (stop-after-first-error #t)
+  ;; (run-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter7/checked/checker.scm b/collects/tests/eopl/chapter7/checked/checker.scm
new file mode 100755
index 0000000000..62cba59945
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/checker.scm
@@ -0,0 +1,145 @@
+(module checker (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+
+  (provide type-of type-of-program)
+
+  ;; check-equal-type! : Type * Type * Exp -> Unspecified
+  ;; Page: 242
+  (define check-equal-type!
+    (lambda (ty1 ty2 exp)
+      (if (not (equal? ty1 ty2))
+        (report-unequal-types ty1 ty2 exp))))
+
+  ;; report-unequal-types : Type * Type * Exp -> Unspecified
+  ;; Page: 243
+  (define report-unequal-types
+    (lambda (ty1 ty2 exp)
+      (eopl:error 'check-equal-type!  
+          "Types didn't match: ~s != ~a in~%~a"
+          (type-to-external-form ty1)
+          (type-to-external-form ty2)
+          exp)))
+
+  ;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
+  
+  ;; type-of-program : Program -> Type
+  ;; Page: 244
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1) (type-of exp1 (init-tenv))))))
+
+  ;; type-of : Exp * Tenv -> Type
+  ;; Page 244--246
+  (define type-of
+    (lambda (exp tenv)
+      (cases expression exp
+
+        ;; \commentbox{\hastype{\tenv}{\mv{num}}{\mathtt{int}}}
+        (const-exp (num) (int-type))
+
+        ;; \commentbox{\hastype{\tenv}{\var{}}{\tenv{}(\var{})}}
+        (var-exp (var) (apply-tenv tenv var))
+
+        ;; \commentbox{\diffrule}
+        (diff-exp (exp1 exp2)
+          (let ((ty1 (type-of exp1 tenv))
+                (ty2 (type-of exp2 tenv)))
+            (check-equal-type! ty1 (int-type) exp1)
+            (check-equal-type! ty2 (int-type) exp2)
+            (int-type)))
+
+        ;; \commentbox{\zerorule}
+        (zero?-exp (exp1)
+          (let ((ty1 (type-of exp1 tenv)))
+            (check-equal-type! ty1 (int-type) exp1)
+            (bool-type)))
+
+        ;; \commentbox{\condrule}
+        (if-exp (exp1 exp2 exp3)
+          (let ((ty1 (type-of exp1 tenv))
+                (ty2 (type-of exp2 tenv))
+                (ty3 (type-of exp3 tenv)))
+            (check-equal-type! ty1 (bool-type) exp1)
+            (check-equal-type! ty2 ty3 exp)
+            ty2))
+
+        ;; \commentbox{\letrule}
+        (let-exp (var exp1 body)
+          (let ((exp1-type (type-of exp1 tenv)))
+            (type-of body
+              (extend-tenv var exp1-type tenv))))
+
+        ;; \commentbox{\procrulechurch}
+        (proc-exp (var var-type body)
+          (let ((result-type
+                  (type-of body
+                    (extend-tenv var var-type tenv))))
+            (proc-type var-type result-type)))
+
+        ;; \commentbox{\apprule}
+        (call-exp (rator rand) 
+          (let ((rator-type (type-of rator tenv))
+                (rand-type  (type-of rand tenv)))
+            (cases type rator-type
+              (proc-type (arg-type result-type)
+                (begin
+                  (check-equal-type! arg-type rand-type rand)
+                  result-type))
+              (else
+                (report-rator-not-a-proc-type rator-type rator)))))
+
+        ;; \commentbox{\letrecrule}
+        (letrec-exp (p-result-type p-name b-var b-var-type p-body
+                      letrec-body)
+          (let ((tenv-for-letrec-body
+                  (extend-tenv p-name
+                    (proc-type b-var-type p-result-type)
+                    tenv)))
+            (let ((p-body-type 
+                    (type-of p-body
+                      (extend-tenv b-var b-var-type
+                        tenv-for-letrec-body)))) 
+              (check-equal-type!
+                p-body-type p-result-type p-body)
+              (type-of letrec-body tenv-for-letrec-body)))))))
+    
+  (define report-rator-not-a-proc-type
+    (lambda (rator-type rator)
+      (eopl:error 'type-of-expression
+        "Rator not a proc type:~%~s~%had rator type ~s"   
+           rator 
+           (type-to-external-form rator-type))))
+
+  ;;;;;;;;;;;;;;;; type environments ;;;;;;;;;;;;;;;;
+    
+  (define-datatype type-environment type-environment?
+    (empty-tenv-record)
+    (extended-tenv-record
+      (sym symbol?)
+      (type type?)
+      (tenv type-environment?)))
+    
+  (define empty-tenv empty-tenv-record)
+  (define extend-tenv extended-tenv-record)
+    
+  (define apply-tenv 
+    (lambda (tenv sym)
+      (cases type-environment tenv
+        (empty-tenv-record ()
+          (eopl:error 'apply-tenv "Unbound variable ~s" sym))
+        (extended-tenv-record (sym1 val1 old-env)
+          (if (eqv? sym sym1) 
+            val1
+            (apply-tenv old-env sym))))))
+  
+  (define init-tenv
+    (lambda ()
+      (extend-tenv 'x (int-type) 
+        (extend-tenv 'v (int-type)
+          (extend-tenv 'i (int-type)
+            (empty-tenv))))))
+
+  )
diff --git a/collects/tests/eopl/chapter7/checked/data-structures.scm b/collects/tests/eopl/chapter7/checked/data-structures.scm
new file mode 100755
index 0000000000..629d3fcf06
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/data-structures.scm
@@ -0,0 +1,64 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-rec
+      (p-name symbol?)
+      (b-var symbol?)
+      (p-body expression?)
+      (saved-env environment?)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/checked/drscheme-init.scm b/collects/tests/eopl/chapter7/checked/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter7/checked/environments.scm b/collects/tests/eopl/chapter7/checked/environments.scm
new file mode 100755
index 0000000000..b46926bb48
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/environments.scm
@@ -0,0 +1,41 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec (p-name b-var p-body saved-env)
+          (if (eqv? search-sym p-name)
+             (proc-val (procedure b-var p-body env))          
+             (apply-env saved-env search-sym))))))
+    
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/checked/interp.scm b/collects/tests/eopl/chapter7/checked/interp.scm
new file mode 100755
index 0000000000..6c0b079fed
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/interp.scm
@@ -0,0 +1,82 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> Expval
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (body)
+          (value-of body (init-env))))))
+
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (apply-env env var))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (value-of body
+              (extend-env var val env))))
+
+        (proc-exp (bvar ty body)
+	  (proc-val
+	    (procedure bvar body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (ty1 p-name b-var ty2 p-body letrec-body)
+          (value-of letrec-body
+            (extend-env-rec p-name b-var p-body env)))
+
+	    )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+  
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter7/checked/lang.scm b/collects/tests/eopl/chapter7/checked/lang.scm
new file mode 100755
index 0000000000..64e73a93ad
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/lang.scm
@@ -0,0 +1,99 @@
+(module lang (lib "eopl.ss" "eopl") 
+
+  ;; grammar for the CHECKED language
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+       (letter (arbno (or letter digit "_" "-" "?")))
+       symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+       ("zero?" "(" expression ")")
+       zero?-exp)
+
+      (expression
+       ("if" expression "then" expression "else" expression)
+       if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+       ("let" identifier "=" expression "in" expression)
+       let-exp)   
+
+      (expression
+       ("proc" "(" identifier ":" type ")" expression)
+       proc-exp)
+
+      (expression
+       ("(" expression expression ")")
+       call-exp)
+
+      (expression
+        ("letrec"
+          type identifier "(" identifier ":" type ")" "=" expression
+           "in" expression)
+        letrec-exp)
+
+      (type
+       ("int")
+       int-type)
+      
+      (type
+       ("bool")
+       bool-type)
+      
+      (type
+       ("(" type "->" type ")")
+       proc-type)
+      
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+;;;;;;;;;;;;;;;; type-to-external-form ;;;;;;;;;;;;;;;;
+
+  ;; type-to-external-form : Type -> List
+  ;; Page: 243
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (proc-type (arg-type result-type)
+          (list
+            (type-to-external-form arg-type)
+            '->
+            (type-to-external-form result-type))))))
+
+  )
diff --git a/collects/tests/eopl/chapter7/checked/tests.scm b/collects/tests/eopl/chapter7/checked/tests.scm
new file mode 100755
index 0000000000..0022536555
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/tests.scm
@@ -0,0 +1,256 @@
+(module tests mzscheme
+  
+  (provide tests-for-run tests-for-check)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define tests-for-run
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" 29)
+      (interp-ignores-type-info-in-proc "(proc(x : (int -> int)) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x : int) proc (y : int) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f : bool)
+            let d = proc (x : bool) proc (z : bool) ((f (x x)) z)
+            in proc (n : bool) ((f (d d)) n)
+in let
+    t4m = proc (f : bool) proc(x : bool) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec int even(odd : (int -> int))  = proc(x : int) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  int odd(x : int)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      ))
+
+  (define tests-for-check
+    '(
+      ;; tests from run-tests:
+  
+      ;; simple arithmetic
+      (positive-const "11" int)
+      (negative-const "-33" int)
+      (simple-arith-1 "-(44,33)" int)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" int)
+      (nested-arith-right "-(55, -(22,11))" int)
+  
+      ;; simple variables
+      (test-var-1 "x" int)
+      (test-var-2 "-(x,1)" int)
+      (test-var-3 "-(1,x)" int)
+
+      (zero-test-1 "zero?(-(3,2))" bool)
+      (zero-test-2 "-(2,zero?(0))" error)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(1) then 3 else 4" int)
+      (if-false "if zero?(0) then 3 else 4" int)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,12)) then 3 else 4" int)
+      (if-eval-test-false "if zero?(-(11, 11)) then 3 else 4" int)
+      (if-eval-then "if zero?(1) then -(22,1) else -(22,2)" int)
+      (if-eval-else "if zero?(0) then -(22,1) else -(22,2)" int)
+      
+      ;; make sure types of arms agree (new for lang5-1)
+      
+      (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+      (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" int)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" int)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" int)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" int)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int)
+      (checker-doesnt-ignore-type-info-in-proc 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" int)
+
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4)"
+        int)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then -((f -(x,1)), m) else 0 in (f 4)"
+        int)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc (f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool))) )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int)
+
+      (letrec-non-shadowing
+   "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in (fact 4)"
+        int)
+
+
+
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/checked/top.scm b/collects/tests/eopl/chapter7/checked/top.scm
new file mode 100755
index 0000000000..1633dc17a0
--- /dev/null
+++ b/collects/tests/eopl/chapter7/checked/top.scm
@@ -0,0 +1,96 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "checker.scm")               ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+  (require "tests.scm")                 ; for tests-for-run and tests-for-check
+  
+  (provide run run-all check check-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : string -> external-type
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal? tests-for-check)))
+
+  ;; check-one : symbol -> expval
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+ 
+  ;; (check-all)
+
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter7/inferred/data-structures.scm b/collects/tests/eopl/chapter7/inferred/data-structures.scm
new file mode 100755
index 0000000000..629d3fcf06
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/data-structures.scm
@@ -0,0 +1,64 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-rec
+      (p-name symbol?)
+      (b-var symbol?)
+      (p-body expression?)
+      (saved-env environment?)))
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/inferred/drscheme-init.scm b/collects/tests/eopl/chapter7/inferred/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter7/inferred/environments.scm b/collects/tests/eopl/chapter7/inferred/environments.scm
new file mode 100755
index 0000000000..a4e89f8bfc
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/environments.scm
@@ -0,0 +1,40 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (provide init-env empty-env extend-env apply-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env 
+       'i (num-val 1)
+       (extend-env
+        'v (num-val 5)
+        (extend-env
+         'x (num-val 10)
+         (empty-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-rec (p-name b-var p-body saved-env)
+          (if (eqv? search-sym p-name)
+             (proc-val (procedure b-var p-body env))          
+             (apply-env saved-env search-sym))))))
+    
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/inferred/equal-up-to-gensyms.scm b/collects/tests/eopl/chapter7/inferred/equal-up-to-gensyms.scm
new file mode 100755
index 0000000000..a8fb49a65c
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/equal-up-to-gensyms.scm
@@ -0,0 +1,81 @@
+(module equal-up-to-gensyms (lib "eopl.ss" "eopl")
+
+  (provide equal-types?)
+
+  (define equal-types?
+    (lambda (ty1 ty2)
+      (equal-up-to-gensyms? ty1 ty2)))
+
+  ;; S-exp = Sym | Listof(S-exp)
+  ;; A-list = Listof(Pair(TvarTypeSym, TvarTypesym))
+  ;; a tvar-type-sym is a symbol ending with a digit.
+
+  ;; equal-up-to-gensyms? : S-exp * S-exp -> Bool
+  ;; Page: 271
+  (define equal-up-to-gensyms?
+    (lambda (sexp1 sexp2)
+      (equal?
+        (apply-subst-to-sexp (canonical-subst sexp1) sexp1)
+        (apply-subst-to-sexp (canonical-subst sexp2) sexp2))))
+
+  ;; canonicalize : S-exp -> A-list
+  ;; usage: replaces all tvar-syms with tvar1, tvar2, etc.
+  ;; Page: 271
+  (define canonical-subst
+    (lambda (sexp)
+        ;; loop : sexp * alist -> alist
+        (let loop ((sexp sexp) (table '()))
+          (cond
+            ((null? sexp) table)
+            ((tvar-type-sym? sexp) 
+             (cond
+               ((assq sexp table) ; sexp is already bound, no more to
+                                  ; do 
+                table)
+               (else 
+                 (cons 
+                   ;; the length of the table serves as a counter!
+                   (cons sexp (ctr->ty (length table))) 
+                   table))))
+            ((pair? sexp)
+             (loop (cdr sexp)
+               (loop (car sexp) table)))
+            (else table)))))
+
+  ;; tvar-type-sym? : Sym -> Bool
+  ;; Page: 272
+  (define tvar-type-sym?
+    (lambda (sym)
+      (and (symbol? sym)
+        (char-numeric? (car (reverse (symbol->list sym)))))))
+
+  ;; symbol->list : Sym -> List
+  ;; Page: 272
+  (define symbol->list
+    (lambda (x) (string->list (symbol->string x))))
+
+  ;; apply-subst-to-sexp : A-list * S-exp -> S-exp
+  ;; Page: 272
+  (define apply-subst-to-sexp
+    (lambda (subst sexp)
+      (cond
+        ((null? sexp) sexp)
+        ((tvar-type-sym? sexp)
+         (cdr (assq sexp subst)))
+        ((pair? sexp)
+         (cons
+           (apply-subst-to-sexp subst (car sexp))
+           (apply-subst-to-sexp subst (cdr sexp))))
+        (else sexp))))
+
+  ;; ctr->ty : N -> Sym
+  ;; Page: 272
+  (define ctr->ty
+    (lambda (n)
+      (string->symbol
+        (string-append
+          "tvar"
+          (number->string n)))))
+
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/inferred/inferrer.scm b/collects/tests/eopl/chapter7/inferred/inferrer.scm
new file mode 100755
index 0000000000..c9553fde79
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/inferrer.scm
@@ -0,0 +1,176 @@
+(module inferrer  (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "unifier.scm")
+
+  (provide type-of-program type-of)
+
+  ;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
+
+  ;; we'll be thinking of the type of an expression as pair consisting
+  ;; of a type (possibly with some type variables in it) and a
+  ;; substitution that tells us how to interpret those type variables.
+
+  ;; Answer = Type * Subst
+  ;; type-of: Exp * Tenv * Subst  -> Answer
+
+  (define-datatype answer answer?
+    (an-answer                       
+      (type type?)
+      (subst substitution?)))
+
+  ;; type-of-program : Program -> Type
+  ;; Page: 267
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (exp1)
+          (cases answer (type-of exp1 (init-tenv) (empty-subst))
+            (an-answer (ty subst)
+              (apply-subst-to-type ty subst)))))))
+
+  ;; type-of : Exp * Tenv * Subst -> Type
+  ;; Page: 267--270
+  (define type-of
+    (lambda (exp tenv subst)
+      (cases expression exp
+        
+        (const-exp (num) (an-answer (int-type) subst))
+      
+        (zero?-exp (exp1)
+          (cases answer (type-of exp1 tenv subst)
+            (an-answer (type1 subst1)
+              (let ((subst2 (unifier type1 (int-type) subst1 exp)))
+                (an-answer (bool-type) subst2)))))
+
+        (diff-exp (exp1 exp2)
+          (cases answer (type-of exp1 tenv subst)
+            (an-answer (type1 subst1)
+              (let ((subst1 (unifier type1 (int-type) subst1 exp1)))
+                (cases answer (type-of exp2 tenv subst1)
+                  (an-answer (type2 subst2)
+                    (let ((subst2
+                            (unifier type2 (int-type) subst2 exp2)))
+                      (an-answer (int-type) subst2))))))))
+
+        (if-exp (exp1 exp2 exp3)
+          (cases answer (type-of exp1 tenv subst)
+            (an-answer (ty1 subst)
+              (let ((subst (unifier ty1 (bool-type) subst
+                             exp1)))
+                (cases answer (type-of exp2 tenv subst)
+                  (an-answer (ty2 subst)
+                    (cases answer (type-of exp3 tenv subst)
+                      (an-answer (ty3 subst)
+                        (let ((subst (unifier ty2 ty3 subst exp)))
+                          (an-answer ty2 subst))))))))))
+
+        (var-exp (var) (an-answer (apply-tenv tenv var) subst))
+
+        (let-exp (var exp1 body)
+          (cases answer (type-of exp1 tenv subst)
+            (an-answer (rhs-type subst)
+              (type-of body
+                (extend-tenv var rhs-type tenv)
+                subst))))
+
+        (proc-exp (var otype body)
+          (let ((arg-type (otype->type otype)))
+            (cases answer (type-of body
+                            (extend-tenv var arg-type tenv)
+                            subst)
+              (an-answer (result-type subst)
+                (an-answer
+                  (proc-type arg-type result-type)
+                  subst)))))
+
+        (call-exp (rator rand)
+          (let ((result-type (fresh-tvar-type)))
+            (cases answer (type-of rator tenv subst)
+              (an-answer (rator-type subst)
+                (cases answer (type-of rand tenv subst)
+                  (an-answer (rand-type subst)
+                    (let ((subst
+                            (unifier rator-type
+                              (proc-type rand-type result-type)
+                              subst
+                              exp)))
+                      (an-answer result-type subst))))))))
+
+        (letrec-exp (proc-result-otype proc-name 
+                      bvar proc-arg-otype 
+                      proc-body
+                      letrec-body)
+          (let ((proc-result-type
+                  (otype->type proc-result-otype)) 
+                (proc-arg-type
+                  (otype->type proc-arg-otype)))
+            (let ((tenv-for-letrec-body
+                    (extend-tenv 
+                      proc-name
+                      (proc-type proc-arg-type proc-result-type)
+                      tenv)))
+              (cases answer (type-of proc-body
+                              (extend-tenv
+                                bvar proc-arg-type tenv-for-letrec-body)
+                              subst)
+                (an-answer (proc-body-type subst)
+                  (let ((subst 
+                          (unifier proc-body-type proc-result-type subst
+                            proc-body))) 
+                    (type-of letrec-body
+                      tenv-for-letrec-body
+                      subst)))))))
+        
+        )))
+
+    ;;;;;;;;;;;;;;;; type environments ;;;;;;;;;;;;;;;;
+    
+  ;; why are these separated?
+
+  (define-datatype type-environment type-environment?
+    (empty-tenv-record)
+    (extended-tenv-record
+      (sym symbol?)
+      (type type?)
+      (tenv type-environment?)))
+    
+  (define empty-tenv empty-tenv-record)
+  (define extend-tenv extended-tenv-record)
+    
+  (define apply-tenv 
+    (lambda (tenv sym)
+      (cases type-environment tenv
+        (empty-tenv-record ()
+          (eopl:error 'apply-tenv "Unbound variable ~s" sym))
+        (extended-tenv-record (sym1 val1 old-env)
+          (if (eqv? sym sym1) 
+            val1
+            (apply-tenv old-env sym))))))
+  
+  (define init-tenv
+    (lambda ()
+      (extend-tenv 'x (int-type) 
+        (extend-tenv 'v (int-type)
+          (extend-tenv 'i (int-type)
+            (empty-tenv))))))
+
+  ;; fresh-tvar-type : () -> Type
+  ;; Page: 265  
+  (define fresh-tvar-type
+    (let ((sn 0))
+      (lambda ()
+        (set! sn (+ sn 1))
+        (tvar-type sn))))
+
+  ;; otype->type : OptionalType -> Type
+  ;; Page: 265
+  (define otype->type
+    (lambda (otype)
+      (cases optional-type otype
+        (no-type () (fresh-tvar-type))
+        (a-type (ty) ty))))
+
+  )
diff --git a/collects/tests/eopl/chapter7/inferred/interp.scm b/collects/tests/eopl/chapter7/inferred/interp.scm
new file mode 100755
index 0000000000..3a619f5a7a
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/interp.scm
@@ -0,0 +1,81 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  (define value-of-program 
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (body)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (apply-env env var))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (value-of body
+              (extend-env var val env))))
+
+        (proc-exp (bvar ty body)
+	  (proc-val
+	    (procedure bvar body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (ty1 p-name b-var ty2 p-body letrec-body)
+          (value-of letrec-body
+            (extend-env-rec p-name b-var p-body env)))
+
+	    )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+  
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter7/inferred/lang.scm b/collects/tests/eopl/chapter7/inferred/lang.scm
new file mode 100755
index 0000000000..cfea8d68c6
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/lang.scm
@@ -0,0 +1,150 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program (expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "("  identifier ":" optional-type ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression expression ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          optional-type identifier "(" identifier ":" optional-type ")"
+          "=" expression "in" expression)
+        letrec-exp)
+
+      (optional-type
+        ("?")
+        no-type)
+      
+      (optional-type
+        (type)
+        a-type)
+
+      (type
+        ("int")
+        int-type)
+      
+      (type
+        ("bool")
+        bool-type)
+      
+      (type
+        ("(" type "->" type ")")
+        proc-type)
+      
+      (type
+        ("%tvar-type" number)
+        tvar-type)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  
+
+  ;;;;;;;;;;;;;;;; syntactic tests and observers ;;;;;;;;;;;;;;;;
+
+  (define atomic-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (ty1 ty2) #f)
+        (tvar-type (sn) #f)
+        (else #t))))
+
+  (define proc-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (t1 t2) #t)
+        (else #f))))
+
+  (define tvar-type?
+    (lambda (ty)
+      (cases type ty
+        (tvar-type (serial-number) #t)
+        (else #f))))
+
+
+  (define proc-type->arg-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) arg-type)
+        (else (eopl:error 'proc-type->arg-type
+                "Not a proc type: ~s" ty)))))
+
+  (define proc-type->result-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) result-type)
+        (else (eopl:error 'proc-type->result-types
+                "Not a proc type: ~s" ty)))))
+
+  ;; type-to-external-form : Type -> List
+  ;; Page: 266
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (proc-type (arg-type result-type)
+          (list
+            (type-to-external-form arg-type)
+            '->
+            (type-to-external-form result-type)))
+        (tvar-type (serial-number)
+          (string->symbol
+            (string-append
+              "tvar"
+              (number->string serial-number)))))))
+  
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/inferred/substitutions.scm b/collects/tests/eopl/chapter7/inferred/substitutions.scm
new file mode 100755
index 0000000000..e4daed7508
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/substitutions.scm
@@ -0,0 +1,107 @@
+(module substitutions  (lib "eopl.ss" "eopl")
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "data-structures.scm")
+
+  (provide substitution? empty-subst extend-subst apply-subst-to-type)
+
+;;;;;;;;;;;;;;;; Unit substitution ;;;;;;;;;;;;;;;;
+
+  ;; apply-one-subst: type * tvar * type -> type
+  ;; (apply-one-subst ty0 var ty1) returns the type obtained by
+  ;; substituting ty1 for every occurrence of tvar in ty0.  This is
+  ;; sometimes written ty0[tvar=ty1]
+
+  ;; apply-one-subst : Type * Tvar * Type -> Type
+  ;; Page: 260
+  (define apply-one-subst
+    (lambda (ty0 tvar ty1)
+      (cases type ty0
+        (int-type () (int-type))
+        (bool-type () (bool-type))
+        (proc-type (arg-type result-type)
+          (proc-type
+            (apply-one-subst arg-type tvar ty1)
+            (apply-one-subst result-type tvar ty1)))
+        (tvar-type (sn)
+          (if (equal? ty0 tvar) ty1 ty0)))))
+
+;;;;;;;;;;;;;;;; Substitutions ;;;;;;;;;;;;;;;;
+
+  ;; a substitution is a map from unknown types to types.
+  ;; we'll represent this as an association list.
+
+  (define pair-of
+    (lambda (pred1 pred2)
+      (lambda (val)
+        (and (pair? val) (pred1 (car val)) (pred2 (cdr val))))))
+
+  (define substitution? 
+    (list-of (pair-of tvar-type? type?)))
+
+  ;; basic observer: apply-subst-to-type
+  ;; this is sometimes written ty1.subst 
+
+  ;; apply-subst-to-type : Type * Subst -> Type
+  ;; Page: 261
+  (define apply-subst-to-type
+    (lambda (ty subst)
+      (cases type ty
+        (int-type () (int-type))
+        (bool-type () (bool-type))
+        (proc-type (t1 t2)
+          (proc-type
+            (apply-subst-to-type t1 subst)
+            (apply-subst-to-type t2 subst)))
+        (tvar-type (sn)
+          (let ((tmp (assoc ty subst)))
+            (if tmp
+              (cdr tmp)
+              ty))))))
+
+  ;; empty-subst : () -> Subst
+  ;; produces a representation of the empty substitution.
+
+  ;; extend-subst : Subst * Tvar * Type -> Subst
+
+  ;; (extend-subst s tv t) produces a substitution with the property
+  ;; that for all t0,
+  
+  ;;   (apply-subst t0 (extend-subst s tv t))
+  ;;   = (apply-one-subst (apply-subst t0 s) tv t)
+
+  ;; i.e.,  t0.(s[tv=t]) = (t0.s)[tv=t]
+
+  ;; this means that for any type variable tv0 in the domain of s,
+
+  ;;   (apply-subst tv0 (extend-subst s tv t))
+  ;;   = (apply-one-subst (apply-subst tv0 s) tv t)
+
+  ;; so we extend the substitution with a new element, and apply [t/v] to every
+  ;; element already in the substitution. 
+
+
+  ;; empty-subst : () -> Subst
+  ;; Page 262
+  (define empty-subst (lambda () '()))
+
+  ;; extend-subst : Subst * Tvar * Type -> Subst
+  ;; usage: tvar not already bound in subst.
+  ;; Page: 262
+  (define extend-subst
+    (lambda (subst tvar ty)
+      (cons
+        (cons tvar ty)
+        (map 
+          (lambda (p)
+            (let ((oldlhs (car p))
+                  (oldrhs (cdr p)))
+              (cons
+                oldlhs
+                (apply-one-subst oldrhs tvar ty))))
+          subst))))
+
+  )
+
+
+
diff --git a/collects/tests/eopl/chapter7/inferred/tests.scm b/collects/tests/eopl/chapter7/inferred/tests.scm
new file mode 100755
index 0000000000..5e1744d3a5
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/tests.scm
@@ -0,0 +1,317 @@
+(module tests mzscheme
+  
+  (provide tests-for-run tests-for-check)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define tests-for-run
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" 29)
+      (interp-ignores-type-info-in-proc "(proc(x : (int -> int)) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" 29)
+
+
+      (nested-procs "((proc(x : int) proc (y : int) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x : int) proc (y : int) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+      (y-combinator-1 "
+let fix =  proc(f : bool)
+            let d = proc (x : bool) proc (z : bool) ((f (x x)) z)
+            in proc (n : bool) ((f (d d)) n)
+in let
+    t4m = proc (f : bool) proc(x : bool) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+                                        ;      (fact-of-6  "letrec
+                                        ;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+                                        ;in (fact 6)" 
+                                        ;                  720)
+      
+      (HO-nested-letrecs
+        "letrec int even(odd : (int -> int))  = proc(x : int) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  int odd(x : int)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      ))
+
+  (define tests-for-check
+    '(
+      ;; tests from run-tests:
+  
+      ;; simple arithmetic
+      (positive-const "11" int)
+      (negative-const "-33" int)
+      (simple-arith-1 "-(44,33)" int)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" int)
+      (nested-arith-right "-(55, -(22,11))" int)
+  
+      ;; simple variables
+      (test-var-1 "x" int)
+      (test-var-2 "-(x,1)" int)
+      (test-var-3 "-(1,x)" int)
+
+      (zero-test-1 "zero?(-(3,2))" bool)
+      (zero-test-2 "-(2,zero?(0))" error)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(1) then 3 else 4" int)
+      (if-false "if zero?(0) then 3 else 4" int)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,12)) then 3 else 4" int)
+      (if-eval-test-false "if zero?(-(11, 11)) then 3 else 4" int)
+      (if-eval-then "if zero?(1) then -(22,1) else -(22,2)" int)
+      (if-eval-else "if zero?(0) then -(22,1) else -(22,2)" int)
+      
+      ;; make sure types of arms agree (new for lang5-1)
+      
+      (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+      (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" int)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" int)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" int)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" int)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int)
+      (checker-doesnt-ignore-type-info-in-proc 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" int)
+
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4)"
+        int)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then -((f -(x,1)), m) else 0 in (f 4)"
+        int)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc (f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool))) )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int)
+
+      (letrec-non-shadowing
+        "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in (fact 4)"
+        int)
+
+      (pgm7b "
+letrec 
+  ? fact (x : ?) = if zero?(x) then 1 else -(x, (fact -(x,1)))
+in fact"
+        (int -> int))
+
+      
+
+;; multiple letrecs no longer in the language
+;;       (pgm8b "
+;;       letrec ? odd(x : ?)  = if zero?(x) then 0 else (even -(x,1))
+;;              ? even(x : ?) = if zero?(x) then 1 else (odd  -(x,1))
+;;       in odd" (int -> int))
+
+
+;;       (pgm8ab "
+;;       letrec ? odd(x : ?)  = if zero?(x) then 0 else (even -(x,1))
+;;              ? even(bool x) = if zero?(x) then 1 else (odd  -(x,1))
+;;       in (odd 13)" error)
+
+      ;; circular type
+      (circular-type "
+      let fix =  proc (f : ?)
+                  let d = proc (x : ?) proc (z : ?) (f (x x) z)
+                  in proc (n : ?) (f (d d) n)
+          t4m = proc (f : ?, x : ?) if zero?(x) then 0 else +(4,(f -(x,1)))
+      in let times4 = (fix t4m)
+         in (times4 3)"
+        error)
+
+;; multiple arguments not in the language
+;;       (pgm11b
+;;         "letrec ? even (odd : ?, x : ?) = if zero?(x) then 1 else (odd -(x,1))
+;;          in letrec  ? odd(x : ?) = if zero?(x) then 0 else (even odd -(x,1))
+;;          in (odd 13)"
+;;         int)
+
+      (pgm11b-curried
+        "letrec ? even (odd : ?) = proc (x : ?) if zero?(x) then 1 else (odd -(x,1))
+         in letrec  ? odd(x : ?) = if zero?(x) then 0 else ((even odd) -(x,1))
+         in (odd 13)"
+        int)
+
+      (dont-infer-circular-type 
+        "letrec ? f (x : ?) = (f f) in 33"
+        error)
+
+      (polymorphic-type-1 
+        "letrec ? f (x : ?) = (f x) in f"
+        (tvar01 -> tvar02))
+
+      ;; this test should fail, because the type given is insufficiently
+      ;; polymorphic.  So we use it for testing the test harness, but not for
+      ;; testing the checker.
+
+      ;;       (polymorphic-type-1a
+      ;;         "letrec ? f (x : ?) = (f x) in f"
+      ;;         (tvar01 -> tvar01))
+
+      (polymorphic-type-2 
+        "letrec ? f (x : ?) = (f x) in proc (n : ?) (f -(n,1))"
+        (int -> tvar01))
+
+      ))
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter7/inferred/top.scm b/collects/tests/eopl/chapter7/inferred/top.scm
new file mode 100755
index 0000000000..94e22da931
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/top.scm
@@ -0,0 +1,100 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "inferrer.scm")              ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+  (require "tests.scm")                 ; for test-for-run and tests-for-check
+
+  (require "equal-up-to-gensyms.scm")   ; for equal-up-to-gensyms
+  
+  (provide run run-all check check-all)
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Symbol -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : string -> external-type
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-types?
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal-types? tests-for-check)))
+
+  ;; check-one : symbol -> expval
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+  
+  ;; (stop-after-first-error #t)
+ 
+  ;; (check-all)
+
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter7/inferred/unifier.scm b/collects/tests/eopl/chapter7/inferred/unifier.scm
new file mode 100755
index 0000000000..bc1e6c08dc
--- /dev/null
+++ b/collects/tests/eopl/chapter7/inferred/unifier.scm
@@ -0,0 +1,77 @@
+(module unifier (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "substitutions.scm")
+
+  ;; this provides a new view of substitutions, in which unifier
+  ;; replaces extend-env as a constructor.
+  (provide unifier substitution? empty-subst apply-subst-to-type)
+
+  ;; we'll maintain the invariant that no variable bound in the
+  ;; substitution occurs in any of the right-hand sides of the
+  ;; substitution. 
+
+
+;;;;;;;;;;;;;;;; the unifier ;;;;;;;;;;;;;;;;
+
+  ;; unifier : Type * Type * Subst * Exp -> Subst OR Fails
+  ;; Page: 264
+  (define unifier
+    (lambda (ty1 ty2 subst exp)
+      (let ((ty1 (apply-subst-to-type ty1 subst))
+            (ty2 (apply-subst-to-type ty2 subst)))
+        (cond
+          ((equal? ty1 ty2) subst)            
+          ((tvar-type? ty1)
+           (if (no-occurrence? ty1 ty2)
+             (extend-subst subst ty1 ty2)
+             (report-no-occurrence-violation ty1 ty2 exp)))
+          ((tvar-type? ty2)
+           (if (no-occurrence? ty2 ty1)
+             (extend-subst subst ty2 ty1)
+             (report-no-occurrence-violation ty2 ty1 exp)))
+          ((and (proc-type? ty1) (proc-type? ty2))
+           (let ((subst (unifier
+                          (proc-type->arg-type ty1)
+                          (proc-type->arg-type ty2)
+                          subst exp)))
+             (let ((subst (unifier
+                            (proc-type->result-type ty1)
+                            (proc-type->result-type ty2)
+                            subst exp)))
+               subst)))
+          (else (report-unification-failure ty1 ty2 exp))))))
+
+  (define report-unification-failure
+    (lambda (ty1 ty2 exp) 
+      (eopl:error 'unification-failure
+        "Type mismatch: ~s doesn't match ~s in ~s~%"
+        (type-to-external-form ty1)
+        (type-to-external-form ty2)
+        exp)))
+
+  (define report-no-occurrence-violation
+    (lambda (ty1 ty2 exp)
+      (eopl:error 'check-no-occurence!
+        "Can't unify: type variable ~s occurs in type ~s in expression ~s~%" 
+        (type-to-external-form ty1)
+        (type-to-external-form ty2)
+        exp)))
+
+  ;; no-occurrence? : Tvar * Type -> Bool
+  ;; usage: Is there an occurrence of tvar in ty?
+  ;; Page: 265
+  (define no-occurrence?
+    (lambda (tvar ty)
+      (cases type ty
+        (int-type () #t)
+        (bool-type () #t)
+        (proc-type (arg-type result-type)
+          (and
+            (no-occurrence? tvar arg-type)
+            (no-occurrence? tvar result-type)))
+        (tvar-type (serial-number) (not (equal? tvar ty))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/check-modules.scm b/collects/tests/eopl/chapter8/abstract-types-lang/check-modules.scm
new file mode 100755
index 0000000000..507c7dd543
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/check-modules.scm
@@ -0,0 +1,94 @@
+(module check-modules (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+  (require "checker.scm")
+  (require "subtyping.scm")
+
+  (provide type-of-program)
+ 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 
+  ;; type-of-program : Program -> Type
+  ;; Page: 286
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (type-of body
+            (add-module-defns-to-tenv module-defs (empty-tenv)))))))
+
+  ;; add-module-defns-to-tenv : Listof(ModuleDefn) * Tenv -> Tenv
+  ;; Page: 286, 305
+  (define add-module-defns-to-tenv
+    (lambda (defns tenv)
+      (if (null? defns)
+        tenv
+        (cases module-definition (car defns)
+          (a-module-definition (m-name expected-iface m-body)
+            (let ((actual-iface (interface-of m-body tenv)))
+              (if (<:-iface actual-iface expected-iface tenv)
+                ;; ok, continue in extended tenv
+                (let ((new-env (extend-tenv-with-module
+                                 m-name
+                                 (expand-iface m-name expected-iface tenv)
+                                 tenv)))
+                  (add-module-defns-to-tenv (cdr defns) new-env))
+                ;; no, raise error
+                (report-module-doesnt-satisfy-iface m-name
+                  expected-iface actual-iface))))))))
+
+  ;; interface-of : ModuleBody * Tenv -> Iface
+  ;; Page: 322
+  (define interface-of
+    (lambda (m-body tenv)
+      (cases module-body m-body
+        (defns-module-body (defns)
+          (simple-iface
+            (defns-to-decls defns tenv))) )))
+
+  ;; defns-to-decls : Listof(Defn) * Tenv -> Listof(Decl)
+  ;; Page: 288, 305
+  ;; Convert defns to a set of declarations for just the names defined
+  ;; in defns.  Do this in the context of tenv.  The tenv is extended
+  ;; at every step, so we get the correct let* scoping
+  (define defns-to-decls
+    (lambda (defns tenv)
+      (if (null? defns)
+        '()
+        (cases definition (car defns)
+          (val-defn (var-name exp)
+            (let ((ty (type-of exp tenv)))
+              (let ((new-env (extend-tenv var-name ty tenv)))
+                (cons
+                  (val-decl var-name ty)
+                  (defns-to-decls (cdr defns) new-env)))))
+          (type-defn (name ty)
+            (let ((new-env (extend-tenv-with-type
+                             name
+                             (expand-type ty tenv)
+                             tenv)))
+              (cons
+                (transparent-type-decl name ty)
+                (defns-to-decls (cdr defns) new-env))))))))
+
+  (define raise-bad-module-application-error!
+    (lambda (expected-type rand-type body)
+      (pretty-print
+        (list 'bad-module-application body
+          'actual-rand-interface: rand-type
+          'expected-rand-interface: expected-type))
+      (eopl:error 'interface-of
+        "Bad module application ~s" body)))
+
+  (define report-module-doesnt-satisfy-iface
+    (lambda (m-name expected-type actual-type)
+      (pretty-print 
+        (list 'error-in-defn-of-module: m-name
+          'expected-type: expected-type
+          'actual-type: actual-type))
+      (eopl:error 'type-of-module-defn)))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/checker.scm b/collects/tests/eopl/chapter8/abstract-types-lang/checker.scm
new file mode 100755
index 0000000000..b298bbdc72
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/checker.scm
@@ -0,0 +1,126 @@
+(module checker (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+
+  (provide type-of)
+
+  ;; check-equal-type! : Type * Type * Exp -> Unspecified
+  ;; Page: 242
+  (define check-equal-type!
+    (lambda (ty1 ty2 exp)
+      (if (not (equal? ty1 ty2))
+        (report-unequal-types ty1 ty2 exp))))
+
+  ;; report-unequal-types : Type * Type * Exp -> Unspecified
+  ;; Page: 243
+  (define report-unequal-types
+    (lambda (ty1 ty2 exp)
+      (eopl:error 'check-equal-type!  
+          "Types didn't match: ~s != ~a in~%~a"
+          (type-to-external-form ty1)
+          (type-to-external-form ty2)
+          exp)))
+
+  ;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
+  
+  ;; moved to check-modules.scm
+  ;; type-of-program : Program -> Type
+  ;; Page: 244 
+  ;;   (define type-of-program
+  ;;     (lambda (pgm)
+  ;;       (cases program pgm
+  ;;         (a-program (exp1) 
+  ;;           (type-of exp1 (init-tenv))))))
+
+
+  ;; type-of : Exp * Tenv -> Type
+  ;; Page 244--246.  See also page 285.
+  (define type-of
+    (lambda (exp tenv)
+      (cases expression exp
+        (const-exp (num) (int-type))
+        
+        (diff-exp (exp1 exp2)
+          (let ((type1 (type-of exp1 tenv))
+                (type2 (type-of exp2 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (check-equal-type! type2 (int-type) exp2)
+            (int-type)))
+        
+        (zero?-exp (exp1)
+          (let ((type1 (type-of exp1 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (bool-type)))
+        
+        (if-exp (exp1 exp2 exp3)
+          (let ((ty1 (type-of exp1 tenv))
+                (ty2 (type-of exp2 tenv))
+                (ty3 (type-of exp3 tenv)))
+            (check-equal-type! ty1 (bool-type) exp1)
+            (check-equal-type! ty2 ty3 exp)
+            ty2))
+        
+        (var-exp (var) (apply-tenv tenv var))
+
+        ;; lookup-qualified-var-in-tenv defined on page 285.
+        (qualified-var-exp (m-name var-name) 
+          (lookup-qualified-var-in-tenv m-name var-name tenv))
+
+        (let-exp (var exp1 body)
+          (let ((rhs-type (type-of exp1 tenv)))
+            (type-of body (extend-tenv var rhs-type tenv))))
+        
+        (proc-exp (bvar bvar-type body)
+          (let ((expanded-bvar-type
+                  (expand-type bvar-type tenv)))
+            (let ((result-type
+                    (type-of body
+                      (extend-tenv
+                        bvar
+                        expanded-bvar-type
+                        tenv))))
+              (proc-type expanded-bvar-type result-type))))
+        
+        (call-exp (rator rand) 
+          (let ((rator-type (type-of rator tenv))
+                (rand-type  (type-of rand tenv)))
+            (cases type rator-type
+              (proc-type (arg-type result-type)
+                (begin
+                  (check-equal-type! arg-type rand-type rand)
+                  result-type))
+              (else
+                (eopl:error 'type-of
+                  "Rator not a proc type:~%~s~%had rator type ~s"   
+                  rator (type-to-external-form rator-type))))))
+        
+        (letrec-exp (proc-result-type proc-name 
+                      bvar bvar-type 
+                      proc-body
+                      letrec-body)
+          (let ((tenv-for-letrec-body
+                  (extend-tenv 
+                    proc-name
+                    (expand-type
+                      (proc-type bvar-type proc-result-type)
+                      tenv)
+                    tenv)))
+            (let ((proc-result-type
+                    (expand-type proc-result-type tenv))
+                  (proc-body-type
+                    (type-of proc-body
+                      (extend-tenv
+                        bvar
+                        (expand-type bvar-type tenv)
+                        tenv-for-letrec-body))))
+              (check-equal-type!
+                proc-body-type proc-result-type proc-body)
+              (type-of letrec-body tenv-for-letrec-body))))
+        
+        )))
+    
+  ;; type environments are now in static-data-structures.scm .
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/data-structures.scm b/collects/tests/eopl/chapter8/abstract-types-lang/data-structures.scm
new file mode 100755
index 0000000000..7c21fbf30a
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/data-structures.scm
@@ -0,0 +1,84 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+  ;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  ;;;;;;;;;;;;;;;; module values ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282, 319
+  (define-datatype typed-module typed-module?
+    (simple-module
+      (bindings environment?))
+    (proc-module
+      (bvar symbol?)
+      (body module-body?)
+      (saved-env environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-recursively
+      (id symbol?)
+      (bvar symbol?)
+      (body expression?)
+      (saved-env environment?))
+    (extend-env-with-module
+      (m-name symbol?)
+      (m-val typed-module?)
+      (saved-env environment?)   
+      ))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/drscheme-init.scm b/collects/tests/eopl/chapter8/abstract-types-lang/drscheme-init.scm
new file mode 100755
index 0000000000..41bf963c75
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/drscheme-init.scm
@@ -0,0 +1,130 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   apply-safely
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/environments.scm b/collects/tests/eopl/chapter8/abstract-types-lang/environments.scm
new file mode 100755
index 0000000000..3734e7eed5
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/environments.scm
@@ -0,0 +1,85 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")
+  (require "lang.scm")
+
+  (provide empty-env extend-env apply-env)
+  (provide lookup-module-name-in-env)
+  (provide lookup-qualified-var-in-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; initial-value-env : module-env -> environment
+
+  ;; (init-env m-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10, and in which m-env is the module
+  ;; environment.
+
+  (define inital-value-env 
+    (lambda (m-env)
+      (extend-env 
+        'i (num-val 1)
+        (extend-env
+          'v (num-val 5)
+          (extend-env
+            'x (num-val 10)
+            (empty-env m-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; for variables bound by extend-env or extend-env-recursively
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No value binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-recursively
+          (id bvar body saved-env)
+          (if (eqv? search-sym id)
+            (proc-val (procedure bvar body env))          
+            (apply-env saved-env search-sym)))
+        (extend-env-with-module
+            (m-name m-val saved-env)
+          (apply-env saved-env search-sym)) )))
+                
+  ;; for names bound by extend-env-with-module
+
+  ;; lookup-module-name-in-env : Sym * Env -> Typed-Module
+  (define lookup-module-name-in-env
+    (lambda (m-name env)            
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'lookup-module-name-in-env
+            "No module binding for ~s" m-name))
+        (extend-env (bvar bval saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-recursively  (id bvar body saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-with-module
+          (m-name1 m-val saved-env)
+	  (if (eqv? m-name1 m-name)
+            m-val
+	    (lookup-module-name-in-env m-name saved-env))))))
+
+  ;; lookup-qualified-var-in-env : Sym * Sym * Env -> ExpVal
+  ;; Page: 283
+  (define lookup-qualified-var-in-env
+    (lambda (m-name var-name env)
+      (let ((m-val (lookup-module-name-in-env m-name env)))
+        ; (pretty-print m-val)
+        (cases typed-module m-val
+          (simple-module (bindings)
+            (apply-env bindings var-name))
+          (proc-module (bvar body saved-env)
+            (eopl:error 'lookup-qualified-var
+              "can't retrieve variable from ~s take ~s from proc module"
+              m-name var-name))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/expand-type.scm b/collects/tests/eopl/chapter8/abstract-types-lang/expand-type.scm
new file mode 100755
index 0000000000..38201e0035
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/expand-type.scm
@@ -0,0 +1,93 @@
+(module expand-type (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  ; (require "renaming.scm")              ; for fresh-module-name
+
+  (provide expand-type)
+  (provide expand-iface)
+
+;;;;;;;;;;;;;;;; expand-type ;;;;;;;;;;;;;;;;
+
+  ;; expand-type expands a type so that it contains no type
+  ;; abbreviations. 
+
+  ;; For example, if tenv contains a declaration for a module
+
+  ;;   module m1
+  ;;    interface
+  ;;     [abstract-type t
+  ;;      type-abbrev u = int
+  ;;      type-abbrev v = (t -> u)]
+
+  ;; then calling expand-type on from m1 take v should return
+  ;; (from m1 take t -> int)  
+
+  ;; this relies on the invariant that every type returned by
+  ;; lookup-type-name-in-tenv is already expanded.
+
+
+  ;; expand-type : Type * Tenv -> ExpandedType
+  (define expand-type
+    (lambda (ty tenv)
+      (cases type ty
+        (int-type () (int-type))
+        (bool-type () (bool-type))
+        (proc-type (arg-type result-type)
+          (proc-type
+            (expand-type arg-type tenv)
+            (expand-type result-type tenv)))
+        (named-type (name)
+          (lookup-type-name-in-tenv tenv name))
+        (qualified-type (m-name t-name)
+          (lookup-qualified-type-in-tenv m-name t-name tenv))
+        )))
+
+
+  ;; creates new interface with all types expanded
+  ;; expand-iface : Sym * Iface * Tenv -> Iface
+  ;; Page: 307
+  (define expand-iface
+    (lambda (m-name iface tenv)
+      (cases interface iface
+        (simple-iface (decls) 
+          (simple-iface
+            (expand-decls m-name decls tenv))) )))
+
+
+  ;; like defns->decls, this creates only transparent type
+  ;; declarations. 
+
+  ;; expand-decls : Sym * Listof(Decl) * Tenv -> Listof(Decl)
+  ;; Page: 307
+  (define expand-decls
+    (lambda (m-name decls internal-tenv) 
+      (if (null? decls) '()
+        (cases declaration (car decls)
+          (opaque-type-decl (t-name)
+            ;; here the expanded type is m.t
+            (let ((expanded-type (qualified-type m-name t-name)))
+              (let ((new-env (extend-tenv-with-type
+                               t-name
+                               expanded-type
+                               internal-tenv)))
+                (cons 
+                  (transparent-type-decl t-name expanded-type)
+                  (expand-decls m-name (cdr decls) new-env)))))
+          (transparent-type-decl (t-name ty)
+            (let ((expanded-type (expand-type ty internal-tenv)))
+              (let ((new-env (extend-tenv-with-type 
+                               t-name
+                               expanded-type
+                               internal-tenv)))
+                (cons
+                  (transparent-type-decl t-name expanded-type)
+                  (expand-decls m-name (cdr decls) new-env)))))
+          (val-decl (var-name ty)
+            (let ((expanded-type
+                    (expand-type ty internal-tenv)))
+              (cons
+                (val-decl var-name expanded-type)
+                (expand-decls m-name (cdr decls) internal-tenv))))))))
+
+  )
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/interp.scm b/collects/tests/eopl/chapter8/abstract-types-lang/interp.scm
new file mode 100755
index 0000000000..f14532c5ef
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/interp.scm
@@ -0,0 +1,144 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> Expval
+  ;; Page: 284
+  (define value-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (let ((env 
+                  (add-module-defns-to-env module-defs (empty-env))))
+            ;; (eopl:pretty-print env)
+            (value-of body env))))))
+
+  ;; add-module-defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 284
+  (define add-module-defns-to-env
+    (lambda (defs env)
+      (if (null? defs)
+        env
+        (cases module-definition (car defs)
+          (a-module-definition (m-name iface m-body)
+            (add-module-defns-to-env
+              (cdr defs)
+              (extend-env-with-module
+                m-name 
+                (value-of-module-body m-body env)
+                env)))))))
+
+  ;; We will have let* scoping inside a module body.
+  ;; We put all the values in the environment, not just the ones
+  ;; that are in the interface.  But the typechecker will prevent
+  ;; anybody from using the extras.
+
+  ;; value-of-module-body : ModuleBody * Env -> TypedModule
+  ;; Page: 285, 320
+  (define value-of-module-body
+    (lambda (m-body env)    
+      (cases module-body m-body
+        (defns-module-body (defns)
+          (simple-module
+            (defns-to-env defns env))) )))
+
+
+  (define raise-cant-apply-non-proc-module!
+    (lambda (rator-val)
+      (eopl:error 'value-of-module-body 
+        "can't apply non-proc-module-value ~s" rator-val)))
+
+  ;; defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 285, 303
+  (define defns-to-env
+    (lambda (defns env)
+      (if (null? defns)
+        (empty-env)                ; we're making a little environment
+        (cases definition (car defns)
+          (val-defn (var exp)
+            (let ((val (value-of exp env)))
+              ;; new environment for subsequent definitions
+              (let ((new-env (extend-env var val env)))
+                (extend-env var val
+                  (defns-to-env
+                    (cdr defns) new-env)))))
+          ;; type definitions are ignored at run time
+          (else
+            (defns-to-env (cdr defns) env))
+          ))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (apply-env env var))
+
+        (qualified-var-exp (m-name var-name)
+          (lookup-qualified-var-in-env m-name var-name env))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (let ((new-env (extend-env var val env)))
+              ;; (eopl:pretty-print new-env)
+              (value-of body new-env))))
+
+        (proc-exp (bvar ty body)
+	  (proc-val
+	    (procedure bvar body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (ty1 proc-name bvar ty2 proc-body letrec-body)
+          (value-of letrec-body
+            (extend-env-recursively proc-name bvar proc-body env)))
+
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/lang.scm b/collects/tests/eopl/chapter8/abstract-types-lang/lang.scm
new file mode 100755
index 0000000000..efbf72cd8c
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/lang.scm
@@ -0,0 +1,274 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; grammar for modules with abstract types
+  ;; based on CHECKED.
+
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+
+  (define the-grammar
+
+    '(
+      
+      (program
+        ((arbno module-definition)
+         expression)
+        a-program)
+
+      (module-definition
+        ("module" identifier 
+          "interface" interface
+          "body" module-body)
+        a-module-definition)
+
+
+      (interface
+        ("[" (arbno declaration) "]") 
+        simple-iface)
+
+
+      (declaration
+        ("opaque" identifier)
+        opaque-type-decl)
+
+      (declaration
+        ("transparent" identifier "=" type)
+        transparent-type-decl)
+
+      (declaration    
+        (identifier ":" type)
+        val-decl)
+
+
+      (module-body
+        ("[" (arbno definition) "]")
+        defns-module-body)
+
+
+      (definition
+        (identifier "=" expression)
+        val-defn)
+
+      (definition
+        ("type" identifier "=" type)
+        type-defn)
+
+      ;; new expression:
+
+      (expression
+        ("from" identifier "take" identifier)
+        qualified-var-exp)
+
+      ;; new types
+
+      (type
+        (identifier)
+        named-type)                
+
+      (type
+        ("from" identifier "take" identifier)
+        qualified-type)
+
+ 
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;; no changes in grammar below here
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+      (expression (number) const-exp)
+
+      (expression
+        (identifier)
+        var-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "(" identifier ":" type ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression expression ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          type identifier "(" identifier ":" type ")"
+          "=" expression "in" expression)
+        letrec-exp)
+
+      (type
+        ("int")
+        int-type)
+      
+      (type
+        ("bool")
+        bool-type)
+      
+      (type
+        ("(" type "->" type ")")
+        proc-type)
+
+      ))
+  
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+
+  ;;;;;;;;;;;;;;;; syntactic tests and observers ;;;;;;;;;;;;;;;;
+
+  ;;;; for types
+
+  (define atomic-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (ty1 ty2) #f)
+        (else #t))))
+
+  (define proc-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (t1 t2) #t)
+        (else #f))))
+
+  (define proc-type->arg-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) arg-type)
+        (else (eopl:error 'proc-type->arg-type
+                "Not a proc type: ~s" ty)))))
+
+  (define proc-type->result-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) result-type)
+        (else (eopl:error 'proc-type->result-types
+                "Not a proc type: ~s" ty)))))
+
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (proc-type (arg-type result-type)
+          (list
+            (type-to-external-form arg-type)
+            '->
+            (type-to-external-form result-type)))
+       (named-type (name) name)
+        (qualified-type (modname varname)
+          (list 'from modname 'take varname))
+        )))
+  
+
+  ;;;; for module definitions
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Maybe(Defn)
+  (define maybe-lookup-module-in-list
+    (lambda (name module-defs)
+      (if (null? module-defs)
+        #f
+        (let ((name1 (module-definition->name (car module-defs))))
+          (if (eqv? name1 name)
+            (car module-defs)
+            (maybe-lookup-module-in-list name (cdr module-defs)))))))
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Defn OR Error
+  (define lookup-module-in-list
+    (lambda (name module-defs)
+      (cond
+        ((maybe-lookup-module-in-list name module-defs)
+         => (lambda (mdef) mdef))
+        (else 
+          (eopl:error 'lookup-module-in-list
+            "unknown module ~s"
+            name)))))
+
+  (define module-definition->name
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-name))))
+
+ (define module-definition->interface
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-type))))
+
+  (define module-definition->body
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-body))))
+
+ (define val-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (val-decl (name ty) #t)
+       (else #f))))
+
+ (define transparent-type-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (transparent-type-decl (name ty) #t)
+       (else #f))))
+
+ (define opaque-type-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (opaque-type-decl (name) #t)
+       (else #f))))
+
+ (define decl->name
+   (lambda (decl)
+     (cases declaration decl
+       (opaque-type-decl (name) name)
+       (transparent-type-decl (name ty) name)
+       (val-decl (name ty) name))))
+
+ (define decl->type
+   (lambda (decl)
+     (cases declaration decl
+       (transparent-type-decl (name ty) ty)
+       (val-decl (name ty) ty)
+       (opaque-type-decl (name)
+         (eopl:error 'decl->type
+           "can't take type of abstract type declaration ~s"
+           decl)))))
+     
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/renaming.scm b/collects/tests/eopl/chapter8/abstract-types-lang/renaming.scm
new file mode 100755
index 0000000000..336e10548c
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/renaming.scm
@@ -0,0 +1,71 @@
+(module renaming (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+
+  (provide rename-in-iface fresh-module-name)
+
+  (define rename-in-iface
+    (lambda (m-type old new)
+      (cases interface m-type
+        (simple-iface (decls)
+          (simple-iface
+            (rename-in-decls decls old new))) )))
+
+  ;; this isn't a map because we have let* scoping in a list of declarations
+  (define rename-in-decls
+    (lambda (decls old new)
+      (if (null? decls) '()
+        (let ((decl (car decls))
+              (decls (cdr decls)))
+          (cases declaration decl
+            (val-decl (name ty)
+              (cons
+                (val-decl name (rename-in-type ty old new))
+                (rename-in-decls decls old new)))
+            (opaque-type-decl (name)
+              (cons
+                (opaque-type-decl name)
+                (if (eqv? name old)
+                  decls
+                  (rename-in-decls decls old new))))
+            (transparent-type-decl (name ty)
+              (cons
+                (transparent-type-decl 
+                  name
+                  (rename-in-type ty old new))
+                (if (eqv? name old)
+                  decls
+                  (rename-in-decls decls old new))))
+            )))))
+
+  (define rename-in-type
+    (lambda (ty old new)
+      (let recur ((ty ty))
+        (cases type ty 
+          (named-type (id)
+            (named-type (rename-name id old new)))
+          (qualified-type (m-name name)
+            (qualified-type
+              (rename-name m-name old new)
+              name))
+          (proc-type (t1 t2)
+            (proc-type (recur t1) (recur t2)))
+          (else ty)              ; this covers int, bool, and unknown.
+          ))))
+
+  (define rename-name
+    (lambda (name old new)
+      (if (eqv? name old) new name)))
+
+  (define fresh-module-name
+    (let ((sn 0))
+      (lambda (module-name)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string module-name)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  )
+
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/static-data-structures.scm b/collects/tests/eopl/chapter8/abstract-types-lang/static-data-structures.scm
new file mode 100755
index 0000000000..261256b40f
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/static-data-structures.scm
@@ -0,0 +1,154 @@
+(module static-data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?, type?, etc.
+
+  (provide (all-defined))               ; too many things to list
+
+  (define-datatype type-environment type-environment?
+    (empty-tenv)
+    (extend-tenv 
+      (bvar symbol?)
+      (bval type?)
+      (saved-tenv type-environment?))
+    (extend-tenv-with-module
+      (name symbol?)
+      (interface interface?)
+      (saved-tenv type-environment?))
+    (extend-tenv-with-type
+      (t-name symbol?)
+      (t-type type?)                    ; invariant: this must always
+                                        ; be expanded
+      (saved-tenv type-environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; procedures for looking things up tenvs ;;;;;;;;;;;;;;;;
+
+  ;;;;;;;;;;;;;;;; lookup or die
+
+  ;; lookup-qualified-var-in-tenv : Sym * Sym * Tenv -> Type
+  ;; Page: 285
+  (define lookup-qualified-var-in-tenv
+    (lambda (m-name var-name tenv)
+      (let ((iface (lookup-module-name-in-tenv tenv m-name)))
+        (cases interface iface
+          (simple-iface (decls)
+            (lookup-variable-name-in-decls var-name decls)) ))))
+
+  (define lookup-variable-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (variable-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'variable search-sym tenv)))))
+
+  (define lookup-module-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (module-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'module search-sym tenv)))))
+
+  (define lookup-type-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (type-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'type search-sym tenv)))))
+
+  (define lookup-qualified-type-in-tenv
+    (lambda (m-name t-name tenv)
+      (let ((iface (lookup-module-name-in-tenv tenv m-name)))
+        (cases interface iface
+          (simple-iface (decls)
+            ;; this is not right, because it doesn't distinguish
+            ;; between type and variable declarations.  Exercise: fix
+            ;; this so that it raises an error if t-name is declared
+            ;; in a val-decl.
+            (lookup-variable-name-in-decls t-name decls))
+          ))))
+
+  (define apply-tenv lookup-variable-name-in-tenv)
+
+  (define raise-tenv-lookup-failure-error
+    (lambda (kind var tenv)
+      (eopl:pretty-print
+        (list 'tenv-lookup-failure: (list 'missing: kind var) 'in:
+          tenv))
+      (eopl:error 'lookup-variable-name-in-tenv)))
+
+
+  ;; this is not right, because it doesn't distinguish
+  ;; between type and variable declarations.  But it will do
+  ;; for now.  Exercise: refine this do that it raises an error if
+  ;; var-name is declared as something other than a val-decl.
+
+  (define lookup-variable-name-in-decls
+    (lambda (var-name decls0)
+      (let loop ((decls decls0))
+        (cond
+          ((null? decls)
+           (raise-lookup-variable-in-decls-error! var-name decls0))
+          ((eqv? var-name (decl->name (car decls)))
+           (decl->type (car decls)))
+          (else (loop (cdr decls)))))))
+
+  (define raise-lookup-variable-in-decls-error!
+    (lambda (var-name decls)
+      (eopl:pretty-print
+        (list 'lookup-variable-decls-failure:
+          (list 'missing-variable var-name)
+          'in:
+          decls))))
+
+  ;;;;;;;;;;;;;;;; lookup or return #f.
+
+  ;; variable-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Type)
+  (define variable-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv (name ty saved-tenv)
+            (if (eqv? name search-sym) 
+              ty
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; module-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Iface)
+  (define module-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv-with-module (name m-type saved-tenv)
+            (if (eqv? name search-sym) 
+              m-type
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; type-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Iface)
+  (define type-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv-with-type (name type saved-tenv)
+            (if (eqv? name search-sym) 
+              type
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; assumes tenv is non-empty.  
+  (define tenv->saved-tenv
+    (lambda (tenv)
+      (cases type-environment tenv
+        (empty-tenv () 
+          (eopl:error 'tenv->saved-tenv
+            "tenv->saved-tenv called on empty tenv"))
+        (extend-tenv (name ty saved-tenv) saved-tenv)
+        (extend-tenv-with-module (name m-type saved-tenv) saved-tenv)
+        (extend-tenv-with-type (name ty saved-tenv) saved-tenv)
+        )))
+
+  )
+                    
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/subtyping.scm b/collects/tests/eopl/chapter8/abstract-types-lang/subtyping.scm
new file mode 100755
index 0000000000..a45f490030
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/subtyping.scm
@@ -0,0 +1,101 @@
+(module subtyping (lib "eopl.ss" "eopl")
+  
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+  (require "renaming.scm")
+
+  (provide <:-iface)
+
+  ;; <:-iface : Iface * Iface * Tenv -> Bool
+  ;; Page: 289
+  (define <:-iface
+    (lambda (iface1 iface2 tenv)
+      (cases interface iface1
+        (simple-iface (decls1)
+          (cases interface iface2
+            (simple-iface (decls2)
+              (<:-decls decls1 decls2 tenv)))))))
+
+  ;; s1 <: s2 iff s1 has at least as much stuff as s2, and in the same
+  ;; order.  We walk down s1 until we find a declaration that declares
+  ;; the same name as the first component of s2.  If we run off the
+  ;; end of s1, then we fail.  As we walk down s1, we record any type
+  ;; bindings in the tenv
+
+  ;; <:-decls : Listof(Decl) * Listof(Decl) * Tenv -> Bool
+  ;; Page: 289, 305
+  (define <:-decls
+    (lambda (decls1 decls2 tenv)
+      (cond
+        ;; if nothing in decls2, any decls1 will do
+        ((null? decls2) #t)
+        ;; nothing in decls1 to match, so false
+        ((null? decls1) #f)
+        (else
+          ;; at this point we know both decls1 and decls2 are non-empty.
+          (let ((name1 (decl->name (car decls1)))
+                (name2 (decl->name (car decls2))))
+            (if (eqv? name1 name2)
+              ;; same name.  They'd better match
+              (and
+                (<:-decl (car decls1) (car decls2) tenv)
+                (<:-decls (cdr decls1) (cdr decls2)
+                  (extend-tenv-with-decl (car decls1) tenv)))
+              ;; different names.  OK to skip, but record decl1 in the tenv. 
+              (<:-decls (cdr decls1) decls2
+                (extend-tenv-with-decl (car decls1) tenv))))))))
+
+  ;; extend-tenv-with-decl : Decl * Tenv -> Tenv
+  ;; Page: 309
+  (define extend-tenv-with-decl
+    (lambda (decl tenv)
+      (cases declaration decl
+        ;; don't need to record val declarations
+        (val-decl (name ty) tenv)
+        (transparent-type-decl (name ty)
+          (extend-tenv-with-type
+            name
+            (expand-type ty tenv)
+            tenv))
+        (opaque-type-decl (name)
+          (extend-tenv-with-type
+            name
+            ;; the module name doesn't matter, since the only
+            ;; operation on qualified types is equal?
+            (qualified-type (fresh-module-name '%abstype) name)
+            tenv)))))
+
+  ;; decl1 and decl2 are known to declare the same name.  There are
+  ;; exactly four combinations that can succeed.
+
+  ;; <:-decl : Decl * Decl * Tenv -> Bool
+  ;; Page: 311
+  (define <:-decl 
+    (lambda (decl1 decl2 tenv)
+      (or
+        (and
+          (val-decl? decl1)
+          (val-decl? decl2)
+          (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
+        (and
+          (transparent-type-decl? decl1)
+          (transparent-type-decl? decl2)
+          (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
+        (and 
+          (transparent-type-decl? decl1)
+          (opaque-type-decl? decl2))
+        (and
+          (opaque-type-decl? decl1)
+          (opaque-type-decl? decl2))
+        )))
+
+  ;; equiv-type? : Type * Type * Tenv -> Bool
+  ;; Page: 311
+  (define equiv-type?
+    (lambda (ty1 ty2 tenv)
+      (equal?
+        (expand-type ty1 tenv)
+        (expand-type ty2 tenv))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/test-suite.scm b/collects/tests/eopl/chapter8/abstract-types-lang/test-suite.scm
new file mode 100755
index 0000000000..2fbc2948b4
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/test-suite.scm
@@ -0,0 +1,981 @@
+(module test-suite mzscheme
+
+  (provide tests-for-run tests-for-check tests-for-parse)
+
+  (define the-test-suite
+    '(
+      ;; tests from run-tests:
+  
+;;       ;; simple arithmetic
+;;       (positive-const "11" int 11)
+;;       (negative-const "-33" int -33)
+;;       (simple-arith-1 "-(44,33)" int 11)
+  
+;;       ;; nested arithmetic
+;;       (nested-arith-left "-(-(44,33),22)" int -11)
+;;       (nested-arith-right "-(55, -(22,11))" int 44)
+  
+;;       ;; simple variables
+;;       (test-var-1 "x" error)
+;;       (test-var-2 "-(x,1)" error)
+;;       (test-var-3 "-(1,x)" error)
+
+;;       (zero-test-1 "zero?(-(3,2))" bool #f)
+;;       (zero-test-2 "-(2,zero?(0))" error)
+      
+;;       ;; simple unbound variables
+;;       (test-unbound-var-1 "foo" error)
+;;       (test-unbound-var-2 "-(x,foo)" error)
+  
+;;       ;; simple conditionals
+;;       (if-true "if zero?(0) then 3 else 4" int 3)
+;;       (if-false "if zero?(1) then 3 else 4" int 4)
+
+;;       ;; make sure that the test and both arms get evaluated
+;;       ;; properly. 
+;;       (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" int 3)
+;;       (if-eval-test-false "if zero?(-(11,12)) then 3 else 4" int 4)
+;;       (if-eval-then "if zero?(0) then -(22,1) else -(22,2)" int 21)
+;;       (if-eval-else "if zero?(1) then -(22,1) else -(22,2)" int 20)
+      
+;;       ;; make sure types of arms agree (new for lang5-1)
+      
+;;       (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+;;       (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+;;       ;; simple let
+;;       (simple-let-1 "let x = 3 in x" int 3)
+
+;;       ;; make sure the body and rhs get evaluated
+;;       (eval-let-body "let x = 3 in -(x,1)" int 2)
+;;       (eval-let-rhs "let x = -(4,1) in -(x,1)" int 2)
+
+;;       ;; check nested let and shadowing
+;;       (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int -1)
+;;       (check-shadowing-in-body "let x = 3 in let x = 4 in x" int 4)
+;;       (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int 29)
+      (checker-doesnt-ignore-type-info-in-proc-but-interp-does 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error 29) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int 29)
+      (let-to-proc-1
+        "(proc( f : (int -> int))(f 30)  proc(x : int)-(x,1))" int 29)
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int -1)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int 2)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int 32)
+      (simple-letrec-2
+        "letrec int double(x : int) = if zero?(x) then 0 else -((double -(x,1)), -2) in (double 4)"
+        int 8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        int 20)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int 6)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int 3) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc ( f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool)))
+        )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int 1)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int 3)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int 39)
+
+      (letrec-non-shadowing
+        "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int 1)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-the-fcn "
+let f = proc (x : int) proc (y : int) -(x,y)   
+in letrec 
+     int loop(x : int) = if zero?(x) then 1 else ((f x) (loop -(x,1)))
+   in (loop 4)"
+        int 3)
+
+       (modules-declare-and-ignore "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+33"
+        int 33)
+
+       (modules-take-one-value "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+from m take u"
+        int 3)
+
+       (modules-take-one-value-no-import
+        "module m 
+          interface 
+           [u : int] 
+          body 
+           [u = 3]
+         from m take u"
+        int 3)
+
+       (modules-take-from-parameterized-module "
+module m
+ interface 
+  ((m1 : []) => [u : int])
+ body 
+  module-proc (m1 : []) [u = 3]
+
+from m take u
+"
+        error error)
+
+       (modules-check-iface-subtyping-1 "
+module m 
+ interface 
+  [u : int]
+ body 
+  [u = 3 v = 4]
+from m take u"
+        int 3)
+
+
+       ;; if the interpreter always called the typechecker, or put
+       ;; only declared variables in the module, this would raise an
+       ;; error.  Exercise: make this modification.
+
+       (modules-take-one-value-but-interface-bad "
+         module m interface []  body [u = 3]
+         from m take u"
+; this version for permissive interp
+        error 3
+; this version for strict interp
+;         error error
+        )
+
+       (modules-take-bad-value
+        "module m interface []  body [u = 3]
+         from m take x"
+        error error)       
+
+        (modules-two-vals "
+module m
+ interface 
+  [u : int 
+   v : int] 
+ body
+  [u = 44
+   v = 33]
+
+  -(from m take u, from m take v)"
+        int 11)
+
+
+        (modules-two-vals-bad-interface-1
+        "module m interface [u : int v : bool]  
+                  body [u = 44 v = 33]
+         -(from m take u, from m take v)"
+        error 11)
+
+        (modules-extra-vals-are-ok-1 "
+          module m interface [x : int] body [x = 3 y = 4]
+          from m take x"
+          int 3)
+
+        (module-extra-vals-are-ok-2 "
+          module m interface [y : int] body [x = 3 y = 4]
+          from m take y"
+          int)
+          
+        (module-extra-types-are-ok-11 
+          "module m interface [y : int] body [x = 3 type t = int y = 4]
+         from m take y"
+          int 4)
+
+        (module-extra-types-are-ok-12
+          "module m interface [opaque t y : int] 
+                    body [type u = bool x = 3 type t = int y = 4]
+          from m take y"
+          int)
+
+        (module-extra-types-are-ok-13
+          "module m interface [transparent t = int y : int] 
+                    body [type u = bool x = 3 type t = int y = 4]
+          from m take y"
+          int 4)
+
+
+       (modules-two-vals-bad-interface-14
+        "module m interface 
+            [v : int 
+             u : bool]
+          body 
+           [v = zero?(0) u = 33]
+         -(from m take u, from m take v)"
+        error)
+
+
+        (modules-check-let*-1
+        "module m interface      [u : int v : int]
+                  body [u = 44  v = -(u,11)]
+         -(from m take u, from m take v)"
+        int 11)
+
+      (modules-check-let*-2.0
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+      (modules-check-let*-2.05
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] body [v = -(from m1 take u,11)]
+         33"
+        int 33)                       ; doesn't actually import anything
+
+      (modules-check-let*-2.1
+        "module m1 interface [u : int] body [u = 44]
+         module m2   
+          interface [v : int] 
+          body [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+     (modules-check-let*-2.2
+        "module m2
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         module m1 interface [u : int] body [u = 44]
+         -(from m1 take u, from m2 take v)"
+        error)
+
+     ;; modules declaring types
+
+      (modules-export-abs-type-1
+        "module m1 interface [opaque t] body [type t = int]
+         33"
+        int 33)
+
+      (modules-take-from-ints-0.1
+        "module m1
+          interface [opaque t  
+             zero : t] 
+          body [type t = int
+             zero = 0]
+         33"
+        int 33)
+
+      (modules-take-from-ints-0.1a
+        "module m1
+          interface [opaque t  
+             zero : t] 
+          body [type t = int
+             zero = 0]
+         from m1 take zero"
+        (from m1 take t) 0)
+
+       (modules-take-from-ints-0.1.91
+        "module m1
+            interface [opaque t
+               zero : t]
+            body [type t = int
+               zero = 0
+               foo = 3]
+         let check = proc (x : from m1 take t) zero?(0)
+         in (check  from m1 take zero)"
+        bool #t)
+
+       (modules-take-from-ints-0.1.91a
+        "module m1
+            interface [opaque t
+               zero : t]
+            body [type t = int
+               zero = 0
+               foo = 3]
+         let check = proc (x : from m1 take t  ) zero?(0)
+         in check"
+        ((from m1 take t) -> bool))
+
+       (modules-take-from-ints-0.2
+        "module m1
+          interface [opaque t
+             zero : t
+             check : (t -> bool)] 
+          body [type t = int
+             zero = 0
+             check = proc(x : t) zero?(x)]
+         (from m1 take check  from m1 take zero)"
+        bool #t)
+
+       (modules-mybool-1
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+          (from mybool take to-bool  
+           from mybool take false)
+          "
+         bool #f)
+
+       (modules-mybool-1a
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+          from mybool take to-bool"
+        ((from mybool take t) -> bool))
+
+       (modules-mybool-1b
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+           from mybool take false
+          "
+         (from mybool take t) )
+
+      (modules-take-from-ints-1
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in (check (s (s (p (s z)))))"
+        bool #t)
+
+      (modules-take-from-ints-1a
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in s"
+        ((from ints-1 take t) -> (from ints-1 take t)))
+
+
+      (modules-take-from-ints-1b
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in check"
+        ((from ints-1 take t) -> bool))
+
+
+   (modules-take-from-ints-2
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)] 
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        int 33)
+
+   
+   (modules-take-from-ints-2-bad-1
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)] 
+          body [zero = proc (x : t) x
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)
+             ]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        error)
+
+   (modules-take-from-ints-3
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> int)] 
+          body [zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        error)
+
+   (modules-check-polymorphism-1 "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) x]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+
+   (modules-check-polymorphism-1a "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) x]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+    (modules-check-polymorphism-1b "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) -(x,1)]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+    (modules-check-shadowing-1 "
+      module ints-1
+       interface 
+        [opaque t
+          zero : t
+          succ : (t -> t)
+          is-zero : (t -> bool)] 
+       body 
+        [type t = int
+         zero = 0
+         succ = proc(x : t) -(x,-1)
+         pred = proc(x : t) -(x,1)
+         is-zero = proc (x : t) zero?(x)]
+      module ints-2 
+       interface 
+        [zero : from ints-1 take t
+         succ : (from ints-1 take t -> from ints-1 take t)
+         is-zero : (from ints-1 take t -> bool)]
+       body
+        [zero = from ints-1 take zero
+         succ = from ints-1 take succ
+         is-zero = from ints-1 take is-zero]
+      let s = from ints-2 take succ
+      in let z? = from ints-2 take is-zero
+      in let z = from ints-2 take zero
+      in (z? (s z))"
+     bool #f)
+
+
+  (modules-check-shadowing-1.8 "
+      module ints-1 
+       interface 
+        [opaque t  
+         zero : t] 
+       body 
+        [type t = int 
+         zero = 0]
+      module ints-2 
+       interface     
+        [foo : from ints-1 take t]
+       body 
+        [foo = from ints-1 take zero]
+      let v = from ints-2 take foo
+      in 33
+     " int 33)
+
+   (modules-check-shadowing-1.8a
+     "module ints-1 
+       interface [opaque t  zero : t] 
+       body [type t = int zero = 0]
+      module ints-2 
+       interface [ foo : from ints-1 take t]
+       body 
+        [foo = from ints-1 take zero]
+      from ints-2 take foo
+     " 
+     (from ints-1 take t))
+
+   ;; this test is bogus, because duplicate module names are not
+   ;; allowed.  
+
+;;    (modules-check-shadowing-1.9.1 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in 33
+;;      " int)
+
+   ;; Once exercise 8.1 (reject duplicated module names) is done, the
+   ;; test should be:
+
+;;    (modules-check-shadowing-1.9.2 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in 33
+;;      " error)    ; <<<---- changed outcome.
+
+
+   ;; This is bogus in yet another way.  In the following example, v
+   ;; has the type of from ints-1 take foo, which is from ints-1 take
+   ;; t.  But at the point where v is used, ints-1 has been rebound,
+   ;; and doesn't even have a type component t.
+
+;;    (modules-check-shadowing-1.9.2 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in v
+;;      " (from ints-1 take t))
+
+
+   ;; We can take advantage of this confusion to generate an unsound
+   ;; program that type-checks:
+
+;;    (modules-check-shadowing-1.9.3 "
+;; module ints-1 
+;;  interface [opaque t zero : t]
+;;  body [type t = int zero = 0]
+;; module ints-1
+;;  interface [zero : from ints-1 take t
+;;             opaque t
+;;             f : (t -> int)]
+;;  body [zero = from ints-1 take zero
+;;        type t = bool
+;;        f = proc (b : t) if b then 33 else 44]
+;;  (from ints-1 take f
+;;   from ints-1 take zero)"
+;;      int)
+
+   ;; this code allows the application of ints-1.f because its type is
+   ;; (ints-1.t -> int), and zero has type ints-1.t .  But those are
+   ;; two different modules both named ints-1.
+
+   ;; In general, the solution is to rename the inner ints-1 to avoid
+   ;; the conflict.  Exercise: do this. When you do this,
+   ;; modules-check-shadowing-1.9.3 should give back "error".
+     
+   ;; Aren't you sorry you asked?
+
+   (transparent-0
+     "module m1 interface [transparent t = int
+                   zero : t]
+                body [type t = int
+                   zero = 0]
+      -(from m1 take zero,1)"
+     int)
+
+   (transparent-1 
+     "module m1 
+       interface [opaque t zero : t]
+       body [type t = int zero = 0]
+      module m2 
+       interface [transparent t = from m1 take t   % don't know
+                                           % what's in m1!
+          one : t]
+       body [type t = int
+          one = 1]
+     -(from m2 take one, from m1 take zero)
+     "
+     error)
+
+  (transparent-2
+    "module m1 
+      interface 
+       [transparent t = int
+        zero : t]
+      body 
+       [type t = int
+        zero = 0]
+
+     module m2 
+      interface 
+       [transparent t = from m1 take t   % now known to be int.
+        one : t]
+      body 
+        [type t = int
+         one = 1]
+      -(from m2 take one, from m1 take zero)
+     "
+     int 1)
+
+   (modules-myints-0.1 "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,-2)
+            pred = proc(x : t) -(x,2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     (from ints-1 take t)
+     4)
+
+   (modules-myints-0.20 "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     error
+     -4)
+
+
+   (modules-myints-0.2a "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     (from ints-1 take t) -4)
+
+    (lift-type-from-scope-0.01 "
+       module m1 
+        interface 
+         [transparent u = int
+          transparent t = int]
+        body 
+         [type u = int
+          type t = u]
+      module m2 
+       interface 
+        [transparent u = int
+         x : from m1 take t]
+       body
+        [type u = int
+         x = 3]
+
+       33"
+      int
+      33)
+
+    (lift-type-from-scope-0.1 "
+       module m1 
+        interface 
+         [transparent u = int
+          transparent t = u]
+        body 
+         [type u = int
+          type t = u]
+       module m2 
+        interface 
+         [transparent u = int
+          x : from m1 take t]
+        body
+         [type u = int
+          x = 3]
+
+       33"
+      int
+      33)
+
+    (lift-type-from-scope-1 "
+       module m1 
+        interface 
+         [opaque u
+          transparent t = u]
+        body 
+         [type u = bool
+          type t = u]
+       module m2 
+        interface 
+         [transparent u = int
+          x : from m1 take t]
+        body
+         [type u = int
+          x = 3]
+
+       33"
+      error                             
+      33)
+
+    (lift-type-from-scope-2 "
+       module m1 
+        interface 
+         [opaque t1
+          f : (t1 -> t1)]
+        body 
+         [type t1 = bool
+          f = proc (x : t1) x]
+
+       from m1 take f"
+      ((from m1 take t1) -> (from m1 take t1))
+      )                                 
+
+    (lift-type-from-scope-3 "
+       module m1 
+        interface 
+         [opaque t2
+          f : (t1 -> t1)]
+        body 
+         [type t1 = bool
+          f = proc (x : t1) x]
+
+       from m1 take f"
+      error                             ; this should be rejected because t1
+                                        ; is unbound.
+      )
+
+      (modules-14.1 "
+      module m1 interface 
+                 [transparent t = int
+                  z : t]
+                body
+                  [type t = int
+                   z = 0]
+
+      module m2 
+       interface
+        [foo : (from m1 take t -> int)]
+       body
+        [foo = proc (x : from m1 take t) x]
+
+      (from m2 take foo  33)"
+      int)
+
+      (modules-14 "
+      module m1 
+       interface
+        [transparent t = int
+         z : t]
+       body
+        [type t = int
+         z = 0]
+      module m2 
+       interface
+        [foo : (from m1 take t -> int)]
+       body
+        [foo = proc (x : from m1 take t) x]
+
+      from m2 take foo"
+        (int -> int))
+
+
+      (modules-14b "
+module m1 interface [transparent t1 = int] body [type t1 = int]
+module m2 interface [foo : from m1 take t1] body [foo = 3]
+from m2 take foo"
+        int)
+
+
+    ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  (define tests-for-parse
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        (else
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             #t)
+           (loop (cdr lst)))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+
+  )
+
+  
+  
+    
+
+  
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/tests-book.scm b/collects/tests/eopl/chapter8/abstract-types-lang/tests-book.scm
new file mode 100755
index 0000000000..d1c3735804
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/tests-book.scm
@@ -0,0 +1,366 @@
+(module tests-book mzscheme
+  
+  (provide tests-for-run tests-for-check tests-for-parse)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+
+  (define the-test-suite
+ 
+    '(
+
+      (modules-dans-simplest "
+         module m1
+          interface 
+           [a : int
+            b : int]
+          body
+           [a = 33
+            c = -(a,1)
+            b = -(c,a)]
+
+         let a = 10
+         in -(-(from m1 take a, from m1 take b), 
+              a)"
+        int 24)
+
+
+      (example-8.2 "
+         module m1 
+          interface 
+           [u : bool]
+          body 
+           [u = 33]
+
+         44"
+        error 44)
+
+      (example-8.3 "
+         module m1 
+          interface 
+           [u : int 
+            v : int]
+          body 
+           [u = 33]
+
+         44"
+        error)
+
+      (example-8.4 "
+         module m1 
+          interface 
+           [u : int 
+            v : int] 
+          body 
+           [v = 33 
+            u = 44]
+
+         from m1 take u" 
+        error)
+
+      (example-8.5a "
+         module m1 
+          interface 
+           [u : int] 
+          body 
+           [u = 44]
+
+         module m2 
+          interface
+           [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         -(from m1 take u, from m2 take v)"
+        int)
+
+      (example-8.5b "
+         module m2 
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         module m1 
+          interface [u : int] 
+          body [u = 44]
+
+         -(from m1 take u, from m2 take v)"
+        error)
+
+      (example-8.10"
+       module m1 
+       interface 
+        [transparent t = int 
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 -(0, (from m1 take s 
+                       z))
+      in
+      (foo 
+       from m1 take z)"
+        int -1)
+
+      (example-8.14 "
+         module m1 
+       interface [transparent t = int
+                  z : t]
+       body [type t = int
+                       z = 0]
+      module m2 
+       interface 
+        [foo : (from m1 take t -> int)]
+       body 
+        [foo = proc (x : from m1 take t) x]
+
+      from m2 take foo"
+        (int -> int))
+
+      (example-8.15 "
+         module m1 
+       interface 
+        [opaque t
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 (from m1 take s 
+                  (from m1 take s
+                   z))
+      -(0, (foo 
+            from m1 take z))"
+        error)
+
+      (example-8.15a "
+      module m1 
+       interface 
+        [opaque t
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 (from m1 take s
+                  z)
+      in (foo 
+       from m1 take z)"
+        (from m1 take t))
+
+      (example-8.8 "
+         module colors
+         interface
+          [opaque color
+           red : color
+           green : color
+           is-red? : (color -> bool)
+           switch-colors : (color -> color)]
+         body
+          [type color = int
+           red = 0
+           green = 1
+           is-red? = proc (c : color) zero?(c)
+           switch-colors = proc (c : color) 
+                            if (is-red? c) then green else red]
+
+         44"
+        int)
+
+      (example-8.9 "
+         module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in (succ (succ zero))"
+        (from ints-1 take t) 10)
+
+      (example-8.10 "
+         module ints-2
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,3)
+                         pred = proc(x : t) -(x,-3)
+                         is-zero = proc (x : t) zero?(x)]
+
+         let z = from ints-2 take zero
+         in let s = from ints-2 take succ
+         in (s (s z))"
+        (from ints-2 take t) -6)
+
+      (example-8.11 "
+         module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+        let z = from ints-1 take zero
+        in let s = from ints-1 take succ
+        in let p = from ints-1 take pred
+        in let z? = from ints-1 take is-zero
+        in letrec int to-int (x : from ints-1 take t) =
+                      if (z? x) then 0
+                         else -((to-int (p x)), -1)
+        in (to-int (s (s z)))"
+        int 2)
+
+      (example-8.12 "
+         module ints-2
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,3)
+                         pred = proc(x : t) -(x,-3)
+                         is-zero = proc (x : t) zero?(x)
+                         ]
+
+         let z = from ints-2 take zero
+         in let s = from ints-2 take succ
+         in let p = from ints-2 take pred
+         in let z? = from ints-2 take is-zero
+         in letrec int to-int (x : from ints-2 take t) =
+                       if (z? x) then 0
+                          else -((to-int (p x)), -1)
+         in (to-int (s (s z)))"
+        int 2)
+
+      (example-8.13 "
+         module mybool 
+          interface [opaque t
+                     true : t
+                     false : t
+                     and : (t -> (t -> t))
+                     not : (t -> t)
+                     to-bool : (t -> bool)]
+          body [type t = int
+                          true = 0
+                          false = 13
+                          and = proc (x : t) 
+                                 proc (y : t)
+                                  if zero?(x) 
+                                   then y 
+                                   else false
+                          not = proc (x : t) 
+                                 if zero?(x) 
+                                  then false 
+                                  else true
+                          to-bool = proc (x : t) zero?(x)] 
+
+         let true = from mybool take true
+         in let false = from mybool take false
+         in let and = from mybool take and
+         in ((and true) false)"
+        (from mybool take t) 13)
+
+;;       (exercise-8.15 "
+;;          module tables
+;;          interface [opaque table
+;;                     empty : table
+;;                     add-to-table : (int -> (int -> (table -> table)))
+;;                     lookup-in-table : (int -> (table -> int))]
+;;          body
+;;           [type table = (int -> int)
+;;            ...  % to be filled in for exercise 8.15
+;;            ]
+
+;;           let empty = from tables take empty
+;;           in let add-binding = from tables take add-to-table
+;;           in let lookup = from tables take lookup-in-table
+;;           in let table1 = (((add-binding 3) 301)
+;;                            (((add-binding 4) 400)
+;;                             (((add-binding 3) 301)
+;;                               empty)))
+;;           in -( ((lookup 4) table1),
+;;                 ((lookup 3) table1))"
+;;         int 99)
+
+      (exercise-8.14 "
+         module mybool 
+         interface [opaque t
+                    true : t
+                    false : t
+                    and : (t -> (t -> t))
+                    not : (t -> t)
+                    to-bool : (t -> bool)]
+         body [type t = int
+                         true = 1
+                         false = 0
+                         and = proc (x : t) 
+                                proc (y : t)
+                                 if zero?(x) 
+                                  then false 
+                                  else y
+                         not = proc (x : t) 
+                                if zero?(x) 
+                                 then true 
+                                 else false
+                         to-bool = proc (x : t) 
+                                    if zero?(x) 
+                                     then zero?(1) 
+                                     else zero?(0)]
+          44"
+        int 44)
+
+ 
+      ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+  (define tests-for-parse the-test-suite)
+
+  )
+
diff --git a/collects/tests/eopl/chapter8/abstract-types-lang/top.scm b/collects/tests/eopl/chapter8/abstract-types-lang/top.scm
new file mode 100755
index 0000000000..4c0dace105
--- /dev/null
+++ b/collects/tests/eopl/chapter8/abstract-types-lang/top.scm
@@ -0,0 +1,129 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Parse all the tests with (parse-all)
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "check-modules.scm")         ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+
+  ;; choose one of the following test suites
+
+  (require "test-suite.scm")        ; ordinary test suite        
+  ;; (require "tests-book.scm")     ; examples from book/lecture notes     
+
+  (provide run run-all check check-all parse-all)
+
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : string -> external-type
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal? tests-for-check)))
+
+  ;; check-one : symbol -> expval
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+ 
+  ;; (check-all)
+
+  ;;;;;;;;;;;;;;;; parsing ;;;;;;;;;;;;;;;;
+  
+  ;; writing syntactically correct programs in this language can take
+  ;; some effort, so we've added a test that just parses the items in
+  ;; the test list.  This requires a slightly different structure.
+
+  ;; test-item ::= (test-name program correct-ans)
+  ;; test-list is a list of test-items.
+
+  (define parse-all
+    (lambda ()
+      (for-each
+        (lambda (test-item)
+          (let ((test-name (list-ref test-item 0))
+                (pgm       (list-ref test-item 1)))
+            (eopl:printf "~s... " test-name)               
+            (let ((outcome
+                    (apply-safely scan&parse (list pgm))))
+              (if (car outcome)
+                (eopl:printf "passed ~%")
+                (begin
+                  (eopl:printf "failed ~%")
+                  (if (stop-after-first-error)
+                    (eopl:error test-name
+                      "incorrect outcome detected"))))))) 
+        tests-for-parse)))
+
+  ;; (parse-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter8/full-system/check-modules.scm b/collects/tests/eopl/chapter8/full-system/check-modules.scm
new file mode 100755
index 0000000000..93b2528aa0
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/check-modules.scm
@@ -0,0 +1,127 @@
+(module check-modules (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+  (require "checker.scm")
+  (require "renaming.scm")
+  (require "subtyping.scm")
+
+  (provide type-of-program)
+ 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 
+  ;; type-of-program : Program -> Type
+  ;; Page: 286
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (type-of body
+            (add-module-defns-to-tenv module-defs (empty-tenv)))))))
+
+  ;; add-module-defns-to-tenv : Listof(ModuleDefn) * Tenv -> Tenv
+  ;; Page: 286, 305
+  (define add-module-defns-to-tenv
+    (lambda (defns tenv)
+      (if (null? defns)
+        tenv
+        (cases module-definition (car defns)
+          (a-module-definition (m-name expected-iface m-body)
+            (let ((actual-iface (interface-of m-body tenv)))
+              (if (<:-iface actual-iface expected-iface tenv)
+                ;; ok, continue in extended tenv
+                (let ((new-env (extend-tenv-with-module
+                                 m-name
+                                 (expand-iface m-name expected-iface tenv)
+                                 tenv)))
+                  (add-module-defns-to-tenv (cdr defns) new-env))
+                ;; no, raise error
+                (report-module-doesnt-satisfy-iface m-name
+                  expected-iface actual-iface))))))))
+
+  ;; interface-of : ModuleBody * Tenv -> Iface
+  ;; Page: 322
+  (define interface-of
+    (lambda (m-body tenv)
+      (cases module-body m-body
+        (var-module-body (m-name)
+          (lookup-module-name-in-tenv tenv m-name))
+        (defns-module-body (defns)
+          (simple-iface
+            (defns-to-decls defns tenv)))
+        (app-module-body (rator-id rand-id)
+          (let ((rator-iface (lookup-module-name-in-tenv tenv rator-id))
+                (rand-iface  (lookup-module-name-in-tenv tenv rand-id)))
+            (cases interface rator-iface
+              (simple-iface (decls)
+                (eopl:error 'interface-of
+                  "attempt to apply non-parameterized module ~s"
+                  rator-id))
+              (proc-iface (param-name param-iface result-iface)
+                (if (<:-iface
+                      rand-iface
+                      param-iface tenv)
+                  (rename-in-iface
+                    result-iface param-name rand-id)
+                  (raise-bad-module-application-error! param-iface
+                    rand-iface m-body)))
+              (else (eopl:error 'interface-of
+                      "unknown module type ~s"
+                      rator-iface))
+              )))
+        (proc-module-body (rand-name rand-iface m-body)
+          ;; add the formal parameter to the tenv as if it had been a
+          ;; top-level module.
+          (let ((body-iface
+                  (interface-of m-body
+                    (extend-tenv-with-module rand-name 
+                      (expand-iface rand-name rand-iface tenv)
+                      tenv))))
+            (proc-iface rand-name rand-iface body-iface)))
+        )))
+
+  ;; defns-to-decls : Listof(Defn) * Tenv -> Listof(Decl)
+  ;; Page: 288, 305
+  ;; Convert defns to a set of declarations for just the names defined
+  ;; in defns.  Do this in the context of tenv.  The tenv is extended
+  ;; at every step, so we get the correct let* scoping
+  (define defns-to-decls
+    (lambda (defns tenv)
+      (if (null? defns)
+        '()
+        (cases definition (car defns)
+          (val-defn (var-name exp)
+            (let ((ty (type-of exp tenv)))
+              (let ((new-env (extend-tenv var-name ty tenv)))
+                (cons
+                  (val-decl var-name ty)
+                  (defns-to-decls (cdr defns) new-env)))))
+          (type-defn (name ty)
+            (let ((new-env (extend-tenv-with-type
+                             name
+                             (expand-type ty tenv)
+                             tenv)))
+              (cons
+                (transparent-type-decl name ty)
+                (defns-to-decls (cdr defns) new-env))))))))
+
+  (define raise-bad-module-application-error!
+    (lambda (expected-type rand-type body)
+      (pretty-print
+        (list 'bad-module-application body
+          'actual-rand-interface: rand-type
+          'expected-rand-interface: expected-type))
+      (eopl:error 'interface-of
+        "Bad module application ~s" body)))
+
+  (define report-module-doesnt-satisfy-iface
+    (lambda (m-name expected-type actual-type)
+      (pretty-print 
+        (list 'error-in-defn-of-module: m-name
+          'expected-type: expected-type
+          'actual-type: actual-type))
+      (eopl:error 'type-of-module-defn)))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/checker.scm b/collects/tests/eopl/chapter8/full-system/checker.scm
new file mode 100755
index 0000000000..b298bbdc72
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/checker.scm
@@ -0,0 +1,126 @@
+(module checker (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+
+  (provide type-of)
+
+  ;; check-equal-type! : Type * Type * Exp -> Unspecified
+  ;; Page: 242
+  (define check-equal-type!
+    (lambda (ty1 ty2 exp)
+      (if (not (equal? ty1 ty2))
+        (report-unequal-types ty1 ty2 exp))))
+
+  ;; report-unequal-types : Type * Type * Exp -> Unspecified
+  ;; Page: 243
+  (define report-unequal-types
+    (lambda (ty1 ty2 exp)
+      (eopl:error 'check-equal-type!  
+          "Types didn't match: ~s != ~a in~%~a"
+          (type-to-external-form ty1)
+          (type-to-external-form ty2)
+          exp)))
+
+  ;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
+  
+  ;; moved to check-modules.scm
+  ;; type-of-program : Program -> Type
+  ;; Page: 244 
+  ;;   (define type-of-program
+  ;;     (lambda (pgm)
+  ;;       (cases program pgm
+  ;;         (a-program (exp1) 
+  ;;           (type-of exp1 (init-tenv))))))
+
+
+  ;; type-of : Exp * Tenv -> Type
+  ;; Page 244--246.  See also page 285.
+  (define type-of
+    (lambda (exp tenv)
+      (cases expression exp
+        (const-exp (num) (int-type))
+        
+        (diff-exp (exp1 exp2)
+          (let ((type1 (type-of exp1 tenv))
+                (type2 (type-of exp2 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (check-equal-type! type2 (int-type) exp2)
+            (int-type)))
+        
+        (zero?-exp (exp1)
+          (let ((type1 (type-of exp1 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (bool-type)))
+        
+        (if-exp (exp1 exp2 exp3)
+          (let ((ty1 (type-of exp1 tenv))
+                (ty2 (type-of exp2 tenv))
+                (ty3 (type-of exp3 tenv)))
+            (check-equal-type! ty1 (bool-type) exp1)
+            (check-equal-type! ty2 ty3 exp)
+            ty2))
+        
+        (var-exp (var) (apply-tenv tenv var))
+
+        ;; lookup-qualified-var-in-tenv defined on page 285.
+        (qualified-var-exp (m-name var-name) 
+          (lookup-qualified-var-in-tenv m-name var-name tenv))
+
+        (let-exp (var exp1 body)
+          (let ((rhs-type (type-of exp1 tenv)))
+            (type-of body (extend-tenv var rhs-type tenv))))
+        
+        (proc-exp (bvar bvar-type body)
+          (let ((expanded-bvar-type
+                  (expand-type bvar-type tenv)))
+            (let ((result-type
+                    (type-of body
+                      (extend-tenv
+                        bvar
+                        expanded-bvar-type
+                        tenv))))
+              (proc-type expanded-bvar-type result-type))))
+        
+        (call-exp (rator rand) 
+          (let ((rator-type (type-of rator tenv))
+                (rand-type  (type-of rand tenv)))
+            (cases type rator-type
+              (proc-type (arg-type result-type)
+                (begin
+                  (check-equal-type! arg-type rand-type rand)
+                  result-type))
+              (else
+                (eopl:error 'type-of
+                  "Rator not a proc type:~%~s~%had rator type ~s"   
+                  rator (type-to-external-form rator-type))))))
+        
+        (letrec-exp (proc-result-type proc-name 
+                      bvar bvar-type 
+                      proc-body
+                      letrec-body)
+          (let ((tenv-for-letrec-body
+                  (extend-tenv 
+                    proc-name
+                    (expand-type
+                      (proc-type bvar-type proc-result-type)
+                      tenv)
+                    tenv)))
+            (let ((proc-result-type
+                    (expand-type proc-result-type tenv))
+                  (proc-body-type
+                    (type-of proc-body
+                      (extend-tenv
+                        bvar
+                        (expand-type bvar-type tenv)
+                        tenv-for-letrec-body))))
+              (check-equal-type!
+                proc-body-type proc-result-type proc-body)
+              (type-of letrec-body tenv-for-letrec-body))))
+        
+        )))
+    
+  ;; type environments are now in static-data-structures.scm .
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/data-structures.scm b/collects/tests/eopl/chapter8/full-system/data-structures.scm
new file mode 100755
index 0000000000..7c21fbf30a
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/data-structures.scm
@@ -0,0 +1,84 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+  ;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  ;;;;;;;;;;;;;;;; module values ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282, 319
+  (define-datatype typed-module typed-module?
+    (simple-module
+      (bindings environment?))
+    (proc-module
+      (bvar symbol?)
+      (body module-body?)
+      (saved-env environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-recursively
+      (id symbol?)
+      (bvar symbol?)
+      (body expression?)
+      (saved-env environment?))
+    (extend-env-with-module
+      (m-name symbol?)
+      (m-val typed-module?)
+      (saved-env environment?)   
+      ))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/drscheme-init.scm b/collects/tests/eopl/chapter8/full-system/drscheme-init.scm
new file mode 100755
index 0000000000..41bf963c75
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/drscheme-init.scm
@@ -0,0 +1,130 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   apply-safely
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter8/full-system/environments.scm b/collects/tests/eopl/chapter8/full-system/environments.scm
new file mode 100755
index 0000000000..3734e7eed5
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/environments.scm
@@ -0,0 +1,85 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")
+  (require "lang.scm")
+
+  (provide empty-env extend-env apply-env)
+  (provide lookup-module-name-in-env)
+  (provide lookup-qualified-var-in-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; initial-value-env : module-env -> environment
+
+  ;; (init-env m-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10, and in which m-env is the module
+  ;; environment.
+
+  (define inital-value-env 
+    (lambda (m-env)
+      (extend-env 
+        'i (num-val 1)
+        (extend-env
+          'v (num-val 5)
+          (extend-env
+            'x (num-val 10)
+            (empty-env m-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; for variables bound by extend-env or extend-env-recursively
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No value binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-recursively
+          (id bvar body saved-env)
+          (if (eqv? search-sym id)
+            (proc-val (procedure bvar body env))          
+            (apply-env saved-env search-sym)))
+        (extend-env-with-module
+            (m-name m-val saved-env)
+          (apply-env saved-env search-sym)) )))
+                
+  ;; for names bound by extend-env-with-module
+
+  ;; lookup-module-name-in-env : Sym * Env -> Typed-Module
+  (define lookup-module-name-in-env
+    (lambda (m-name env)            
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'lookup-module-name-in-env
+            "No module binding for ~s" m-name))
+        (extend-env (bvar bval saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-recursively  (id bvar body saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-with-module
+          (m-name1 m-val saved-env)
+	  (if (eqv? m-name1 m-name)
+            m-val
+	    (lookup-module-name-in-env m-name saved-env))))))
+
+  ;; lookup-qualified-var-in-env : Sym * Sym * Env -> ExpVal
+  ;; Page: 283
+  (define lookup-qualified-var-in-env
+    (lambda (m-name var-name env)
+      (let ((m-val (lookup-module-name-in-env m-name env)))
+        ; (pretty-print m-val)
+        (cases typed-module m-val
+          (simple-module (bindings)
+            (apply-env bindings var-name))
+          (proc-module (bvar body saved-env)
+            (eopl:error 'lookup-qualified-var
+              "can't retrieve variable from ~s take ~s from proc module"
+              m-name var-name))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/expand-type.scm b/collects/tests/eopl/chapter8/full-system/expand-type.scm
new file mode 100755
index 0000000000..dc27fd524d
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/expand-type.scm
@@ -0,0 +1,97 @@
+(module expand-type (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  ; (require "renaming.scm")              ; for fresh-module-name
+
+  (provide expand-type)
+  (provide expand-iface)
+
+;;;;;;;;;;;;;;;; expand-type ;;;;;;;;;;;;;;;;
+
+  ;; expand-type expands a type so that it contains no type
+  ;; abbreviations. 
+
+  ;; For example, if tenv contains a declaration for a module
+
+  ;;   module m1
+  ;;    interface
+  ;;     [abstract-type t
+  ;;      type-abbrev u = int
+  ;;      type-abbrev v = (t -> u)]
+
+  ;; then calling expand-type on from m1 take v should return
+  ;; (from m1 take t -> int)  
+
+  ;; this relies on the invariant that every type returned by
+  ;; lookup-type-name-in-tenv is already expanded.
+
+
+  ;; expand-type : Type * Tenv -> ExpandedType
+  (define expand-type
+    (lambda (ty tenv)
+      (cases type ty
+        (int-type () (int-type))
+        (bool-type () (bool-type))
+        (proc-type (arg-type result-type)
+          (proc-type
+            (expand-type arg-type tenv)
+            (expand-type result-type tenv)))
+        (named-type (name)
+          (lookup-type-name-in-tenv tenv name))
+        (qualified-type (m-name t-name)
+          (lookup-qualified-type-in-tenv m-name t-name tenv))
+        )))
+
+
+  ;; creates new interface with all types expanded
+  ;; expand-iface : Sym * Iface * Tenv -> Iface
+  ;; Page: 307
+  (define expand-iface
+    (lambda (m-name iface tenv)
+      (cases interface iface
+        (simple-iface (decls) 
+          (simple-iface
+            (expand-decls m-name decls tenv)))
+        (proc-iface (param-name param-iface result-iface)
+          ;; proc-ifaces don't get expanded; their types will be expanded
+          ;; when they get to <:-iface
+          iface))))
+
+
+  ;; like defns->decls, this creates only transparent type
+  ;; declarations. 
+
+  ;; expand-decls : Sym * Listof(Decl) * Tenv -> Listof(Decl)
+  ;; Page: 307
+  (define expand-decls
+    (lambda (m-name decls internal-tenv) 
+      (if (null? decls) '()
+        (cases declaration (car decls)
+          (opaque-type-decl (t-name)
+            ;; here the expanded type is m.t
+            (let ((expanded-type (qualified-type m-name t-name)))
+              (let ((new-env (extend-tenv-with-type
+                               t-name
+                               expanded-type
+                               internal-tenv)))
+                (cons 
+                  (transparent-type-decl t-name expanded-type)
+                  (expand-decls m-name (cdr decls) new-env)))))
+          (transparent-type-decl (t-name ty)
+            (let ((expanded-type (expand-type ty internal-tenv)))
+              (let ((new-env (extend-tenv-with-type 
+                               t-name
+                               expanded-type
+                               internal-tenv)))
+                (cons
+                  (transparent-type-decl t-name expanded-type)
+                  (expand-decls m-name (cdr decls) new-env)))))
+          (val-decl (var-name ty)
+            (let ((expanded-type
+                    (expand-type ty internal-tenv)))
+              (cons
+                (val-decl var-name expanded-type)
+                (expand-decls m-name (cdr decls) internal-tenv))))))))
+
+  )
diff --git a/collects/tests/eopl/chapter8/full-system/interp.scm b/collects/tests/eopl/chapter8/full-system/interp.scm
new file mode 100755
index 0000000000..af0b13e953
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/interp.scm
@@ -0,0 +1,161 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> Expval
+  ;; Page: 284
+  (define value-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (let ((env 
+                  (add-module-defns-to-env module-defs (empty-env))))
+            ;; (eopl:pretty-print env)
+            (value-of body env))))))
+
+  ;; add-module-defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 284
+  (define add-module-defns-to-env
+    (lambda (defs env)
+      (if (null? defs)
+        env
+        (cases module-definition (car defs)
+          (a-module-definition (m-name iface m-body)
+            (add-module-defns-to-env
+              (cdr defs)
+              (extend-env-with-module
+                m-name 
+                (value-of-module-body m-body env)
+                env)))))))
+
+  ;; We will have let* scoping inside a module body.
+  ;; We put all the values in the environment, not just the ones
+  ;; that are in the interface.  But the typechecker will prevent
+  ;; anybody from using the extras.
+
+  ;; value-of-module-body : ModuleBody * Env -> TypedModule
+  ;; Page: 285, 320
+  (define value-of-module-body
+    (lambda (m-body env)    
+      (cases module-body m-body
+
+        (defns-module-body (defns)
+          (simple-module
+            (defns-to-env defns env)))
+
+        (var-module-body (id)
+          (lookup-module-name-in-env id env))
+
+        (proc-module-body (m-name m-type m-body)
+          (proc-module m-name m-body env))
+
+        (app-module-body (rator rand)
+          (let ((rator-val (lookup-module-name-in-env rator env))
+                (rand-val  (lookup-module-name-in-env rand  env)))
+            (cases typed-module rator-val
+              (proc-module (m-name m-body env)
+                (value-of-module-body m-body
+                  (extend-env-with-module m-name rand-val env)))
+              (else (raise-cant-apply-non-proc-module! rator-val)))))
+        )))
+
+
+  (define raise-cant-apply-non-proc-module!
+    (lambda (rator-val)
+      (eopl:error 'value-of-module-body 
+        "can't apply non-proc-module-value ~s" rator-val)))
+
+  ;; defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 285, 303
+  (define defns-to-env
+    (lambda (defns env)
+      (if (null? defns)
+        (empty-env)                ; we're making a little environment
+        (cases definition (car defns)
+          (val-defn (var exp)
+            (let ((val (value-of exp env)))
+              ;; new environment for subsequent definitions
+              (let ((new-env (extend-env var val env)))
+                (extend-env var val
+                  (defns-to-env
+                    (cdr defns) new-env)))))
+          ;; type definitions are ignored at run time
+          (else
+            (defns-to-env (cdr defns) env))
+          ))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (apply-env env var))
+
+        (qualified-var-exp (m-name var-name)
+          (lookup-qualified-var-in-env m-name var-name env))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (let ((new-env (extend-env var val env)))
+              ;; (eopl:pretty-print new-env)
+              (value-of body new-env))))
+
+        (proc-exp (bvar ty body)
+	  (proc-val
+	    (procedure bvar body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (ty1 proc-name bvar ty2 proc-body letrec-body)
+          (value-of letrec-body
+            (extend-env-recursively proc-name bvar proc-body env)))
+
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter8/full-system/lang.scm b/collects/tests/eopl/chapter8/full-system/lang.scm
new file mode 100755
index 0000000000..0171ef15d1
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/lang.scm
@@ -0,0 +1,290 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; grammar for full module system.
+  ;; based on CHECKED.
+
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+
+  (define the-grammar
+
+    '(
+      
+      (program
+        ((arbno module-definition)
+         expression)
+        a-program)
+
+      (module-definition
+        ("module" identifier 
+          "interface" interface
+          "body" module-body)
+        a-module-definition)
+
+
+      (interface
+        ("[" (arbno declaration) "]") 
+        simple-iface)
+
+      (interface
+        ("(" "(" identifier ":" interface ")" "=>" interface ")") 
+        proc-iface)
+
+
+      (declaration
+        ("opaque" identifier)
+        opaque-type-decl)
+
+      (declaration
+        ("transparent" identifier "=" type)
+        transparent-type-decl)
+
+      (declaration    
+        (identifier ":" type)
+        val-decl)
+
+
+      (module-body
+        ("[" (arbno definition) "]")
+        defns-module-body)
+
+      (module-body
+        ("module-proc" "(" identifier ":" interface ")" module-body)
+        proc-module-body)
+
+      (module-body
+        (identifier)
+        var-module-body)
+
+      (module-body
+        ("(" identifier identifier ")")
+        app-module-body)
+
+
+      (definition
+        (identifier "=" expression)
+        val-defn)
+
+      (definition
+        ("type" identifier "=" type)
+        type-defn)
+
+      ;; new expression:
+
+      (expression
+        ("from" identifier "take" identifier)
+        qualified-var-exp)
+
+      ;; new types
+
+      (type
+        (identifier)
+        named-type)                
+
+      (type
+        ("from" identifier "take" identifier)
+        qualified-type)
+
+ 
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;; no changes in grammar below here
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+      (expression (number) const-exp)
+
+      (expression
+        (identifier)
+        var-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "(" identifier ":" type ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression expression ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          type identifier "(" identifier ":" type ")"
+          "=" expression "in" expression)
+        letrec-exp)
+
+      (type
+        ("int")
+        int-type)
+      
+      (type
+        ("bool")
+        bool-type)
+      
+      (type
+        ("(" type "->" type ")")
+        proc-type)
+
+      ))
+  
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+
+  ;;;;;;;;;;;;;;;; syntactic tests and observers ;;;;;;;;;;;;;;;;
+
+  ;;;; for types
+
+  (define atomic-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (ty1 ty2) #f)
+        (else #t))))
+
+  (define proc-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (t1 t2) #t)
+        (else #f))))
+
+  (define proc-type->arg-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) arg-type)
+        (else (eopl:error 'proc-type->arg-type
+                "Not a proc type: ~s" ty)))))
+
+  (define proc-type->result-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) result-type)
+        (else (eopl:error 'proc-type->result-types
+                "Not a proc type: ~s" ty)))))
+
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (proc-type (arg-type result-type)
+          (list
+            (type-to-external-form arg-type)
+            '->
+            (type-to-external-form result-type)))
+       (named-type (name) name)
+        (qualified-type (modname varname)
+          (list 'from modname 'take varname))
+        )))
+  
+
+  ;;;; for module definitions
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Maybe(Defn)
+  (define maybe-lookup-module-in-list
+    (lambda (name module-defs)
+      (if (null? module-defs)
+        #f
+        (let ((name1 (module-definition->name (car module-defs))))
+          (if (eqv? name1 name)
+            (car module-defs)
+            (maybe-lookup-module-in-list name (cdr module-defs)))))))
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Defn OR Error
+  (define lookup-module-in-list
+    (lambda (name module-defs)
+      (cond
+        ((maybe-lookup-module-in-list name module-defs)
+         => (lambda (mdef) mdef))
+        (else 
+          (eopl:error 'lookup-module-in-list
+            "unknown module ~s"
+            name)))))
+
+  (define module-definition->name
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-name))))
+
+ (define module-definition->interface
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-type))))
+
+  (define module-definition->body
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-body))))
+
+ (define val-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (val-decl (name ty) #t)
+       (else #f))))
+
+ (define transparent-type-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (transparent-type-decl (name ty) #t)
+       (else #f))))
+
+ (define opaque-type-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (opaque-type-decl (name) #t)
+       (else #f))))
+
+ (define decl->name
+   (lambda (decl)
+     (cases declaration decl
+       (opaque-type-decl (name) name)
+       (transparent-type-decl (name ty) name)
+       (val-decl (name ty) name))))
+
+ (define decl->type
+   (lambda (decl)
+     (cases declaration decl
+       (transparent-type-decl (name ty) ty)
+       (val-decl (name ty) ty)
+       (opaque-type-decl (name)
+         (eopl:error 'decl->type
+           "can't take type of abstract type declaration ~s"
+           decl)))))
+     
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/renaming.scm b/collects/tests/eopl/chapter8/full-system/renaming.scm
new file mode 100755
index 0000000000..32400c1bcc
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/renaming.scm
@@ -0,0 +1,82 @@
+(module renaming (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+
+  (provide rename-in-iface fresh-module-name)
+
+  (define rename-in-iface
+    (lambda (m-type old new)
+      (cases interface m-type
+        (simple-iface (decls)
+          (simple-iface
+            (rename-in-decls decls old new)))
+        (proc-iface (param-name param-type result-type)
+          (proc-iface 
+            param-name
+            (rename-in-iface param-type old new)
+            (if (eqv? param-name old) 
+              result-type
+              (rename-in-iface result-type old new))))
+        (else (eopl:error 'rename-in-iface
+                "unknown module type ~s"
+                m-type))
+        )))
+
+  ;; this isn't a map because we have let* scoping in a list of declarations
+  (define rename-in-decls
+    (lambda (decls old new)
+      (if (null? decls) '()
+        (let ((decl (car decls))
+              (decls (cdr decls)))
+          (cases declaration decl
+            (val-decl (name ty)
+              (cons
+                (val-decl name (rename-in-type ty old new))
+                (rename-in-decls decls old new)))
+            (opaque-type-decl (name)
+              (cons
+                (opaque-type-decl name)
+                (if (eqv? name old)
+                  decls
+                  (rename-in-decls decls old new))))
+            (transparent-type-decl (name ty)
+              (cons
+                (transparent-type-decl 
+                  name
+                  (rename-in-type ty old new))
+                (if (eqv? name old)
+                  decls
+                  (rename-in-decls decls old new))))
+            )))))
+
+  (define rename-in-type
+    (lambda (ty old new)
+      (let recur ((ty ty))
+        (cases type ty 
+          (named-type (id)
+            (named-type (rename-name id old new)))
+          (qualified-type (m-name name)
+            (qualified-type
+              (rename-name m-name old new)
+              name))
+          (proc-type (t1 t2)
+            (proc-type (recur t1) (recur t2)))
+          (else ty)              ; this covers int, bool, and unknown.
+          ))))
+
+  (define rename-name
+    (lambda (name old new)
+      (if (eqv? name old) new name)))
+
+  (define fresh-module-name
+    (let ((sn 0))
+      (lambda (module-name)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string module-name)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  )
+
diff --git a/collects/tests/eopl/chapter8/full-system/scratch.scm b/collects/tests/eopl/chapter8/full-system/scratch.scm
new file mode 100755
index 0000000000..d9383d08b0
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/scratch.scm
@@ -0,0 +1,47 @@
+(error-in-defn-of-module:
+  curry1
+  expected-type:
+  (struct:proc-iface
+    m2
+    (struct:simple-iface
+      ((struct:opaque-type-decl t)
+       (struct:val-decl
+         d
+         (struct:proc-type (struct:named-type t) (struct:named-type t)))))
+    (struct:simple-iface
+      ((struct:transparent-type-decl t (struct:qualified-type m2 t))
+       (struct:val-decl z (struct:named-type t))
+       (struct:val-decl
+         s
+         (struct:proc-type (struct:named-type t) (struct:named-type t)))
+       (struct:val-decl
+         d
+         (struct:proc-type (struct:named-type t) (struct:named-type t))))))
+  actual-type:
+  (struct:proc-iface
+    m2
+    (struct:simple-iface
+      ((struct:transparent-type-decl t (struct:qualified-type ints-1 t))
+       (struct:val-decl
+         d
+         (struct:proc-type (struct:named-type t) (struct:named-type t)))))
+    (struct:simple-iface
+      ((struct:transparent-type-decl t (struct:qualified-type ints-1 t))
+       (struct:val-decl z (struct:named-type t))
+       (struct:val-decl
+         s
+         (struct:proc-type (struct:named-type t) (struct:named-type t)))
+       (struct:val-decl
+         d
+         (struct:proc-type
+           (struct:named-type t)
+           (struct:named-type t)))))))
+
+(define foo
+  (lambda (x y)
+    (cond
+      ((eqv? x y) x)
+      ((and (pair? x) (pair? y)
+         (= (length x) (length y))
+       (map foo x y))
+      (else '**))))
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/static-data-structures.scm b/collects/tests/eopl/chapter8/full-system/static-data-structures.scm
new file mode 100755
index 0000000000..2803e6bb3b
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/static-data-structures.scm
@@ -0,0 +1,162 @@
+(module static-data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?, type?, etc.
+
+  (provide (all-defined))               ; too many things to list
+
+  (define-datatype type-environment type-environment?
+    (empty-tenv)
+    (extend-tenv 
+      (bvar symbol?)
+      (bval type?)
+      (saved-tenv type-environment?))
+    (extend-tenv-with-module
+      (name symbol?)
+      (interface interface?)
+      (saved-tenv type-environment?))
+    (extend-tenv-with-type
+      (t-name symbol?)
+      (t-type type?)                    ; invariant: this must always
+                                        ; be expanded
+      (saved-tenv type-environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; procedures for looking things up tenvs ;;;;;;;;;;;;;;;;
+
+  ;;;;;;;;;;;;;;;; lookup or die
+
+  ;; lookup-qualified-var-in-tenv : Sym * Sym * Tenv -> Type
+  ;; Page: 285
+  (define lookup-qualified-var-in-tenv
+    (lambda (m-name var-name tenv)
+      (let ((iface (lookup-module-name-in-tenv tenv m-name)))
+        (cases interface iface
+          (simple-iface (decls)
+            (lookup-variable-name-in-decls var-name decls))
+          ;; added for full-system:
+          (proc-iface (param-name param-iface result-iface)
+             (eopl:error 'lookup-qualified-var-in-tenv
+              "can't retrieve variable from ~s take ~s from proc-iface"
+              m-name var-name))))))
+
+  (define lookup-variable-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (variable-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'variable search-sym tenv)))))
+
+  (define lookup-module-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (module-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'module search-sym tenv)))))
+
+  (define lookup-type-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (type-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'type search-sym tenv)))))
+
+  (define lookup-qualified-type-in-tenv
+    (lambda (m-name t-name tenv)
+      (let ((iface (lookup-module-name-in-tenv tenv m-name)))
+        (cases interface iface
+          (simple-iface (decls)
+            ;; this is not right, because it doesn't distinguish
+            ;; between type and variable declarations.  Exercise: fix
+            ;; this so that it raises an error if t-name is declared
+            ;; in a val-decl.
+            (lookup-variable-name-in-decls t-name decls))
+          (proc-iface (bvar bvar-iface result-iface)
+            (eopl:error 'lookup-qualified-type
+              "can't retrieve type from ~s take ~s from proc interface"
+              m-name t-name))))))
+
+  (define apply-tenv lookup-variable-name-in-tenv)
+
+  (define raise-tenv-lookup-failure-error
+    (lambda (kind var tenv)
+      (eopl:pretty-print
+        (list 'tenv-lookup-failure: (list 'missing: kind var) 'in:
+          tenv))
+      (eopl:error 'lookup-variable-name-in-tenv)))
+
+
+  ;; this is not right, because it doesn't distinguish
+  ;; between type and variable declarations.  But it will do
+  ;; for now.  Exercise: refine this do that it raises an error if
+  ;; var-name is declared as something other than a val-decl.
+
+  (define lookup-variable-name-in-decls
+    (lambda (var-name decls0)
+      (let loop ((decls decls0))
+        (cond
+          ((null? decls)
+           (raise-lookup-variable-in-decls-error! var-name decls0))
+          ((eqv? var-name (decl->name (car decls)))
+           (decl->type (car decls)))
+          (else (loop (cdr decls)))))))
+
+  (define raise-lookup-variable-in-decls-error!
+    (lambda (var-name decls)
+      (eopl:pretty-print
+        (list 'lookup-variable-decls-failure:
+          (list 'missing-variable var-name)
+          'in:
+          decls))))
+
+  ;;;;;;;;;;;;;;;; lookup or return #f.
+
+  ;; variable-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Type)
+  (define variable-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv (name ty saved-tenv)
+            (if (eqv? name search-sym) 
+              ty
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; module-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Iface)
+  (define module-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv-with-module (name m-type saved-tenv)
+            (if (eqv? name search-sym) 
+              m-type
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; type-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Iface)
+  (define type-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv-with-type (name type saved-tenv)
+            (if (eqv? name search-sym) 
+              type
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; assumes tenv is non-empty.  
+  (define tenv->saved-tenv
+    (lambda (tenv)
+      (cases type-environment tenv
+        (empty-tenv () 
+          (eopl:error 'tenv->saved-tenv
+            "tenv->saved-tenv called on empty tenv"))
+        (extend-tenv (name ty saved-tenv) saved-tenv)
+        (extend-tenv-with-module (name m-type saved-tenv) saved-tenv)
+        (extend-tenv-with-type (name ty saved-tenv) saved-tenv)
+        )))
+
+  )
+                    
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/subtyping.scm b/collects/tests/eopl/chapter8/full-system/subtyping.scm
new file mode 100755
index 0000000000..48c49bbb40
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/subtyping.scm
@@ -0,0 +1,121 @@
+(module subtyping (lib "eopl.ss" "eopl")
+  
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+  (require "renaming.scm")
+
+  (provide <:-iface)
+
+  ;; <:-iface : Iface * Iface * Tenv -> Bool
+  ;; Page: 289, 323
+  (define <:-iface
+    (lambda (iface1 iface2 tenv)
+      (cases interface iface1
+        (simple-iface (decls1)
+          (cases interface iface2
+            (simple-iface (decls2)
+              (<:-decls decls1 decls2 tenv))
+            (else #f)))
+        (proc-iface (param-name1 param-iface1 result-iface1)
+          (cases interface iface2
+            (proc-iface (param-name2 param-iface2 result-iface2)
+              ;; first we rename the param names to the same fresh name
+              (let ((new-name (fresh-module-name param-name1)))
+                (let ((result-iface1
+                        (rename-in-iface
+                          result-iface1 param-name1 new-name)) 
+                      (result-iface2
+                        (rename-in-iface
+                          result-iface2 param-name2 new-name)))
+                  (and
+                    (<:-iface param-iface2 param-iface1 tenv)
+                    (<:-iface result-iface1 result-iface2 
+                      (extend-tenv-with-module
+                        new-name
+                        (expand-iface new-name param-iface1 tenv)
+                        tenv))))))
+            (else #f))))))
+
+  ;; s1 <: s2 iff s1 has at least as much stuff as s2, and in the same
+  ;; order.  We walk down s1 until we find a declaration that declares
+  ;; the same name as the first component of s2.  If we run off the
+  ;; end of s1, then we fail.  As we walk down s1, we record any type
+  ;; bindings in the tenv
+
+  ;; <:-decls : Listof(Decl) * Listof(Decl) * Tenv -> Bool
+  ;; Page: 289, 305
+  (define <:-decls
+    (lambda (decls1 decls2 tenv)
+      (cond
+        ;; if nothing in decls2, any decls1 will do
+        ((null? decls2) #t)
+        ;; nothing in decls1 to match, so false
+        ((null? decls1) #f)
+        (else
+          ;; at this point we know both decls1 and decls2 are non-empty.
+          (let ((name1 (decl->name (car decls1)))
+                (name2 (decl->name (car decls2))))
+            (if (eqv? name1 name2)
+              ;; same name.  They'd better match
+              (and
+                (<:-decl (car decls1) (car decls2) tenv)
+                (<:-decls (cdr decls1) (cdr decls2)
+                  (extend-tenv-with-decl (car decls1) tenv)))
+              ;; different names.  OK to skip, but record decl1 in the tenv. 
+              (<:-decls (cdr decls1) decls2
+                (extend-tenv-with-decl (car decls1) tenv))))))))
+
+  ;; extend-tenv-with-decl : Decl * Tenv -> Tenv
+  ;; Page: 309
+  (define extend-tenv-with-decl
+    (lambda (decl tenv)
+      (cases declaration decl
+        ;; don't need to record val declarations
+        (val-decl (name ty) tenv)
+        (transparent-type-decl (name ty)
+          (extend-tenv-with-type
+            name
+            (expand-type ty tenv)
+            tenv))
+        (opaque-type-decl (name)
+          (extend-tenv-with-type
+            name
+            ;; the module name doesn't matter, since the only
+            ;; operation on qualified types is equal?
+            (qualified-type (fresh-module-name '%abstype) name)
+            tenv)))))
+
+  ;; decl1 and decl2 are known to declare the same name.  There are
+  ;; exactly four combinations that can succeed.
+
+  ;; <:-decl : Decl * Decl * Tenv -> Bool
+  ;; Page: 311
+  (define <:-decl 
+    (lambda (decl1 decl2 tenv)
+      (or
+        (and
+          (val-decl? decl1)
+          (val-decl? decl2)
+          (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
+        (and
+          (transparent-type-decl? decl1)
+          (transparent-type-decl? decl2)
+          (equiv-type? (decl->type decl1) (decl->type decl2) tenv))
+        (and 
+          (transparent-type-decl? decl1)
+          (opaque-type-decl? decl2))
+        (and
+          (opaque-type-decl? decl1)
+          (opaque-type-decl? decl2))
+        )))
+
+  ;; equiv-type? : Type * Type * Tenv -> Bool
+  ;; Page: 311
+  (define equiv-type?
+    (lambda (ty1 ty2 tenv)
+      (equal?
+        (expand-type ty1 tenv)
+        (expand-type ty2 tenv))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/test-suite.scm b/collects/tests/eopl/chapter8/full-system/test-suite.scm
new file mode 100755
index 0000000000..f0e45979e8
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/test-suite.scm
@@ -0,0 +1,1644 @@
+(module test-suite mzscheme
+
+  (provide tests-for-run tests-for-check tests-for-parse)
+
+  (define the-test-suite
+    '(
+      ;; tests from run-tests:
+  
+;;       ;; simple arithmetic
+;;       (positive-const "11" int 11)
+;;       (negative-const "-33" int -33)
+;;       (simple-arith-1 "-(44,33)" int 11)
+  
+;;       ;; nested arithmetic
+;;       (nested-arith-left "-(-(44,33),22)" int -11)
+;;       (nested-arith-right "-(55, -(22,11))" int 44)
+  
+;;       ;; simple variables
+;;       (test-var-1 "x" error)
+;;       (test-var-2 "-(x,1)" error)
+;;       (test-var-3 "-(1,x)" error)
+
+;;       (zero-test-1 "zero?(-(3,2))" bool #f)
+;;       (zero-test-2 "-(2,zero?(0))" error)
+      
+;;       ;; simple unbound variables
+;;       (test-unbound-var-1 "foo" error)
+;;       (test-unbound-var-2 "-(x,foo)" error)
+  
+;;       ;; simple conditionals
+;;       (if-true "if zero?(0) then 3 else 4" int 3)
+;;       (if-false "if zero?(1) then 3 else 4" int 4)
+
+;;       ;; make sure that the test and both arms get evaluated
+;;       ;; properly. 
+;;       (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" int 3)
+;;       (if-eval-test-false "if zero?(-(11,12)) then 3 else 4" int 4)
+;;       (if-eval-then "if zero?(0) then -(22,1) else -(22,2)" int 21)
+;;       (if-eval-else "if zero?(1) then -(22,1) else -(22,2)" int 20)
+      
+;;       ;; make sure types of arms agree (new for lang5-1)
+      
+;;       (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+;;       (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+;;       ;; simple let
+;;       (simple-let-1 "let x = 3 in x" int 3)
+
+;;       ;; make sure the body and rhs get evaluated
+;;       (eval-let-body "let x = 3 in -(x,1)" int 2)
+;;       (eval-let-rhs "let x = -(4,1) in -(x,1)" int 2)
+
+;;       ;; check nested let and shadowing
+;;       (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int -1)
+;;       (check-shadowing-in-body "let x = 3 in let x = 4 in x" int 4)
+;;       (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int 29)
+      (checker-doesnt-ignore-type-info-in-proc-but-interp-does 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error 29) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int 29)
+      (let-to-proc-1
+        "(proc( f : (int -> int))(f 30)  proc(x : int)-(x,1))" int 29)
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int -1)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int 2)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int 32)
+      (simple-letrec-2
+        "letrec int double(x : int) = if zero?(x) then 0 else -((double -(x,1)), -2) in (double 4)"
+        int 8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        int 20)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int 6)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int 3) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc ( f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool)))
+        )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int 1)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int 3)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int 39)
+
+      (letrec-non-shadowing
+        "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int 1)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-the-fcn "
+let f = proc (x : int) proc (y : int) -(x,y)   
+in letrec 
+     int loop(x : int) = if zero?(x) then 1 else ((f x) (loop -(x,1)))
+   in (loop 4)"
+        int 3)
+
+       (modules-declare-and-ignore "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+33"
+        int 33)
+
+       (modules-take-one-value "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+from m take u"
+        int 3)
+
+       (modules-take-one-value-no-import
+        "module m 
+          interface 
+           [u : int] 
+          body 
+           [u = 3]
+         from m take u"
+        int 3)
+
+       (modules-take-from-parameterized-module "
+module m
+ interface 
+  ((m1 : []) => [u : int])
+ body 
+  module-proc (m1 : []) [u = 3]
+
+from m take u
+"
+        error error)
+
+       (modules-check-iface-subtyping-1 "
+module m 
+ interface 
+  [u : int]
+ body 
+  [u = 3 v = 4]
+from m take u"
+        int 3)
+
+
+       ;; if the interpreter always called the typechecker, or put
+       ;; only declared variables in the module, this would raise an
+       ;; error.  Exercise: make this modification.
+
+       (modules-take-one-value-but-interface-bad "
+         module m interface []  body [u = 3]
+         from m take u"
+; this version for permissive interp
+        error 3
+; this version for strict interp
+;         error error
+        )
+
+       (modules-take-bad-value
+        "module m interface []  body [u = 3]
+         from m take x"
+        error error)       
+
+        (modules-two-vals "
+module m
+ interface 
+  [u : int 
+   v : int] 
+ body
+  [u = 44
+   v = 33]
+
+  -(from m take u, from m take v)"
+        int 11)
+
+
+        (modules-two-vals-bad-interface-1
+        "module m interface [u : int v : bool]  
+                  body [u = 44 v = 33]
+         -(from m take u, from m take v)"
+        error 11)
+
+        (modules-extra-vals-are-ok-1 "
+          module m interface [x : int] body [x = 3 y = 4]
+          from m take x"
+          int 3)
+
+        (module-extra-vals-are-ok-2 "
+          module m interface [y : int] body [x = 3 y = 4]
+          from m take y"
+          int)
+          
+        (module-extra-types-are-ok-11 
+          "module m interface [y : int] body [x = 3 type t = int y = 4]
+         from m take y"
+          int 4)
+
+        (module-extra-types-are-ok-12
+          "module m interface [opaque t y : int] 
+                    body [type u = bool x = 3 type t = int y = 4]
+          from m take y"
+          int)
+
+        (module-extra-types-are-ok-13
+          "module m interface [transparent t = int y : int] 
+                    body [type u = bool x = 3 type t = int y = 4]
+          from m take y"
+          int 4)
+
+
+       (modules-two-vals-bad-interface-14
+        "module m interface 
+            [v : int 
+             u : bool]
+          body 
+           [v = zero?(0) u = 33]
+         -(from m take u, from m take v)"
+        error)
+
+
+        (modules-check-let*-1
+        "module m interface      [u : int v : int]
+                  body [u = 44  v = -(u,11)]
+         -(from m take u, from m take v)"
+        int 11)
+
+      (modules-check-let*-2.0
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+      (modules-check-let*-2.05
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] body [v = -(from m1 take u,11)]
+         33"
+        int 33)                       ; doesn't actually import anything
+
+      (modules-check-let*-2.1
+        "module m1 interface [u : int] body [u = 44]
+         module m2   
+          interface [v : int] 
+          body [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+     (modules-check-let*-2.2
+        "module m2
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         module m1 interface [u : int] body [u = 44]
+         -(from m1 take u, from m2 take v)"
+        error)
+
+      (modules-check-parameterized-1 "
+        module m1 
+            interface ((m : [v : int]) => [w : int])
+            body 
+             module-proc (m : [v : int]) [w = -(from m take v, 1)]
+        module m2 
+         interface [v : int] 
+         body [v = 33]
+        module m3  
+         interface [w : int] 
+         body 
+          (m1 m2)
+        from m3 take w"
+        int 32)
+
+      (modules-check-parameterized-bad-argument "
+        module m1 
+            interface ((m : [v : int]) =>  [w : int])
+            body 
+             module-proc (m : [v : int]) [w = from m take v]
+        module m2 interface [u : int] body [u = 33]
+        module m3 
+         interface [w : int] 
+         body
+           (m1 m2)
+        from m3 take w"
+        error)
+        
+      (modules-check-parameterized-bad-interface-1 "
+        module m1 
+            interface ((m : [v : int])  => [w : int])
+            body module-proc (m : [v : int]) [w = from m take v]
+        module m2 interface [v : int] body [x = 33]  % bad
+        module m3 interface [w : int] body  (m1 m2)
+        from m3 take w"
+        error)
+
+      (modules-check-parameterized-2 "
+        module m1
+         interface 
+          ((m : [v : int]) => [u : int])
+         body
+          module-proc (m : [v : int]) [w = from m take v]
+        module m2 
+         interface [v : int] 
+         body [v = 33]
+        module m3   interface [w : int] body 
+         (m1 m2)
+        from m3 take w"
+        error)
+
+      (modules-export-abs-type-1
+        "module m1 interface [opaque t] body [type t = int]
+         33"
+        int 33)
+
+      (modules-take-from-ints-0.1
+        "module m1
+          interface [opaque t  
+             zero : t] 
+          body [type t = int
+             zero = 0]
+         33"
+        int 33)
+
+      (modules-take-from-ints-0.1a
+        "module m1
+          interface [opaque t  
+             zero : t] 
+          body [type t = int
+             zero = 0]
+         from m1 take zero"
+        (from m1 take t) 0)
+
+       (modules-take-from-ints-0.1.91
+        "module m1
+            interface [opaque t
+               zero : t]
+            body [type t = int
+               zero = 0
+               foo = 3]
+         let check = proc (x : from m1 take t) zero?(0)
+         in (check  from m1 take zero)"
+        bool #t)
+
+       (modules-take-from-ints-0.1.91a
+        "module m1
+            interface [opaque t
+               zero : t]
+            body [type t = int
+               zero = 0
+               foo = 3]
+         let check = proc (x : from m1 take t  ) zero?(0)
+         in check"
+        ((from m1 take t) -> bool))
+
+       (modules-take-from-ints-0.2
+        "module m1
+          interface [opaque t
+             zero : t
+             check : (t -> bool)] 
+          body [type t = int
+             zero = 0
+             check = proc(x : t) zero?(x)]
+         (from m1 take check  from m1 take zero)"
+        bool #t)
+
+       (modules-mybool-1
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+          (from mybool take to-bool  
+           from mybool take false)
+          "
+         bool #f)
+
+       (modules-mybool-1a
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+          from mybool take to-bool"
+        ((from mybool take t) -> bool))
+
+       (modules-mybool-1b
+        "module mybool 
+          interface [opaque t
+             true : t
+             false : t
+             and : (t -> (t -> t))
+             not : (t -> t)
+             to-bool : (t -> bool)]
+          body [type t = int
+             true = 0
+             false = 1
+             and = proc (x : t) proc (y : t)
+                        if zero?(x) then y else false
+             not = proc (x : t) if zero?(x) then false else true
+             to-bool = proc (x : t) 
+                            if zero?(x) then zero?(0) else zero?(1)
+             ]
+           from mybool take false
+          "
+         (from mybool take t) )
+
+      (modules-take-from-ints-1
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in (check (s (s (p (s z)))))"
+        bool #t)
+
+      (modules-take-from-ints-1a
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in s"
+        ((from ints-1 take t) -> (from ints-1 take t)))
+
+
+      (modules-take-from-ints-1b
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t) 
+             check : (t -> bool)]
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             check = proc(x : t) zero?(0)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let check = from ints-1 take check
+         in check"
+        ((from ints-1 take t) -> bool))
+
+
+   (modules-take-from-ints-2
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)] 
+          body [type t = int
+             zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        int 33)
+
+   
+   (modules-take-from-ints-2-bad-1
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)] 
+          body [zero = proc (x : t) x
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)
+             ]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        error)
+
+   (modules-take-from-ints-3
+        "module ints-1
+          interface [opaque t
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> int)] 
+          body [zero = 0
+             succ = proc(x : t) -(x,-1)
+             pred = proc(x : t) -(x,1)
+             is-zero = proc (x : t) zero?(x)]
+         let z = from ints-1 take zero
+         in let s = from ints-1 take succ
+         in let p = from ints-1 take pred
+         in let z? = from ints-1 take is-zero
+         in if (z? (s z)) then 22 else 33"
+        error)
+
+   (modules-check-polymorphism-1 "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) x]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+
+   (modules-check-polymorphism-1a "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) x]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+    (modules-check-polymorphism-1b "
+     module m interface [opaque t
+                 f : (t -> t)]
+              body [type t = int
+                 f = proc (x : t) -(x,1)]
+     from m take f"
+     ((from m take t) -> (from m take t)))
+
+    (modules-check-shadowing-1 "
+      module ints-1
+       interface 
+        [opaque t
+          zero : t
+          succ : (t -> t)
+          is-zero : (t -> bool)] 
+       body 
+        [type t = int
+         zero = 0
+         succ = proc(x : t) -(x,-1)
+         pred = proc(x : t) -(x,1)
+         is-zero = proc (x : t) zero?(x)]
+      module ints-2 
+       interface 
+        [zero : from ints-1 take t
+         succ : (from ints-1 take t -> from ints-1 take t)
+         is-zero : (from ints-1 take t -> bool)]
+       body
+        [zero = from ints-1 take zero
+         succ = from ints-1 take succ
+         is-zero = from ints-1 take is-zero]
+      let s = from ints-2 take succ
+      in let z? = from ints-2 take is-zero
+      in let z = from ints-2 take zero
+      in (z? (s z))"
+     bool #f)
+
+
+  (modules-check-shadowing-1.8 "
+      module ints-1 
+       interface 
+        [opaque t  
+         zero : t] 
+       body 
+        [type t = int 
+         zero = 0]
+      module ints-2 
+       interface     
+        [foo : from ints-1 take t]
+       body 
+        [foo = from ints-1 take zero]
+      let v = from ints-2 take foo
+      in 33
+     " int 33)
+
+   (modules-check-shadowing-1.8a
+     "module ints-1 
+       interface [opaque t  zero : t] 
+       body [type t = int zero = 0]
+      module ints-2 
+       interface [ foo : from ints-1 take t]
+       body 
+        [foo = from ints-1 take zero]
+      from ints-2 take foo
+     " 
+     (from ints-1 take t))
+
+   ;; this test is bogus, because duplicate module names are not
+   ;; allowed.  
+
+;;    (modules-check-shadowing-1.9.1 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in 33
+;;      " int)
+
+   ;; Once exercise 8.1 (reject duplicated module names) is done, the
+   ;; test should be:
+
+;;    (modules-check-shadowing-1.9.2 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in 33
+;;      " error)    ; <<<---- changed outcome.
+
+
+   ;; This is bogus in yet another way.  In the following example, v
+   ;; has the type of from ints-1 take foo, which is from ints-1 take
+   ;; t.  But at the point where v is used, ints-1 has been rebound,
+   ;; and doesn't even have a type component t.
+
+;;    (modules-check-shadowing-1.9.2 
+;;      "module ints-1 interface [opaque t  zero : t] 
+;;                   body [type t = int zero = 0]
+;;       module ints-1 interface [foo : from ints-1 take t]
+;;                   body import ints-1
+;;                    [foo = from ints-1 take zero]
+;;       let v = from ints-1 take foo
+;;       in v
+;;      " (from ints-1 take t))
+
+
+   ;; We can take advantage of this confusion to generate an unsound
+   ;; program that type-checks:
+
+;;    (modules-check-shadowing-1.9.3 "
+;; module ints-1 
+;;  interface [opaque t zero : t]
+;;  body [type t = int zero = 0]
+;; module ints-1
+;;  interface [zero : from ints-1 take t
+;;             opaque t
+;;             f : (t -> int)]
+;;  body [zero = from ints-1 take zero
+;;        type t = bool
+;;        f = proc (b : t) if b then 33 else 44]
+;;  (from ints-1 take f
+;;   from ints-1 take zero)"
+;;      int)
+
+   ;; this code allows the application of ints-1.f because its type is
+   ;; (ints-1.t -> int), and zero has type ints-1.t .  But those are
+   ;; two different modules both named ints-1.
+
+   ;; In general, the solution is to rename the inner ints-1 to avoid
+   ;; the conflict.  Exercise: do this. When you do this,
+   ;; modules-check-shadowing-1.9.3 should give back "error".
+     
+   ;; Aren't you sorry you asked?
+
+   (modules-apply-param-module-0.1
+       "module copy-module
+         interface 
+          ((m : [opaque t zero : t]) => 
+           [opaque t 
+            zero : t])
+         body 
+          module-proc (n : [opaque t zero : t]) 
+           [type t = from n take t
+            zero = from n take zero]
+        33"
+       int 33)
+
+  (modules-apply-param-module-1
+       "module makeints
+         interface 
+          ((m : [opaque t 
+             zero : t
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)])
+            => [opaque t 
+                zero : t
+                succ : (t -> t)
+                pred : (t -> t)
+                is-zero : (t -> bool)])
+         body 
+          module-proc (m : [opaque t 
+                            zero : t
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)])
+           [type t = from m take t
+            zero = from m take zero
+            succ = proc (x : t) 
+                        (from m take succ (from m take succ x))
+            pred = proc (x : t) 
+                        (from m take pred (from m take pred x))
+            is-zero = proc (x : t) (from m take is-zero x)]
+
+        module ints-1
+         interface 
+           [opaque t 
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body 
+           [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)]
+ 
+       module ints-2 
+         interface 
+           [opaque t 
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body
+          (makeints ints-1)
+
+        let check = proc (x : from ints-2 take t) zero?(0)
+        in (check 
+             (from ints-2 take succ 
+               (from ints-2 take succ from ints-2 take zero)))"
+       bool #t)
+
+   (transparent-0
+     "module m1 interface [transparent t = int
+                   zero : t]
+                body [type t = int
+                   zero = 0]
+      -(from m1 take zero,1)"
+     int)
+
+   (transparent-1 
+     "module m1 
+       interface [opaque t zero : t]
+       body [type t = int zero = 0]
+      module m2 
+       interface [transparent t = from m1 take t   % don't know
+                                           % what's in m1!
+          one : t]
+       body [type t = int
+          one = 1]
+     -(from m2 take one, from m1 take zero)
+     "
+     error)
+
+  (transparent-2
+    "module m1 
+      interface 
+       [transparent t = int
+        zero : t]
+      body 
+       [type t = int
+        zero = 0]
+
+     module m2 
+      interface 
+       [transparent t = from m1 take t   % now known to be int.
+        one : t]
+      body 
+        [type t = int
+         one = 1]
+      -(from m2 take one, from m1 take zero)
+     "
+     int 1)
+
+     (modules-add-double-1
+       "module add-double 
+         interface 
+          ((m : [opaque t 
+             zero : t 
+             succ : (t -> t)
+             pred : (t -> t)
+             is-zero : (t -> bool)])
+           => [double : (from m take t -> from m take t)])
+         body 
+          module-proc (m : [opaque t 
+                            zero : t 
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)])
+          [double 
+            = letrec 
+               from m take t double (x : from m take t) 
+                = if (from m take is-zero x)
+                  then from m take zero
+                  else (from m take succ
+                        (from m take succ x))
+              in double]
+
+        module ints-1
+         interface 
+           [opaque t 
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body 
+           [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)
+            ]  
+
+        module ints-2  
+         interface [double : (from ints-1 take t -> from ints-1 take t)]
+         body
+           (add-double ints-1)
+
+        (from ints-1 take is-zero
+          (from ints-2 take double
+            (from ints-1 take succ
+              from ints-1 take zero)))"
+       bool
+       #f
+       )
+
+  ;; this example shows the need for substitution in types in a module
+  ;; application.   This also means you need to have the bound
+  ;; variable in the type of a parameterized module.
+
+  (diamond-1 "
+     module maker1 
+      interface 
+       ((m : [opaque t 
+              succ : (t -> t)])
+        => [transparent t = from m take t 
+            double : (t -> t)])
+      body 
+       module-proc (m : [opaque t succ : (t -> t)])
+        [type t = from m take t
+         double = let s = from m take succ
+                  in proc (x : t) (s (s x))]
+
+     module m0 
+      interface 
+       [opaque t 
+        succ : (t -> t)
+        zero : t]
+      body 
+       [type t = int
+        succ = proc(x : t)-(x,-1)
+        zero = 0]
+
+     module m2 
+      interface 
+       [transparent t = from m0 take t
+        double : (t -> t)]
+      body
+       (maker1 m0)
+
+     let check = proc (x : from m0 take t) zero?(0)
+     in (check
+          (from m2 take double
+           from m0 take zero))
+     "
+     bool #t)
+
+  (pass-around-ho-module-1 "
+       module m1
+        interface
+         ((m : [v : int]) =>  [u : int])
+        body 
+         module-proc (m : [v : int])
+          [u = from m take v]
+
+       module m2 
+        interface [v : int] 
+        body [v = 33]
+
+       module m1a 
+        interface ((m : [v : int]) => [u : int])
+        body
+         m1
+
+       module m2a
+         interface [v : int]
+         body 
+          m2
+
+        module m3  
+         interface [u : int] 
+         body
+          (m1a m2a)
+
+        from m3 take u"
+    int 33)
+
+   (modules-myints-0.1 "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,-2)
+            pred = proc(x : t) -(x,2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     (from ints-1 take t)
+     4)
+
+   (modules-myints-0.20 "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     error
+     -4)
+
+
+   (modules-myints-0.2a "
+        module ints-1
+         interface [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)
+            ]
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in let is-zero = from ints-1 take is-zero
+         in (succ (succ zero))"
+     (from ints-1 take t) -4)
+
+    (modules-apply-param-module-1 "
+        module makeints 
+         interface
+         ((m: [opaque t
+                            zero : t
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)]) 
+          => [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)])
+         body 
+          module-proc (m: [opaque t
+                            zero : t
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)])
+           [type t = from m take t
+            zero = from m take zero
+            succ = proc (x : t) 
+                        (from m take succ (from m take succ x))
+            pred = proc (x : t) 
+                        (from m take pred (from m take pred x))
+            is-zero = proc (x : t) (from m take is-zero x)
+           ]
+
+        module ints-1
+         interface 
+           [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body 
+           [type t = int
+            zero = 0
+            succ = proc(x : t) -(x,2)
+            pred = proc(x : t) -(x,-2)
+            is-zero = proc (x : t) zero?(x)]
+ 
+       module ints-2
+         interface 
+           [opaque t
+            zero : t
+            succ : (t -> t)
+            pred : (t -> t)
+            is-zero : (t -> bool)]  
+         body
+          (makeints ints-1)
+
+
+        (from ints-2 take succ 
+         (from ints-2 take succ  
+          from ints-2 take zero)) "
+       (from  ints-2 take t)
+       -8)
+
+
+     (modules-apply-param-module-3
+       "module makeints 
+         interface
+          ((n : [opaque t
+                 zero : t
+                 succ : (t -> t)
+                 pred : (t -> t)
+                 is-zero : (t -> bool)])
+           => [opaque t
+               zero : t
+               succ : (t -> t)
+               pred : (t -> t)
+              is-zero : (t -> bool)])
+         body
+          module-proc (m : [opaque t
+                            zero : t
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)])
+           [type t = from m take t
+            zero = from m take zero
+            succ = proc (x : t) 
+                    (from m take succ (from m take succ x))
+            pred = proc (x : t) 
+                    (from m take pred (from m take pred x))
+            is-zero = proc (x : t) (from m take is-zero x)
+           ]
+
+        module ints-1 
+         interface
+          [opaque t
+           zero : t
+           succ : (t -> t)
+           pred : (t -> t)
+           is-zero : (t -> bool)]  
+         body
+          [type t = int 
+           zero = 0
+           succ = proc(x : t) -(x,2)
+           pred = proc(x : t) -(x,-2)
+           is-zero = proc (x : t) zero?(x)]
+        module ints-2
+         interface 
+          [opaque t
+           zero : t
+           succ : (t -> t)
+           pred : (t -> t)
+           is-zero : (t -> bool)]  
+         body
+          (makeints ints-1)
+
+        let zero = from ints-2 take zero
+        in let succ = from ints-2 take succ
+        in let pred = from ints-2 take pred
+        in let is-zero = from ints-2 take is-zero
+        in letrec int to-int (n : from ints-2 take t)
+                           = if (is-zero n)
+                              then 0
+                              else -( (to-int (pred n)), -1)
+        in (to-int (succ (succ zero)))
+         "
+        int
+        2)
+
+
+    (modules-apply-param-module-4 "
+        module makeints 
+         interface
+          ((m : [opaque t
+                 zero : t
+                 succ : (t -> t)
+                 pred : (t -> t)
+                 is-zero : (t -> bool)])
+           => [opaque t
+               zero : t
+               succ : (t -> t)
+               pred : (t -> t)
+               is-zero : (t -> bool)])
+         body
+          module-proc (m : [opaque t
+                            zero : t
+                            succ : (t -> t)
+                            pred : (t -> t)
+                            is-zero : (t -> bool)]) 
+           [type t = from m take t
+            zero = from m take zero
+            succ = proc (x : t) 
+                    (from m take succ (from m take succ x))
+            pred = proc (x : t) 
+                    (from m take pred (from m take pred x))
+            is-zero = proc (x : t) (from m take is-zero x)
+           ]
+
+        module ints-1
+         interface 
+          [opaque t
+           zero : t
+           succ : (t -> t)
+           pred : (t -> t)
+           is-zero : (t -> bool)]  
+         body 
+          [type t = int
+           zero = 0
+           succ = proc(x : t) -(x,2)
+           pred = proc(x : t) -(x,-2)
+           is-zero = proc (x : t) zero?(x)]
+
+        module ints-2
+         interface 
+          [opaque t
+           zero : t
+           succ : (t -> t)
+           pred : (t -> t)
+           is-zero : (t -> bool)]  
+         body
+          (makeints ints-1)
+
+        module int3
+         interface 
+          [opaque t
+           zero : t
+           succ : (t -> t)
+           pred : (t -> t)
+           is-zero : (t -> bool)]  
+         body
+          (makeints ints-2)
+
+        (from int3 take succ 
+         (from int3 take succ  from int3 take zero)) "
+       (from  int3 take t)
+       -16)
+
+    (lift-type-from-scope-0.01 "
+       module m1 
+        interface 
+         [transparent u = int
+          transparent t = int]
+        body 
+         [type u = int
+          type t = u]
+      module m2 
+       interface 
+        [transparent u = int
+         x : from m1 take t]
+       body
+        [type u = int
+         x = 3]
+
+       33"
+      int
+      33)
+
+    (lift-type-from-scope-0.1 "
+       module m1 
+        interface 
+         [transparent u = int
+          transparent t = u]
+        body 
+         [type u = int
+          type t = u]
+       module m2 
+        interface 
+         [transparent u = int
+          x : from m1 take t]
+        body
+         [type u = int
+          x = 3]
+
+       33"
+      int
+      33)
+
+    (lift-type-from-scope-1 "
+       module m1 
+        interface 
+         [opaque u
+          transparent t = u]
+        body 
+         [type u = bool
+          type t = u]
+       module m2 
+        interface 
+         [transparent u = int
+          x : from m1 take t]
+        body
+         [type u = int
+          x = 3]
+
+       33"
+      error                             
+      33)
+
+    (lift-type-from-scope-2 "
+       module m1 
+        interface 
+         [opaque t1
+          f : (t1 -> t1)]
+        body 
+         [type t1 = bool
+          f = proc (x : t1) x]
+
+       from m1 take f"
+      ((from m1 take t1) -> (from m1 take t1))
+      )                                 
+
+    (lift-type-from-scope-3 "
+       module m1 
+        interface 
+         [opaque t2
+          f : (t1 -> t1)]
+        body 
+         [type t1 = bool
+          f = proc (x : t1) x]
+
+       from m1 take f"
+      error                             ; this should die because t1
+                                        ; is unbound.
+      )
+
+      (modules-14.1 "
+      module m1 interface 
+                 [transparent t = int
+                  z : t]
+                body
+                  [type t = int
+                   z = 0]
+
+      module m2 
+       interface
+        [foo : (from m1 take t -> int)]
+       body
+        [foo = proc (x : from m1 take t) x]
+
+      (from m2 take foo  33)"
+      int)
+
+      (modules-14 "
+      module m1 
+       interface
+        [transparent t = int
+         z : t]
+       body
+        [type t = int
+         z = 0]
+      module m2 
+       interface
+        [foo : (from m1 take t -> int)]
+       body
+        [foo = proc (x : from m1 take t) x]
+
+      from m2 take foo"
+        (int -> int))
+
+
+      (modules-14b "
+module m1 interface [transparent t1 = int] body [type t1 = int]
+module m2 interface [foo : from m1 take t1] body [foo = 3]
+from m2 take foo"
+        int)
+
+      (modules-test-curry1 "
+      module maker1
+       interface
+        ((m1 : [opaque t
+                s : (t -> t)])
+         => [transparent t = from m1 take t
+             d : (t -> t)])
+       body
+        module-proc
+         (m1 : [opaque t
+                s : (t -> t)])
+         [type t = from m1 take t
+          d = proc (x : t) (from m1 take s (from m1 take s x))]
+
+       module m0
+        interface
+         [opaque t
+          s : (t -> t)]
+        body
+         [type t = int
+          s = proc (u : t) -(u, -1)]
+
+        module m1
+         interface
+          [opaque t
+           d : (t -> t)]
+         body
+          (maker1 m0)
+
+        33" int 33)
+
+      (modules-test-curry2 "
+      module maker1
+       interface
+        ((m1 : [opaque t
+                s : (t -> t)])
+         => ((m2 : [transparent t = from m1 take t])
+              => [transparent t = from m1 take t
+                  d : (t -> t)]))
+       body
+        module-proc
+         (p1 : [opaque t
+                s : (t -> t)])
+         module-proc
+          (p2 : [transparent t = from p1 take t])
+          [type t = from p1 take t
+           d = proc (x : t) (from p1 take s (from p1 take s x))]
+
+       module m0
+        interface
+         [opaque t
+          s : (t -> t)]
+        body
+         [type t = int
+          s = proc (u : t) -(u, -1)]
+
+       module m1
+        interface
+         ((m2 : % [opaque t]
+            [transparent t = from m0 take t])
+          => [transparent t = from m2 take t
+              d : (t -> t)])
+        body
+         (maker1 m0)
+
+         module m2
+          interface
+           [opaque t
+            d : (t -> t)]
+          body
+           (m1 m0)
+
+        33" int 33)
+
+;; I think these require smarter treatment of sharing-- see Leroy POPL 94.
+
+;;       (modules-curried-application-0 "
+;;       module curried-functor
+;;        interface
+;;         ((m1 : [opaque t])
+;;          => ((m2 : [transparent t = from m1 take t])
+;;              => [transparent t = from m1 take t]))
+;;         body
+;;          module-proc
+;;           (m1 : [opaque t]) 
+;;           module-proc
+;;            (m2 : [transparent t = from m1 take t])
+;;            [type t = from m1 take t]
+
+;;        module intx
+;;         interface
+;;          [opaque t
+;;           z : t]
+;;         body
+;;          [type t = bool
+;;           z = zero?(1)]
+
+;;        module app1
+;;         interface
+;;          ((m2 : [opaque t])
+;;           => [transparent t = from m1 take t])
+;;         body
+;;          (curried-functor intx)
+
+;;        33"
+;;         int 33)
+
+
+;;     (modules-curried-application-1 "
+;;       module curried-merge
+;;        interface
+;;         ((m1 : [opaque t 
+;;                 z : t 
+;;                 s : (t -> t)])
+;;          => ((m2 : [transparent t = from m1 take t 
+;;                     d : (t -> t)])
+;;              => [transparent t = from m1 take t
+;;                  z : t
+;;                  s : (t -> t)
+;;                  d : (t -> t)]))
+;;         body
+;;          module-proc
+;;           (m1 : [opaque t 
+;;                  z : t 
+;;                  s : (t -> t)]) 
+;;           module-proc
+;;            (m2 : [transparent t = from m1 take t 
+;;                   d : (t -> t)])
+;;           [type t = from m1 take t
+;;            z = from m1 take z
+;;            s = from m1 take s
+;;            d = from m2 take d]
+
+;;       module ints-1
+;;        interface 
+;;         [opaque t 
+;;          z : t 
+;;          s : (t -> t)]
+;;        body
+;;         [type t = int
+;;          z = 3
+;;          s = proc (x : int) -(x, -1)]
+
+;;       module double1
+;;        interface
+;;         [transparent t = from ints-1 take t
+;;          d : (t -> t)]
+;;        body
+;;         [type t = from ints-1 take t
+;;          d = proc (x : t) (from ints-1 take s (from ints-1 take s x))]
+
+;;       module curry1
+;;        interface
+;;         ((m2 : [opaque t
+;;                     d : (t -> t)])
+;;              => [transparent t = from m2 take t
+;;                  z : t
+;;                  s : (t -> t)
+;;                  d : (t -> t)])
+;;        body
+;;         (curried-merge ints-1)
+
+;;       module curry2
+;;        interface
+;;         [opaque t
+;;                  z : t
+;;                  s : (t -> t)
+;;                  d : (t -> t)]
+;;        body
+;;         (curry1 double1)
+
+;;        (from curry2 take d
+;;         from curry2 take z)
+;; "
+;;         (from ints-1 take t) 5)
+
+      
+
+;; Here are some possible tests for named interfaces (Ex. 8.27)
+
+;;       (modules-named-interfaces-1 "
+;;         interface i1 = [u : int v: bool]
+;;         module m1
+;;          interface i1
+;;          body [u = 3 v = zero?(0)]
+;;         import m1
+;;         from m1 take u"
+;;         int)
+
+;;       (modules-named-interfaces-2 "
+;;         interface i1 = [u : int v: bool]
+;;         module m1
+;;          interface i1
+;;          body [u = 3 v = zero?(0)]
+;;         module m2
+;;          interface ((m3 : i1) => [u : int])
+;;          body 
+;;           module-proc (m4 : i1) [u = from m4 take u]
+;;         module builder
+;;          interface [u:int]
+;;          body
+;;          import m1
+;;          import m2
+;;          (m2 m1)
+
+;;         import builder
+;;         from builder take u"
+;;         int)
+
+;;       (modules-named-interfaces-3 "
+;;         interface i1 = [u : int v: bool]
+;;         interface i2 = ((m3 : i1) => [u : int])
+;;         module m1
+;;          interface i1
+;;          body [u = 3 v = zero?(0)]
+;;         module m2
+;;          interface i2
+;;          body 
+;;           module-proc (m4 : i1) [u = from m4 take u]
+;;         module builder
+;;          interface [u:int]
+;;          body
+;;          import m1
+;;          import m2
+;;          (m2 m1)
+
+;;         import builder
+;;         from builder take u"
+;;         int)
+
+    ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  (define tests-for-parse
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        (else
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             #t)
+           (loop (cdr lst)))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+
+  )
+
+  
+  
+    
+
+  
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/full-system/tests-book.scm b/collects/tests/eopl/chapter8/full-system/tests-book.scm
new file mode 100755
index 0000000000..6070db1eb2
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/tests-book.scm
@@ -0,0 +1,596 @@
+(module tests-book mzscheme
+  
+  (provide tests-for-run tests-for-check tests-for-parse)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+
+  (define the-test-suite
+ 
+    '(
+
+      (modules-dans-simplest "
+         module m1
+          interface 
+           [a : int
+            b : int]
+          body
+           [a = 33
+            c = -(a,1)
+            b = -(c,a)]
+
+         let a = 10
+         in -(-(from m1 take a, from m1 take b), 
+              a)"
+        int 24)
+
+
+      (example-8.2 "
+         module m1 
+          interface 
+           [u : bool]
+          body 
+           [u = 33]
+
+         44"
+        error 44)
+
+      (example-8.3 "
+         module m1 
+          interface 
+           [u : int 
+            v : int]
+          body 
+           [u = 33]
+
+         44"
+        error)
+
+      (example-8.4 "
+         module m1 
+          interface 
+           [u : int 
+            v : int] 
+          body 
+           [v = 33 
+            u = 44]
+
+         from m1 take u" 
+        error)
+
+      (example-8.5a "
+         module m1 
+          interface 
+           [u : int] 
+          body 
+           [u = 44]
+
+         module m2 
+          interface
+           [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         -(from m1 take u, from m2 take v)"
+        int)
+
+      (example-8.5b "
+         module m2 
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         module m1 
+          interface [u : int] 
+          body [u = 44]
+
+         -(from m1 take u, from m2 take v)"
+        error)
+
+      (example-8.10"
+       module m1 
+       interface 
+        [transparent t = int 
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 -(0, (from m1 take s 
+                       z))
+      in
+      (foo 
+       from m1 take z)"
+        int -1)
+
+      (example-8.14 "
+         module m1 
+       interface [transparent t = int
+                  z : t]
+       body [type t = int
+                       z = 0]
+      module m2 
+       interface 
+        [foo : (from m1 take t -> int)]
+       body 
+        [foo = proc (x : from m1 take t) x]
+
+      from m2 take foo"
+        (int -> int))
+
+      (example-8.15 "
+         module m1 
+       interface 
+        [opaque t
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 (from m1 take s 
+                  (from m1 take s
+                   z))
+      -(0, (foo 
+            from m1 take z))"
+        error)
+
+      (example-8.15a "
+      module m1 
+       interface 
+        [opaque t
+         z : t
+         s : (t -> t)
+         is-z? : (t -> bool)]
+       body 
+        [type t = int
+         z = 0
+         s = proc (x : t) -(x,-1)
+         is-z? = proc (x : t) zero?(x)]
+
+      let foo = proc (z : from m1 take t) 
+                 (from m1 take s
+                  z)
+      in (foo 
+       from m1 take z)"
+        (from m1 take t))
+
+      (example-8.8 "
+         module colors
+         interface
+          [opaque color
+           red : color
+           green : color
+           is-red? : (color -> bool)
+           switch-colors : (color -> color)]
+         body
+          [type color = int
+           red = 0
+           green = 1
+           is-red? = proc (c : color) zero?(c)
+           switch-colors = proc (c : color) 
+                            if (is-red? c) then green else red]
+
+         44"
+        int)
+
+      (example-8.9 "
+         module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+
+         let zero = from ints-1 take zero
+         in let succ = from ints-1 take succ
+         in (succ (succ zero))"
+        (from ints-1 take t) 10)
+
+      (example-8.10 "
+         module ints-2
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,3)
+                         pred = proc(x : t) -(x,-3)
+                         is-zero = proc (x : t) zero?(x)]
+
+         let z = from ints-2 take zero
+         in let s = from ints-2 take succ
+         in (s (s z))"
+        (from ints-2 take t) -6)
+
+      (example-8.11 "
+         module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+        let z = from ints-1 take zero
+        in let s = from ints-1 take succ
+        in let p = from ints-1 take pred
+        in let z? = from ints-1 take is-zero
+        in letrec int to-int (x : from ints-1 take t) =
+                      if (z? x) then 0
+                         else -((to-int (p x)), -1)
+        in (to-int (s (s z)))"
+        int 2)
+
+      (example-8.12 "
+         module ints-2
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,3)
+                         pred = proc(x : t) -(x,-3)
+                         is-zero = proc (x : t) zero?(x)
+                         ]
+
+         let z = from ints-2 take zero
+         in let s = from ints-2 take succ
+         in let p = from ints-2 take pred
+         in let z? = from ints-2 take is-zero
+         in letrec int to-int (x : from ints-2 take t) =
+                       if (z? x) then 0
+                          else -((to-int (p x)), -1)
+         in (to-int (s (s z)))"
+        int 2)
+
+      (example-8.13 "
+         module mybool 
+          interface [opaque t
+                     true : t
+                     false : t
+                     and : (t -> (t -> t))
+                     not : (t -> t)
+                     to-bool : (t -> bool)]
+          body [type t = int
+                          true = 0
+                          false = 13
+                          and = proc (x : t) 
+                                 proc (y : t)
+                                  if zero?(x) 
+                                   then y 
+                                   else false
+                          not = proc (x : t) 
+                                 if zero?(x) 
+                                  then false 
+                                  else true
+                          to-bool = proc (x : t) zero?(x)] 
+
+         let true = from mybool take true
+         in let false = from mybool take false
+         in let and = from mybool take and
+         in ((and true) false)"
+        (from mybool take t) 13)
+
+;;       (exercise-8.15 "
+;;          module tables
+;;          interface [opaque table
+;;                     empty : table
+;;                     add-to-table : (int -> (int -> (table -> table)))
+;;                     lookup-in-table : (int -> (table -> int))]
+;;          body
+;;           [type table = (int -> int)
+;;            ...  % to be filled in for exercise 8.15
+;;            ]
+
+;;           let empty = from tables take empty
+;;           in let add-binding = from tables take add-to-table
+;;           in let lookup = from tables take lookup-in-table
+;;           in let table1 = (((add-binding 3) 301)
+;;                            (((add-binding 4) 400)
+;;                             (((add-binding 3) 301)
+;;                               empty)))
+;;           in -( ((lookup 4) table1),
+;;                 ((lookup 3) table1))"
+;;         int 99)
+
+      (exercise-8.14 "
+         module mybool 
+         interface [opaque t
+                    true : t
+                    false : t
+                    and : (t -> (t -> t))
+                    not : (t -> t)
+                    to-bool : (t -> bool)]
+         body [type t = int
+                         true = 1
+                         false = 0
+                         and = proc (x : t) 
+                                proc (y : t)
+                                 if zero?(x) 
+                                  then false 
+                                  else y
+                         not = proc (x : t) 
+                                if zero?(x) 
+                                 then true 
+                                 else false
+                         to-bool = proc (x : t) 
+                                    if zero?(x) 
+                                     then zero?(1) 
+                                     else zero?(0)]
+          44"
+        int 44)
+
+      (alice-bob-and-charlie "
+  module Alices-point-builder
+   interface
+    ((database : [opaque db-type
+                  opaque node-type
+                  insert-node : (node-type -> (db-type -> db-type))
+                  ])
+     => [opaque point
+         initial-point : (int -> point)])
+
+   body
+    module-proc
+     (database : [opaque db-type
+                  opaque node-type
+                  insert-node : (node-type -> (db-type -> db-type))])
+
+     [type point = int
+      initial-point = proc (x : int) x]
+
+  module Bobs-db-module
+   interface 
+    [opaque db-type
+     opaque node-type
+     insert-node : (node-type -> (db-type -> db-type))]
+   body
+    [type db-type = int
+     type node-type = bool
+     insert-node = proc (n : node-type) proc (d : db-type) d]
+
+  module Alices-points
+   interface
+    [opaque point
+     initial-point : (int -> point)]
+   body
+    (Alices-point-builder Bobs-db-module)
+
+  module Davids-db-module
+   interface 
+    [opaque db-type
+     opaque node-type
+     insert-node : (node-type -> (db-type -> db-type))]
+   body
+   [type db-type = bool
+     type node-type = int
+     insert-node = proc (n : node-type) proc (d : db-type) d]
+
+  module Charlies-points
+   interface
+     [opaque point
+     initial-point : (int -> point)]
+   body
+    (Alices-point-builder Davids-db-module)
+
+  44"
+        int 44)
+
+      (example-8.15 "
+        module to-int-maker 
+         interface
+          ((m1 : [opaque t
+                  zero : t
+                  succ : (t -> t)
+                  pred : (t -> t)
+                  is-zero : (t -> bool)]) 
+            => [to-int : (from m1 take t -> int)])
+         body 
+          module-proc 
+           (m1 : [opaque t
+                  zero : t
+                  succ : (t -> t)
+                  pred : (t -> t)
+                  is-zero : (t -> bool)])
+           [to-int 
+             = let z? = from m1 take is-zero
+               in let p = from m1 take pred
+               in letrec int to-int (x : from m1 take t) 
+                 = if (z? x) 
+                   then 0
+                   else -((to-int (p x)), -1)
+               in to-int]
+
+        module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+        
+        module ints-1-to-int
+         interface [to-int : (from ints-1 take t -> int)]
+         body  
+          (to-int-maker ints-1)
+
+        let two1 = (from ints-1 take succ
+                    (from ints-1 take succ
+                     from ints-1 take zero))
+        in (from ints-1-to-int take to-int
+            two1)"
+        int 2)
+
+        
+      (example-8.16 "
+        module to-int-maker 
+         interface
+          ((m1 : [opaque t
+                  zero : t
+                  succ : (t -> t)
+                  pred : (t -> t)
+                  is-zero : (t -> bool)]) 
+            => [to-int : (from m1 take t -> int)])
+         body 
+          module-proc 
+           (m1 : [opaque t
+                  zero : t
+                  succ : (t -> t)
+                  pred : (t -> t)
+                  is-zero : (t -> bool)])
+           [to-int 
+             = let z? = from m1 take is-zero
+               in let p = from m1 take pred
+               in letrec int to-int (x : from m1 take t) 
+                 = if (z? x) 
+                   then 0
+                   else -((to-int (p x)), -1)
+               in to-int]
+
+        module ints-1
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,-5)
+                         pred = proc(x : t) -(x,5)
+                         is-zero = proc (x : t) zero?(x)]
+
+
+         module ints-2
+         interface [opaque t
+                    zero : t
+                    succ : (t -> t)
+                    pred : (t -> t)
+                    is-zero : (t -> bool)]  
+         body [type t = int
+                         zero = 0
+                         succ = proc(x : t) -(x,3)
+                         pred = proc(x : t) -(x,-3)
+                         is-zero = proc (x : t) zero?(x)
+                         ]
+
+        module ints-1-to-int
+         interface [to-int : (from ints-1 take t -> int)]
+         body 
+          (to-int-maker ints-1)
+
+        module ints-2-to-int
+         interface [to-int : (from ints-2 take t -> int)]
+         body 
+          (to-int-maker ints-2)
+
+
+        let s1 = from ints-1 take succ
+        in let z1 = from ints-1 take zero
+        in let to-ints-1 = from ints-1-to-int take to-int
+
+        in let s2 = from ints-2 take succ
+        in let z2 = from ints-2 take zero
+        in let to-ints-2 = from ints-2-to-int take to-int
+
+        in let two1 = (s1 (s1 z1))
+        in let two2 = (s2 (s2 z2))
+        in -((to-ints-1 two1), (to-ints-2 two2))"
+        int 0)
+ 
+;;      (exercise-8.19 "
+;;          module sum-prod-maker 
+;;          interface 
+;;           ((m1 : [opaque t
+;;                   zero : t
+;;                   succ : (t -> t)
+;;                   pred : (t -> t)
+;;                   is-zero : (t -> bool)])
+;;            => [plus : (from m1 take t 
+;;                        -> (from m1 take t 
+;;                            -> from m1 take t))
+;;                times : (from m1 take t 
+;;                         -> (from m1 take t 
+;;                             -> from m1 take t))])
+;;          body
+;;           ...  % to be filled in for exer. 8.19
+ 
+;;          44"
+;;        int 44)
+
+;;      (exercise-8.22 "
+;;          module equality-maker 
+;;          interface 
+;;           ((m1 : [opaque t
+;;                   zero : t
+;;                   succ : (t -> t)
+;;                   pred : (t -> t)
+;;                   is-zero : (t -> bool)])
+;;            => [equal : (from m1 take t 
+;;                        -> (from m1 take t 
+;;                            -> bool))])
+;;          body
+;;           ...            
+;;          33"
+;;        int 33)
+
+;;      (exercise-8.19 "
+;;          module from-int-maker 
+;;          interface 
+;;           ((m1 : [opaque t
+;;                   zero : t
+;;                   succ : (t -> t)
+;;                   pred : (t -> t)
+;;                   is-zero : (t -> bool)])
+;;             => [from-int : (int -> from m1 take t)])
+;;          body
+;;           ...
+;;          33"
+;;        int 33)
+ 
+      ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+  (define tests-for-parse the-test-suite)
+
+  )
+
diff --git a/collects/tests/eopl/chapter8/full-system/top.scm b/collects/tests/eopl/chapter8/full-system/top.scm
new file mode 100755
index 0000000000..4c0dace105
--- /dev/null
+++ b/collects/tests/eopl/chapter8/full-system/top.scm
@@ -0,0 +1,129 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Parse all the tests with (parse-all)
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "check-modules.scm")         ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+
+  ;; choose one of the following test suites
+
+  (require "test-suite.scm")        ; ordinary test suite        
+  ;; (require "tests-book.scm")     ; examples from book/lecture notes     
+
+  (provide run run-all check check-all parse-all)
+
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : string -> external-type
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal? tests-for-check)))
+
+  ;; check-one : symbol -> expval
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+ 
+  ;; (check-all)
+
+  ;;;;;;;;;;;;;;;; parsing ;;;;;;;;;;;;;;;;
+  
+  ;; writing syntactically correct programs in this language can take
+  ;; some effort, so we've added a test that just parses the items in
+  ;; the test list.  This requires a slightly different structure.
+
+  ;; test-item ::= (test-name program correct-ans)
+  ;; test-list is a list of test-items.
+
+  (define parse-all
+    (lambda ()
+      (for-each
+        (lambda (test-item)
+          (let ((test-name (list-ref test-item 0))
+                (pgm       (list-ref test-item 1)))
+            (eopl:printf "~s... " test-name)               
+            (let ((outcome
+                    (apply-safely scan&parse (list pgm))))
+              (if (car outcome)
+                (eopl:printf "passed ~%")
+                (begin
+                  (eopl:printf "failed ~%")
+                  (if (stop-after-first-error)
+                    (eopl:error test-name
+                      "incorrect outcome detected"))))))) 
+        tests-for-parse)))
+
+  ;; (parse-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter8/simplemodules/check-modules.scm b/collects/tests/eopl/chapter8/simplemodules/check-modules.scm
new file mode 100755
index 0000000000..c24d4cef3c
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/check-modules.scm
@@ -0,0 +1,78 @@
+(module check-modules (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "checker.scm")
+  (require "subtyping.scm")
+
+  (provide type-of-program)
+ 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ 
+  ;; type-of-program : Program -> Type
+  ;; Page: 286
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (type-of body
+            (add-module-defns-to-tenv module-defs (empty-tenv)))))))
+
+  ;; add-module-defns-to-tenv : Listof(ModuleDefn) * Tenv -> Tenv
+  ;; Page: 286
+  (define add-module-defns-to-tenv
+    (lambda (defns tenv)
+      (if (null? defns)
+        tenv
+        (cases module-definition (car defns)
+          (a-module-definition (m-name expected-iface m-body)
+            (let ((actual-iface (interface-of m-body tenv)))
+              (if (<:-iface actual-iface expected-iface tenv)
+                (let ((new-tenv
+                        (extend-tenv-with-module
+                          m-name
+                          expected-iface
+                          tenv)))
+                  (add-module-defns-to-tenv
+                    (cdr defns) new-tenv))
+                (report-module-doesnt-satisfy-iface
+                  m-name expected-iface actual-iface))))))))
+
+  ;; interface-of : ModuleBody * Tenv -> Iface
+  ;; Page: 288
+  (define interface-of
+    (lambda (m-body tenv)
+      (cases module-body m-body
+        (defns-module-body (defns)
+          (simple-iface
+            (defns-to-decls defns tenv))) )))
+
+  ;; defns-to-decls : Listof(Defn) * Tenv -> Listof(Decl)
+  ;; Page: 288
+  ;; 
+  ;; Convert defns to a set of declarations for just the names defined
+  ;; in defns.  Do this in the context of tenv.  The tenv is extended
+  ;; at every step, so we get the correct let* scoping
+  ;;
+  (define defns-to-decls
+    (lambda (defns tenv)
+      (if (null? defns)
+        '()
+        (cases definition (car defns)
+          (val-defn (var-name exp)
+            (let ((ty (type-of exp tenv)))
+              (let ((new-env (extend-tenv var-name ty tenv)))
+                (cons
+                  (val-decl var-name ty)
+                  (defns-to-decls (cdr defns) new-env)))))))))
+
+  (define report-module-doesnt-satisfy-iface
+    (lambda (m-name expected-type actual-type)
+      (pretty-print 
+        (list 'error-in-defn-of-module: m-name
+          'expected-type: expected-type
+          'actual-type: actual-type))
+      (eopl:error 'type-of-module-defn)))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/checker.scm b/collects/tests/eopl/chapter8/simplemodules/checker.scm
new file mode 100755
index 0000000000..b298bbdc72
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/checker.scm
@@ -0,0 +1,126 @@
+(module checker (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+  (require "expand-type.scm")
+
+  (provide type-of)
+
+  ;; check-equal-type! : Type * Type * Exp -> Unspecified
+  ;; Page: 242
+  (define check-equal-type!
+    (lambda (ty1 ty2 exp)
+      (if (not (equal? ty1 ty2))
+        (report-unequal-types ty1 ty2 exp))))
+
+  ;; report-unequal-types : Type * Type * Exp -> Unspecified
+  ;; Page: 243
+  (define report-unequal-types
+    (lambda (ty1 ty2 exp)
+      (eopl:error 'check-equal-type!  
+          "Types didn't match: ~s != ~a in~%~a"
+          (type-to-external-form ty1)
+          (type-to-external-form ty2)
+          exp)))
+
+  ;;;;;;;;;;;;;;;; The Type Checker ;;;;;;;;;;;;;;;;
+  
+  ;; moved to check-modules.scm
+  ;; type-of-program : Program -> Type
+  ;; Page: 244 
+  ;;   (define type-of-program
+  ;;     (lambda (pgm)
+  ;;       (cases program pgm
+  ;;         (a-program (exp1) 
+  ;;           (type-of exp1 (init-tenv))))))
+
+
+  ;; type-of : Exp * Tenv -> Type
+  ;; Page 244--246.  See also page 285.
+  (define type-of
+    (lambda (exp tenv)
+      (cases expression exp
+        (const-exp (num) (int-type))
+        
+        (diff-exp (exp1 exp2)
+          (let ((type1 (type-of exp1 tenv))
+                (type2 (type-of exp2 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (check-equal-type! type2 (int-type) exp2)
+            (int-type)))
+        
+        (zero?-exp (exp1)
+          (let ((type1 (type-of exp1 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (bool-type)))
+        
+        (if-exp (exp1 exp2 exp3)
+          (let ((ty1 (type-of exp1 tenv))
+                (ty2 (type-of exp2 tenv))
+                (ty3 (type-of exp3 tenv)))
+            (check-equal-type! ty1 (bool-type) exp1)
+            (check-equal-type! ty2 ty3 exp)
+            ty2))
+        
+        (var-exp (var) (apply-tenv tenv var))
+
+        ;; lookup-qualified-var-in-tenv defined on page 285.
+        (qualified-var-exp (m-name var-name) 
+          (lookup-qualified-var-in-tenv m-name var-name tenv))
+
+        (let-exp (var exp1 body)
+          (let ((rhs-type (type-of exp1 tenv)))
+            (type-of body (extend-tenv var rhs-type tenv))))
+        
+        (proc-exp (bvar bvar-type body)
+          (let ((expanded-bvar-type
+                  (expand-type bvar-type tenv)))
+            (let ((result-type
+                    (type-of body
+                      (extend-tenv
+                        bvar
+                        expanded-bvar-type
+                        tenv))))
+              (proc-type expanded-bvar-type result-type))))
+        
+        (call-exp (rator rand) 
+          (let ((rator-type (type-of rator tenv))
+                (rand-type  (type-of rand tenv)))
+            (cases type rator-type
+              (proc-type (arg-type result-type)
+                (begin
+                  (check-equal-type! arg-type rand-type rand)
+                  result-type))
+              (else
+                (eopl:error 'type-of
+                  "Rator not a proc type:~%~s~%had rator type ~s"   
+                  rator (type-to-external-form rator-type))))))
+        
+        (letrec-exp (proc-result-type proc-name 
+                      bvar bvar-type 
+                      proc-body
+                      letrec-body)
+          (let ((tenv-for-letrec-body
+                  (extend-tenv 
+                    proc-name
+                    (expand-type
+                      (proc-type bvar-type proc-result-type)
+                      tenv)
+                    tenv)))
+            (let ((proc-result-type
+                    (expand-type proc-result-type tenv))
+                  (proc-body-type
+                    (type-of proc-body
+                      (extend-tenv
+                        bvar
+                        (expand-type bvar-type tenv)
+                        tenv-for-letrec-body))))
+              (check-equal-type!
+                proc-body-type proc-result-type proc-body)
+              (type-of letrec-body tenv-for-letrec-body))))
+        
+        )))
+    
+  ;; type environments are now in static-data-structures.scm .
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/data-structures.scm b/collects/tests/eopl/chapter8/simplemodules/data-structures.scm
new file mode 100755
index 0000000000..7c21fbf30a
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/data-structures.scm
@@ -0,0 +1,84 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean or a procval.
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?)))
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+  ;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (bvar symbol?)
+      (body expression?)
+      (env environment?)))
+  
+  ;;;;;;;;;;;;;;;; module values ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282, 319
+  (define-datatype typed-module typed-module?
+    (simple-module
+      (bindings environment?))
+    (proc-module
+      (bvar symbol?)
+      (body module-body?)
+      (saved-env environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; environments ;;;;;;;;;;;;;;;;
+
+  ;; Page: 282
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvar symbol?)
+      (bval expval?)
+      (saved-env environment?))
+    (extend-env-recursively
+      (id symbol?)
+      (bvar symbol?)
+      (body expression?)
+      (saved-env environment?))
+    (extend-env-with-module
+      (m-name symbol?)
+      (m-val typed-module?)
+      (saved-env environment?)   
+      ))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/drscheme-init.scm b/collects/tests/eopl/chapter8/simplemodules/drscheme-init.scm
new file mode 100755
index 0000000000..41bf963c75
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/drscheme-init.scm
@@ -0,0 +1,130 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   apply-safely
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter8/simplemodules/environments.scm b/collects/tests/eopl/chapter8/simplemodules/environments.scm
new file mode 100755
index 0000000000..3734e7eed5
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/environments.scm
@@ -0,0 +1,85 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")
+  (require "lang.scm")
+
+  (provide empty-env extend-env apply-env)
+  (provide lookup-module-name-in-env)
+  (provide lookup-qualified-var-in-env)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; initial-value-env : module-env -> environment
+
+  ;; (init-env m-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10, and in which m-env is the module
+  ;; environment.
+
+  (define inital-value-env 
+    (lambda (m-env)
+      (extend-env 
+        'i (num-val 1)
+        (extend-env
+          'v (num-val 5)
+          (extend-env
+            'x (num-val 10)
+            (empty-env m-env))))))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  ;; for variables bound by extend-env or extend-env-recursively
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No value binding for ~s" search-sym))
+        (extend-env (bvar bval saved-env)
+	  (if (eqv? search-sym bvar)
+	    bval
+	    (apply-env saved-env search-sym)))
+        (extend-env-recursively
+          (id bvar body saved-env)
+          (if (eqv? search-sym id)
+            (proc-val (procedure bvar body env))          
+            (apply-env saved-env search-sym)))
+        (extend-env-with-module
+            (m-name m-val saved-env)
+          (apply-env saved-env search-sym)) )))
+                
+  ;; for names bound by extend-env-with-module
+
+  ;; lookup-module-name-in-env : Sym * Env -> Typed-Module
+  (define lookup-module-name-in-env
+    (lambda (m-name env)            
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'lookup-module-name-in-env
+            "No module binding for ~s" m-name))
+        (extend-env (bvar bval saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-recursively  (id bvar body saved-env)
+          (lookup-module-name-in-env m-name saved-env))
+        (extend-env-with-module
+          (m-name1 m-val saved-env)
+	  (if (eqv? m-name1 m-name)
+            m-val
+	    (lookup-module-name-in-env m-name saved-env))))))
+
+  ;; lookup-qualified-var-in-env : Sym * Sym * Env -> ExpVal
+  ;; Page: 283
+  (define lookup-qualified-var-in-env
+    (lambda (m-name var-name env)
+      (let ((m-val (lookup-module-name-in-env m-name env)))
+        ; (pretty-print m-val)
+        (cases typed-module m-val
+          (simple-module (bindings)
+            (apply-env bindings var-name))
+          (proc-module (bvar body saved-env)
+            (eopl:error 'lookup-qualified-var
+              "can't retrieve variable from ~s take ~s from proc module"
+              m-name var-name))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/expand-type.scm b/collects/tests/eopl/chapter8/simplemodules/expand-type.scm
new file mode 100755
index 0000000000..8682cad539
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/expand-type.scm
@@ -0,0 +1,17 @@
+(module expand-type (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+
+  (provide expand-type)
+  (provide expand-iface)
+
+;;;;;;;;;;;;;;;; expand-type ;;;;;;;;;;;;;;;;
+
+  ;; these are stubs.  They will be replaced by something more
+  ;; interesting in abstract-types-lang.
+
+  (define expand-type (lambda (ty tenv) ty))
+  (define expand-iface (lambda (m-name iface tenv) iface))
+
+  )
diff --git a/collects/tests/eopl/chapter8/simplemodules/interp.scm b/collects/tests/eopl/chapter8/simplemodules/interp.scm
new file mode 100755
index 0000000000..46332050e4
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/interp.scm
@@ -0,0 +1,141 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+
+  (provide value-of-program value-of)
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> Expval
+  ;; Page: 284
+  (define value-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (module-defs body)
+          (let ((env 
+                  (add-module-defns-to-env module-defs (empty-env))))
+            ;; (eopl:pretty-print env)
+            (value-of body env))))))
+
+  ;; add-module-defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 284
+  (define add-module-defns-to-env
+    (lambda (defs env)
+      (if (null? defs)
+        env
+        (cases module-definition (car defs)
+          (a-module-definition (m-name iface m-body)
+            (add-module-defns-to-env
+              (cdr defs)
+              (extend-env-with-module
+                m-name 
+                (value-of-module-body m-body env)
+                env)))))))
+
+  ;; We will have let* scoping inside a module body.
+  ;; We put all the values in the environment, not just the ones
+  ;; that are in the interface.  But the typechecker will prevent
+  ;; anybody from using the extras.
+
+  ;; value-of-module-body : ModuleBody * Env -> TypedModule
+  ;; Page: 285
+  (define value-of-module-body
+    (lambda (m-body env)    
+      (cases module-body m-body
+        (defns-module-body (defns)
+          (simple-module
+            (defns-to-env defns env))) )))
+
+
+  (define raise-cant-apply-non-proc-module!
+    (lambda (rator-val)
+      (eopl:error 'value-of-module-body 
+        "can't apply non-proc-module-value ~s" rator-val)))
+
+  ;; defns-to-env : Listof(Defn) * Env -> Env
+  ;; Page: 285
+  (define defns-to-env
+    (lambda (defns env)
+      (if (null? defns)
+        (empty-env)                ; we're making a little environment
+        (cases definition (car defns)
+          (val-defn (var exp)
+            (let ((val (value-of exp env)))
+              ;; new environment for subsequent definitions
+              (let ((new-env (extend-env var val env)))
+                (extend-env var val
+                  (defns-to-env
+                    (cdr defns) new-env)))))
+          ))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  (define value-of
+    (lambda (exp env)
+
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (apply-env env var))
+
+        (qualified-var-exp (m-name var-name)
+          (lookup-qualified-var-in-env m-name var-name env))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (var exp1 body)       
+          (let ((val (value-of exp1 env)))
+            (let ((new-env (extend-env var val env)))
+              ;; (eopl:pretty-print new-env)
+              (value-of body new-env))))
+
+        (proc-exp (bvar ty body)
+	  (proc-val
+	    (procedure bvar body env)))
+
+        (call-exp (rator rand)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (arg  (value-of rand env)))
+	    (apply-procedure proc arg)))
+
+        (letrec-exp (ty1 proc-name bvar ty2 proc-body letrec-body)
+          (value-of letrec-body
+            (extend-env-recursively proc-name bvar proc-body env)))
+
+        )))
+
+  ;; apply-procedure : Proc * ExpVal -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 arg)
+      (cases proc proc1
+        (procedure (var body saved-env)
+          (value-of body (extend-env var arg saved-env))))))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter8/simplemodules/lang.scm b/collects/tests/eopl/chapter8/simplemodules/lang.scm
new file mode 100755
index 0000000000..557686d7aa
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/lang.scm
@@ -0,0 +1,243 @@
+(module lang (lib "eopl.ss" "eopl")                
+  
+  ;; grammar for simple modules
+  ;; based on CHECKED.
+
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+
+  (define the-grammar
+
+    '(
+      
+      (program
+        ((arbno module-definition)
+         expression)
+        a-program)
+
+      (module-definition
+        ("module" identifier 
+          "interface" interface
+          "body" module-body)
+        a-module-definition)
+
+
+      (interface
+        ("[" (arbno declaration) "]") 
+        simple-iface)
+
+ 
+      (declaration    
+        (identifier ":" type)
+        val-decl)
+
+
+      (module-body
+        ("[" (arbno definition) "]")
+        defns-module-body)
+
+
+      (definition
+        (identifier "=" expression)
+        val-defn)
+
+
+      ;; new expression:
+
+      (expression
+        ("from" identifier "take" identifier)
+        qualified-var-exp)
+
+      ;; new types
+
+      (type
+        (identifier)
+        named-type)                
+
+      (type
+        ("from" identifier "take" identifier)
+        qualified-type)
+
+ 
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;; no changes in grammar below here
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+      (expression (number) const-exp)
+
+      (expression
+        (identifier)
+        var-exp)
+
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression
+        ("let" identifier "=" expression "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "(" identifier ":" type ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression expression ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          type identifier "(" identifier ":" type ")"
+          "=" expression "in" expression)
+        letrec-exp)
+
+      (type
+        ("int")
+        int-type)
+      
+      (type
+        ("bool")
+        bool-type)
+      
+      (type
+        ("(" type "->" type ")")
+        proc-type)
+
+      ))
+  
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+
+  ;;;;;;;;;;;;;;;; syntactic tests and observers ;;;;;;;;;;;;;;;;
+
+  ;;;; for types
+
+  (define atomic-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (ty1 ty2) #f)
+        (else #t))))
+
+  (define proc-type?
+    (lambda (ty)
+      (cases type ty
+        (proc-type (t1 t2) #t)
+        (else #f))))
+
+  (define proc-type->arg-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) arg-type)
+        (else (eopl:error 'proc-type->arg-type
+                "Not a proc type: ~s" ty)))))
+
+  (define proc-type->result-type
+    (lambda (ty)
+      (cases type ty
+        (proc-type (arg-type result-type) result-type)
+        (else (eopl:error 'proc-type->result-types
+                "Not a proc type: ~s" ty)))))
+
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (proc-type (arg-type result-type)
+          (list
+            (type-to-external-form arg-type)
+            '->
+            (type-to-external-form result-type)))
+       (named-type (name) name)
+        (qualified-type (modname varname)
+          (list 'from modname 'take varname))
+        )))
+  
+
+  ;;;; for module definitions
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Maybe(Defn)
+  (define maybe-lookup-module-in-list
+    (lambda (name module-defs)
+      (if (null? module-defs)
+        #f
+        (let ((name1 (module-definition->name (car module-defs))))
+          (if (eqv? name1 name)
+            (car module-defs)
+            (maybe-lookup-module-in-list name (cdr module-defs)))))))
+
+  ;; maybe-lookup-module-in-list : Sym * Listof(Defn) -> Defn OR Error
+  (define lookup-module-in-list
+    (lambda (name module-defs)
+      (cond
+        ((maybe-lookup-module-in-list name module-defs)
+         => (lambda (mdef) mdef))
+        (else 
+          (eopl:error 'lookup-module-in-list
+            "unknown module ~s"
+            name)))))
+
+  (define module-definition->name
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-name))))
+
+ (define module-definition->interface
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-type))))
+
+  (define module-definition->body
+    (lambda (m-defn)
+      (cases module-definition m-defn
+        (a-module-definition (m-name m-type m-body)
+          m-body))))
+
+ (define val-decl?
+   (lambda (decl)
+     (cases declaration decl
+       (val-decl (name ty) #t))))
+
+ (define decl->name
+   (lambda (decl)
+     (cases declaration decl
+       (val-decl (name ty) name))))
+
+ (define decl->type
+   (lambda (decl)
+     (cases declaration decl
+       (val-decl (name ty) ty))))
+     
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/static-data-structures.scm b/collects/tests/eopl/chapter8/simplemodules/static-data-structures.scm
new file mode 100755
index 0000000000..771aa2bd14
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/static-data-structures.scm
@@ -0,0 +1,111 @@
+(module static-data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?, type?, etc.
+
+  (provide (all-defined))               ; too many things to list
+
+  (define-datatype type-environment type-environment?
+    (empty-tenv)
+    (extend-tenv 
+      (bvar symbol?)
+      (bval type?)
+      (saved-tenv type-environment?))
+    (extend-tenv-with-module
+      (name symbol?)
+      (interface interface?)
+      (saved-tenv type-environment?))
+    )
+
+  ;;;;;;;;;;;;;;;; procedures for looking things up tenvs ;;;;;;;;;;;;;;;;
+
+  ;;;;;;;;;;;;;;;; lookup or die
+
+  ;; lookup-qualified-var-in-tenv : Sym * Sym * Tenv -> Type
+  ;; Page: 285
+  (define lookup-qualified-var-in-tenv
+    (lambda (m-name var-name tenv)
+      (let ((iface (lookup-module-name-in-tenv tenv m-name)))
+        (cases interface iface
+          (simple-iface (decls)
+            (lookup-variable-name-in-decls var-name decls)) ))))
+
+  (define lookup-variable-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (variable-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'variable search-sym tenv)))))
+
+  (define lookup-module-name-in-tenv
+    (lambda (tenv search-sym)
+      (let ((maybe-answer
+              (module-name->maybe-binding-in-tenv tenv search-sym)))
+        (if maybe-answer maybe-answer
+          (raise-tenv-lookup-failure-error 'module search-sym tenv)))))
+
+  (define apply-tenv lookup-variable-name-in-tenv)
+
+  (define raise-tenv-lookup-failure-error
+    (lambda (kind var tenv)
+      (eopl:pretty-print
+        (list 'tenv-lookup-failure: (list 'missing: kind var) 'in:
+          tenv))
+      (eopl:error 'lookup-variable-name-in-tenv)))
+
+  (define lookup-variable-name-in-decls
+    (lambda (var-name decls0)
+      (let loop ((decls decls0))
+        (cond
+          ((null? decls)
+           (raise-lookup-variable-in-decls-error! var-name decls0))
+          ((eqv? var-name (decl->name (car decls)))
+           (decl->type (car decls)))
+          (else (loop (cdr decls)))))))
+
+  (define raise-lookup-variable-in-decls-error!
+    (lambda (var-name decls)
+      (eopl:pretty-print
+        (list 'lookup-variable-decls-failure:
+          (list 'missing-variable var-name)
+          'in:
+          decls))))
+
+  ;;;;;;;;;;;;;;;; lookup or return #f.
+
+  ;; variable-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Type)
+  (define variable-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv (name ty saved-tenv)
+            (if (eqv? name search-sym) 
+              ty
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; module-name->maybe-binding-in-tenv : Tenv * Sym -> Maybe(Iface)
+  (define module-name->maybe-binding-in-tenv
+    (lambda (tenv search-sym)
+      (let recur ((tenv tenv)) 
+         (cases type-environment tenv
+          (empty-tenv () #f)
+          (extend-tenv-with-module (name m-type saved-tenv)
+            (if (eqv? name search-sym) 
+              m-type
+              (recur saved-tenv)))
+          (else (recur (tenv->saved-tenv tenv)))))))
+
+  ;; assumes tenv is non-empty.  
+  (define tenv->saved-tenv
+    (lambda (tenv)
+      (cases type-environment tenv
+        (empty-tenv () 
+          (eopl:error 'tenv->saved-tenv
+            "tenv->saved-tenv called on empty tenv"))
+        (extend-tenv (name ty saved-tenv) saved-tenv)
+        (extend-tenv-with-module (name m-type saved-tenv) saved-tenv)
+        )))
+
+  )
+                    
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/subtyping.scm b/collects/tests/eopl/chapter8/simplemodules/subtyping.scm
new file mode 100755
index 0000000000..70d17a9730
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/subtyping.scm
@@ -0,0 +1,42 @@
+(module subtyping (lib "eopl.ss" "eopl")
+  
+  (require "lang.scm")
+
+  (provide <:-iface)
+
+  ;; <:-iface : Iface * Iface * Tenv -> Bool
+  ;; Page: 289
+  (define <:-iface
+    (lambda (iface1 iface2 tenv)
+      (cases interface iface1
+        (simple-iface (decls1)
+          (cases interface iface2
+            (simple-iface (decls2)
+              (<:-decls decls1 decls2 tenv)))))))
+
+  ;; <:-decls : Listof(Decl) * Listof(Decl) * Tenv -> Bool
+  ;; Page: 289
+  ;;
+  ;; s1 <: s2 iff s1 has at least as much stuff as s2, and in the same
+  ;; order.  We walk down s1 until we find a declaration that declares
+  ;; the same name as the first component of s2.  If we run off the
+  ;; end of s1, then we fail.  As we walk down s1, we record any type
+  ;; bindings in the tenv
+  ;;
+  (define <:-decls
+    (lambda (decls1 decls2 tenv)
+      (cond
+        ((null? decls2) #t)
+        ((null? decls1) #f)
+        (else
+          (let ((name1 (decl->name (car decls1)))
+                (name2 (decl->name (car decls2))))
+            (if (eqv? name1 name2)
+              (and
+                (equal?
+                  (decl->type (car decls1))
+                  (decl->type (car decls2)))
+                (<:-decls (cdr decls1) (cdr decls2) tenv))
+              (<:-decls (cdr decls1) decls2 tenv)))))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/test-suite.scm b/collects/tests/eopl/chapter8/simplemodules/test-suite.scm
new file mode 100755
index 0000000000..4d9fa189e0
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/test-suite.scm
@@ -0,0 +1,342 @@
+(module test-suite mzscheme
+
+  (provide tests-for-run tests-for-check tests-for-parse)
+
+  (define the-test-suite
+    '(
+      ;; tests from run-tests:
+  
+;;       ;; simple arithmetic
+;;       (positive-const "11" int 11)
+;;       (negative-const "-33" int -33)
+;;       (simple-arith-1 "-(44,33)" int 11)
+  
+;;       ;; nested arithmetic
+;;       (nested-arith-left "-(-(44,33),22)" int -11)
+;;       (nested-arith-right "-(55, -(22,11))" int 44)
+  
+;;       ;; simple variables
+;;       (test-var-1 "x" error)
+;;       (test-var-2 "-(x,1)" error)
+;;       (test-var-3 "-(1,x)" error)
+
+;;       (zero-test-1 "zero?(-(3,2))" bool #f)
+;;       (zero-test-2 "-(2,zero?(0))" error)
+      
+;;       ;; simple unbound variables
+;;       (test-unbound-var-1 "foo" error)
+;;       (test-unbound-var-2 "-(x,foo)" error)
+  
+;;       ;; simple conditionals
+;;       (if-true "if zero?(0) then 3 else 4" int 3)
+;;       (if-false "if zero?(1) then 3 else 4" int 4)
+
+;;       ;; make sure that the test and both arms get evaluated
+;;       ;; properly. 
+;;       (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" int 3)
+;;       (if-eval-test-false "if zero?(-(11,12)) then 3 else 4" int 4)
+;;       (if-eval-then "if zero?(0) then -(22,1) else -(22,2)" int 21)
+;;       (if-eval-else "if zero?(1) then -(22,1) else -(22,2)" int 20)
+      
+;;       ;; make sure types of arms agree (new for lang5-1)
+      
+;;       (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+;;       (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+;;       ;; simple let
+;;       (simple-let-1 "let x = 3 in x" int 3)
+
+;;       ;; make sure the body and rhs get evaluated
+;;       (eval-let-body "let x = 3 in -(x,1)" int 2)
+;;       (eval-let-rhs "let x = -(4,1) in -(x,1)" int 2)
+
+;;       ;; check nested let and shadowing
+;;       (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int -1)
+;;       (check-shadowing-in-body "let x = 3 in let x = 4 in x" int 4)
+;;       (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int 29)
+      (checker-doesnt-ignore-type-info-in-proc-but-interp-does 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error 29) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int 29)
+      (let-to-proc-1
+        "(proc( f : (int -> int))(f 30)  proc(x : int)-(x,1))" int 29)
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int -1)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int 2)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int 32)
+      (simple-letrec-2
+        "letrec int double(x : int) = if zero?(x) then 0 else -((double -(x,1)), -2) in (double 4)"
+        int 8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        int 20)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int 6)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int 3) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc ( f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool)))
+        )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc ( f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int 1)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int 3)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int 39)
+
+      (letrec-non-shadowing
+        "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int 1)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-the-fcn "
+let f = proc (x : int) proc (y : int) -(x,y)   
+in letrec 
+     int loop(x : int) = if zero?(x) then 1 else ((f x) (loop -(x,1)))
+   in (loop 4)"
+        int 3)
+
+       (modules-declare-and-ignore "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+33"
+        int 33)
+
+       (modules-take-one-value "
+module m
+ interface 
+  [u : int]
+ body 
+  [u = 3]
+
+from m take u"
+        int 3)
+
+       (modules-take-one-value-no-import
+        "module m 
+          interface 
+           [u : int] 
+          body 
+           [u = 3]
+         from m take u"
+        int 3)
+
+       (modules-take-from-parameterized-module "
+module m
+ interface 
+  ((m1 : []) => [u : int])
+ body 
+  module-proc (m1 : []) [u = 3]
+
+from m take u
+"
+        error error)
+
+       (modules-check-iface-subtyping-1 "
+module m 
+ interface 
+  [u : int]
+ body 
+  [u = 3 v = 4]
+from m take u"
+        int 3)
+
+
+       ;; if the interpreter always called the typechecker, or put
+       ;; only declared variables in the module, this would raise an
+       ;; error.  Exercise: make this modification.
+
+       (modules-take-one-value-but-interface-bad "
+         module m interface []  body [u = 3]
+         from m take u"
+; this version for permissive interp
+        error 3
+; this version for strict interp
+;         error error
+        )
+
+       (modules-take-bad-value
+        "module m interface []  body [u = 3]
+         from m take x"
+        error error)       
+
+        (modules-two-vals "
+module m
+ interface 
+  [u : int 
+   v : int] 
+ body
+  [u = 44
+   v = 33]
+
+  -(from m take u, from m take v)"
+        int 11)
+
+
+        (modules-two-vals-bad-interface-1
+        "module m interface [u : int v : bool]  
+                  body [u = 44 v = 33]
+         -(from m take u, from m take v)"
+        error 11)
+
+        (modules-extra-vals-are-ok-1 "
+          module m interface [x : int] body [x = 3 y = 4]
+          from m take x"
+          int 3)
+
+        (module-extra-vals-are-ok-2 "
+          module m interface [y : int] body [x = 3 y = 4]
+          from m take y"
+          int)
+
+       (modules-two-vals-bad-interface-14
+        "module m interface 
+            [v : int 
+             u : bool]
+          body 
+           [v = zero?(0) u = 33]
+         -(from m take u, from m take v)"
+        error)
+
+
+        (modules-check-let*-1
+        "module m interface      [u : int v : int]
+                  body [u = 44  v = -(u,11)]
+         -(from m take u, from m take v)"
+        int 11)
+
+      (modules-check-let*-2.0
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+      (modules-check-let*-2.05
+        "module m1 interface [u : int] body [u = 44]
+         module m2 interface [v : int] body [v = -(from m1 take u,11)]
+         33"
+        int 33)                       ; doesn't actually import anything
+
+      (modules-check-let*-2.1
+        "module m1 interface [u : int] body [u = 44]
+         module m2   
+          interface [v : int] 
+          body [v = -(from m1 take u,11)]
+         -(from m1 take u, from m2 take v)"
+        int 11)
+
+     (modules-check-let*-2.2
+        "module m2
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+         module m1 interface [u : int] body [u = 44]
+         -(from m1 take u, from m2 take v)"
+        error)
+
+    ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  (define tests-for-parse
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        (else
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             #t)
+           (loop (cdr lst)))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+
+  )
+
+  
+  
+    
+
+  
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter8/simplemodules/tests-book.scm b/collects/tests/eopl/chapter8/simplemodules/tests-book.scm
new file mode 100755
index 0000000000..7ca4ee5854
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/tests-book.scm
@@ -0,0 +1,110 @@
+(module tests-book mzscheme
+  
+  (provide tests-for-run tests-for-check tests-for-parse)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+
+  (define the-test-suite
+ 
+    '(
+
+      (modules-dans-simplest "
+         module m1
+          interface 
+           [a : int
+            b : int]
+          body
+           [a = 33
+            c = -(a,1)
+            b = -(c,a)]
+
+         let a = 10
+         in -(-(from m1 take a, from m1 take b), 
+              a)"
+        int 24)
+
+
+      (example-8.2 "
+         module m1 
+          interface 
+           [u : bool]
+          body 
+           [u = 33]
+
+         44"
+        error 44)
+
+      (example-8.3 "
+         module m1 
+          interface 
+           [u : int 
+            v : int]
+          body 
+           [u = 33]
+
+         44"
+        error)
+
+      (example-8.4 "
+         module m1 
+          interface 
+           [u : int 
+            v : int] 
+          body 
+           [v = 33 
+            u = 44]
+
+         from m1 take u" 
+        error)
+
+      (example-8.5a "
+         module m1 
+          interface 
+           [u : int] 
+          body 
+           [u = 44]
+
+         module m2 
+          interface
+           [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         -(from m1 take u, from m2 take v)"
+        int)
+
+      (example-8.5b "
+         module m2 
+          interface [v : int] 
+          body 
+           [v = -(from m1 take u,11)]
+
+         module m1 
+          interface [u : int] 
+          body [u = 44]
+
+         -(from m1 take u, from m2 take v)"
+        error)
+
+      ))
+
+  (define tests-for-run
+    (let loop ((lst the-test-suite))
+      (cond
+        ((null? lst) '())
+        ((= (length (car lst)) 4)
+         ;; (printf "creating item: ~s~%" (caar lst))
+         (cons
+           (list
+             (list-ref (car lst) 0)
+             (list-ref (car lst) 1)
+             (list-ref (car lst) 3))
+           (loop (cdr lst))))
+        (else (loop (cdr lst))))))
+
+  ;; ok to have extra members in a test-item.
+  (define tests-for-check the-test-suite)
+
+  (define tests-for-parse the-test-suite)
+
+  )
+
diff --git a/collects/tests/eopl/chapter8/simplemodules/top.scm b/collects/tests/eopl/chapter8/simplemodules/top.scm
new file mode 100755
index 0000000000..4c0dace105
--- /dev/null
+++ b/collects/tests/eopl/chapter8/simplemodules/top.scm
@@ -0,0 +1,129 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Parse all the tests with (parse-all)
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+  
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "check-modules.scm")         ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+
+  ;; choose one of the following test suites
+
+  (require "test-suite.scm")        ; ordinary test suite        
+  ;; (require "tests-book.scm")     ; examples from book/lecture notes     
+
+  (provide run run-all check check-all parse-all)
+
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+ 
+  ;; (run-all)
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : string -> external-type
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal? tests-for-check)))
+
+  ;; check-one : symbol -> expval
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+ 
+  ;; (check-all)
+
+  ;;;;;;;;;;;;;;;; parsing ;;;;;;;;;;;;;;;;
+  
+  ;; writing syntactically correct programs in this language can take
+  ;; some effort, so we've added a test that just parses the items in
+  ;; the test list.  This requires a slightly different structure.
+
+  ;; test-item ::= (test-name program correct-ans)
+  ;; test-list is a list of test-items.
+
+  (define parse-all
+    (lambda ()
+      (for-each
+        (lambda (test-item)
+          (let ((test-name (list-ref test-item 0))
+                (pgm       (list-ref test-item 1)))
+            (eopl:printf "~s... " test-name)               
+            (let ((outcome
+                    (apply-safely scan&parse (list pgm))))
+              (if (car outcome)
+                (eopl:printf "passed ~%")
+                (begin
+                  (eopl:printf "failed ~%")
+                  (if (stop-after-first-error)
+                    (eopl:error test-name
+                      "incorrect outcome detected"))))))) 
+        tests-for-parse)))
+
+  ;; (parse-all)
+  
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter9/classes/classes.scm b/collects/tests/eopl/chapter9/classes/classes.scm
new file mode 100755
index 0000000000..e22cc0c30f
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/classes.scm
@@ -0,0 +1,231 @@
+(module classes (lib "eopl.ss" "eopl")
+
+  (require "store.scm")
+  (require "lang.scm")
+
+  ;; object interface
+  (provide object object? new-object object->class-name object->fields)
+
+  ;; method interface
+  (provide method method? a-method find-method)
+  
+  ;; class interface
+  (provide lookup-class initialize-class-env!)
+
+;;;;;;;;;;;;;;;; objects ;;;;;;;;;;;;;;;;
+
+  ;; an object consists of a symbol denoting its class, and a list of
+  ;; references representing the managed storage for the all the fields. 
+  
+  (define identifier? symbol?)
+
+  (define-datatype object object? 
+    (an-object
+      (class-name identifier?)
+      (fields (list-of reference?))))
+
+  ;; new-object : ClassName -> Obj
+  ;; Page 340
+  (define new-object                      
+    (lambda (class-name)
+      (an-object
+        class-name
+        (map 
+          (lambda (field-name)
+            (newref (list 'uninitialized-field field-name)))
+          (class->field-names (lookup-class class-name))))))
+
+;;;;;;;;;;;;;;;; methods and method environments ;;;;;;;;;;;;;;;;
+
+  (define-datatype method method?
+    (a-method
+      (vars (list-of symbol?))
+      (body expression?)
+      (super-name symbol?)
+      (field-names (list-of symbol?))))
+
+;;;;;;;;;;;;;;;; method environments ;;;;;;;;;;;;;;;;
+
+  ;; a method environment looks like ((method-name method) ...)
+
+  (define method-environment?
+    (list-of 
+      (lambda (p)
+        (and 
+          (pair? p)
+          (symbol? (car p))
+          (method? (cadr p))))))
+
+  ;; method-env * id -> (maybe method)
+  (define assq-method-env
+    (lambda (m-env id)
+      (cond
+        ((assq id m-env) => cadr)
+        (else #f))))
+
+  ;; find-method : Sym * Sym -> Method
+  ;; Page: 345
+  (define find-method
+    (lambda (c-name name)
+      (let ((m-env (class->method-env (lookup-class c-name))))
+        (let ((maybe-pair (assq name m-env)))
+          (if (pair? maybe-pair) (cadr maybe-pair)
+            (report-method-not-found name))))))
+
+  (define report-method-not-found
+    (lambda (name)
+      (eopl:error 'find-method "unknown method ~s" name)))
+  
+  ;; merge-method-envs : MethodEnv * MethodEnv -> MethodEnv
+  ;; Page: 345
+  (define merge-method-envs
+    (lambda (super-m-env new-m-env)
+      (append new-m-env super-m-env)))
+
+  ;; method-decls->method-env :
+  ;; Listof(MethodDecl) * ClassName * Listof(FieldName) -> MethodEnv
+  ;; Page: 345
+  (define method-decls->method-env
+    (lambda (m-decls super-name field-names)
+      (map
+        (lambda (m-decl)
+          (cases method-decl m-decl
+            (a-method-decl (method-name vars body)
+              (list method-name
+                (a-method vars body super-name field-names)))))
+        m-decls)))
+
+  ;;;;;;;;;;;;;;;; classes ;;;;;;;;;;;;;;;;
+
+  (define-datatype class class?
+    (a-class
+      (super-name (maybe symbol?))
+      (field-names (list-of symbol?))
+      (method-env method-environment?)))
+
+  ;;;;;;;;;;;;;;;; class environments ;;;;;;;;;;;;;;;;
+
+  ;; the-class-env will look like ((class-name class) ...)
+
+  ;; the-class-env : ClassEnv
+  ;; Page: 343
+  (define the-class-env '())
+
+  ;; add-to-class-env! : ClassName * Class -> Unspecified
+  ;; Page: 343
+  (define add-to-class-env!
+    (lambda (class-name class)
+      (set! the-class-env
+        (cons
+          (list class-name class)
+          the-class-env))))
+
+  ;; lookup-class : ClassName -> Class
+  (define lookup-class                    
+    (lambda (name)
+      (let ((maybe-pair (assq name the-class-env)))
+        (if maybe-pair (cadr maybe-pair)
+          (report-unknown-class name)))))
+
+  (define report-unknown-class
+    (lambda (name)
+      (eopl:error 'lookup-class "Unknown class ~s" name)))
+
+
+ 
+  ;; constructing classes
+
+  ;; initialize-class-env! : Listof(ClassDecl) -> Unspecified
+  ;; Page: 344
+  (define initialize-class-env!
+    (lambda (c-decls)
+      (set! the-class-env 
+        (list
+          (list 'object (a-class #f '() '()))))
+      (for-each initialize-class-decl! c-decls)))
+
+  ;; initialize-class-decl! : ClassDecl -> Unspecified
+  (define initialize-class-decl!
+    (lambda (c-decl)
+      (cases class-decl c-decl
+        (a-class-decl (c-name s-name f-names m-decls)
+          (let ((f-names
+                  (append-field-names
+                    (class->field-names (lookup-class s-name))
+                    f-names)))
+            (add-to-class-env!
+              c-name
+              (a-class s-name f-names
+                (merge-method-envs
+                  (class->method-env (lookup-class s-name))
+                  (method-decls->method-env
+                    m-decls s-name f-names)))))))))  
+
+  ;; exercise:  rewrite this so there's only one set! to the-class-env.
+
+  ;; append-field-names :  Listof(FieldName) * Listof(FieldName) 
+  ;;                       -> Listof(FieldName)
+  ;; Page: 344
+  ;; like append, except that any super-field that is shadowed by a
+  ;; new-field is replaced by a gensym
+  (define append-field-names
+    (lambda (super-fields new-fields)
+      (cond
+        ((null? super-fields) new-fields)
+        (else
+         (cons 
+           (if (memq (car super-fields) new-fields)
+             (fresh-identifier (car super-fields))
+             (car super-fields))
+           (append-field-names
+             (cdr super-fields) new-fields))))))
+
+;;;;;;;;;;;;;;;; selectors ;;;;;;;;;;;;;;;;
+
+  (define class->super-name
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name field-names method-env)
+          super-name))))
+
+  (define class->field-names
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name field-names method-env)
+          field-names))))
+
+  (define class->method-env
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name  field-names method-env)
+          method-env))))
+
+
+  (define object->class-name
+    (lambda (obj)
+      (cases object obj
+        (an-object (class-name fields)
+          class-name))))
+
+  (define object->fields
+    (lambda (obj)
+      (cases object obj
+        (an-object (class-decl fields)
+          fields))))
+
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  (define maybe
+    (lambda (pred)
+      (lambda (v)
+        (or (not v) (pred v)))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/classes/data-structures.scm b/collects/tests/eopl/chapter9/classes/data-structures.scm
new file mode 100755
index 0000000000..a72db32232
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/data-structures.scm
@@ -0,0 +1,117 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+  (require "classes.scm")               ; for object?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; reference. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    (obj-val
+      (obj object?))
+    (list-val
+      (lst (list-of expval?)))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  ;; not used.  Nor is expval->obj or expval->list, so we haven't
+  ;; written them.
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (vars (list-of symbol?))
+      (body expression?)
+      (env environment?)))
+  
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvars (list-of symbol?))
+      (bvals (list-of reference?)) 
+      (saved-env environment?))
+    (extend-env-rec**
+      (proc-names (list-of symbol?))
+      (b-varss (list-of (list-of symbol?)))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?))
+    (extend-env-with-self-and-super
+      (self object?)
+      (super-name symbol?)
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)
+	    (env->list saved-env)))
+	(extend-env-rec** (p-names b-varss p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env)))
+        (extend-env-with-self-and-super (self super-name saved-env)
+          (cons
+            (list 'self self 'super super-name)
+            (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/classes/drscheme-init.scm b/collects/tests/eopl/chapter9/classes/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter9/classes/environments.scm b/collects/tests/eopl/chapter9/classes/environments.scm
new file mode 100755
index 0000000000..769007e62e
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/environments.scm
@@ -0,0 +1,77 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (require "store.scm")
+
+  (provide init-env empty-env extend-env apply-env env->list)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env1
+        'i (newref (num-val 1))
+        (extend-env1
+          'v (newref (num-val 5))
+          (extend-env1
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+  (define extend-env1
+    (lambda (id val env)
+      (extend-env (list id) (list val) env)))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvars bvals saved-env)
+          (cond
+            ((location search-sym bvars)
+             => (lambda (n)
+                  (list-ref bvals n)))
+            (else
+              (apply-env saved-env search-sym))))
+        (extend-env-rec** (p-names b-varss p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (newref
+                    (proc-val
+                      (procedure 
+                        (list-ref b-varss n)
+                        (list-ref p-bodies n)
+                        env)))))
+            (else (apply-env saved-env search-sym))))
+        (extend-env-with-self-and-super (self super-name saved-env)
+          (case search-sym
+            ((%self) self)
+            ((%super) super-name)
+            (else (apply-env saved-env search-sym)))))))
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
diff --git a/collects/tests/eopl/chapter9/classes/interp.scm b/collects/tests/eopl/chapter9/classes/interp.scm
new file mode 100755
index 0000000000..78aac98c5b
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/interp.scm
@@ -0,0 +1,212 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  (require "classes.scm")
+  
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  ;; Page: 336
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)             
+      (cases program pgm
+        (a-program (class-decls body)
+          (initialize-class-env! class-decls)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 336 and 337
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (deref (apply-env env var)))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (sum-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (+ val1 val2))))
+
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (vars exps body)       
+	  (if (instrument-let)
+	    (eopl:printf "entering let ~s~%" vars))
+          (let ((new-env 
+                  (extend-env 
+                    vars
+                    (map newref (values-of-exps exps env))
+                    env)))
+	      (if (instrument-let)
+		(begin
+		  (eopl:printf "entering body of let ~s with env =~%" vars)
+		  (pretty-print (env->list new-env))
+		  (eopl:printf "store =~%")
+		  (pretty-print (store->readable (get-store-as-list)))
+		  (eopl:printf "~%")
+		  ))
+	      (value-of body new-env)))
+
+        (proc-exp (bvars body)
+	  (proc-val
+	    (procedure bvars body env)))
+
+        (call-exp (rator rands)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (args (values-of-exps rands env)))
+	    (apply-procedure proc args)))
+
+        (letrec-exp (p-names b-varss p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec** p-names b-varss p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (x e)
+          (begin
+            (setref!
+              (apply-env env x)
+              (value-of e env))
+            (num-val 27)))
+
+
+        (list-exp (exps)
+          (list-val
+            (values-of-exps exps env)))
+
+        ;; new cases for CLASSES language
+
+        (new-object-exp (class-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (new-object class-name)))
+            (apply-method
+              (find-method class-name 'initialize)
+              obj
+              args)
+            obj))
+
+        (self-exp ()
+          (apply-env env '%self))
+
+        (method-call-exp (obj-exp method-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (value-of obj-exp env)))
+            (apply-method
+              (find-method (object->class-name obj) method-name)
+              obj
+              args)))
+      
+        (super-call-exp (method-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (apply-env env '%self)))
+            (apply-method
+              (find-method (apply-env env '%super) method-name)
+              obj
+              args)))        
+        )))
+
+  ;; apply-procedure : Proc * Listof(ExpVal) -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 args)
+      (cases proc proc1
+        (procedure (vars body saved-env)
+          (let ((new-env
+                  (extend-env
+                    vars
+                    (map newref args)
+                    saved-env)))
+            (if (instrument-let)
+              (begin
+                (eopl:printf
+                  "entering body of proc ~s with env =~%"
+                  vars)
+                (pretty-print (env->list new-env)) 
+                (eopl:printf "store =~%")
+                (pretty-print (store->readable (get-store-as-list)))
+                (eopl:printf "~%")))
+            (value-of body new-env))))))
+
+  
+  ;; apply-method : Method * Obj * Listof(ExpVal) -> ExpVal
+  (define apply-method                    
+    (lambda (m self args)
+      (cases method m
+        (a-method (vars body super-name field-names)
+          (value-of body
+            (extend-env vars (map newref args)
+              (extend-env-with-self-and-super
+                self super-name
+                (extend-env field-names (object->fields self)
+                  (empty-env)))))))))
+
+  (define values-of-exps
+    (lambda (exps env)
+      (map
+        (lambda (exp) (value-of exp env))
+        exps)))
+
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (cons
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter9/classes/lang.scm b/collects/tests/eopl/chapter9/classes/lang.scm
new file mode 100755
index 0000000000..25de3e5def
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/lang.scm
@@ -0,0 +1,126 @@
+(module lang (lib "eopl.ss" "eopl")
+
+  ;; grammar for the CLASSES language.  Based on IMPLICIT-REFS, plus
+  ;; multiple-argument procedures, multiple-declaration letrecs, and
+  ;; multiple-declaration lets. 
+  
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program ((arbno class-decl) expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+
+      (expression
+        ("+" "(" expression "," expression ")")
+        sum-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+        ("let" (arbno identifier "=" expression) "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "(" (separated-list identifier ",") ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression (arbno expression) ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          (arbno identifier "(" (separated-list identifier ",") ")"
+            "=" expression)
+          "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      (expression
+        ("list" "(" (separated-list expression ",") ")" )
+        list-exp)
+
+      ;; new productions for oop
+
+      (class-decl                         
+        ("class" identifier 
+          "extends" identifier                   
+          (arbno "field" identifier)
+          (arbno method-decl)
+          )
+        a-class-decl)
+
+      (method-decl
+        ("method" identifier 
+          "("  (separated-list identifier ",") ")" ; method formals
+          expression 
+          )
+        a-method-decl)
+
+      (expression 
+        ("new" identifier "(" (separated-list expression ",") ")")
+        new-object-exp)
+
+      ;; this is special-cased to prevent it from mutation
+      (expression
+        ("self")
+        self-exp)
+
+      (expression
+        ("send" expression identifier
+          "("  (separated-list expression ",") ")")
+        method-call-exp)
+
+      (expression                                
+        ("super" identifier    "("  (separated-list expression ",") ")")
+        super-call-exp)
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+  )
diff --git a/collects/tests/eopl/chapter9/classes/store.scm b/collects/tests/eopl/chapter9/classes/store.scm
new file mode 100755
index 0000000000..f925bdcbda
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/store.scm
@@ -0,0 +1,110 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+   
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/classes/tests.scm b/collects/tests/eopl/chapter9/classes/tests.scm
new file mode 100755
index 0000000000..76f0edbd19
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/tests.scm
@@ -0,0 +1,789 @@
+(module tests mzscheme
+  
+  (provide test-list)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define test-list
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f)(f 30)  proc(x)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x) proc (y) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x) proc (y) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f)
+            let d = proc (x) proc (z) ((f (x x)) z)
+            in proc (n) ((f (d d)) n)
+in let
+    t4m = proc (f) proc(x) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec f(x) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec f(x) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec f(x) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+      
+;      (fact-of-6  "letrec
+;  fact(x) = if zero?(x) then 1 else *(x, (fact sub1(x)))
+;in (fact 6)" 
+;                  720)
+      
+      (HO-nested-letrecs
+"letrec even(odd)  = proc(x) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  odd(x)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+      
+      (begin-test-1
+        "begin 1; 2; 3 end"
+        3)
+
+      ;; extremely primitive testing for mutable variables
+
+      (assignment-test-1 "let x = 17
+                          in begin set x = 27; x end"
+        27)
+
+
+      (gensym-test
+"let g = let count = 0 in proc(d) 
+                        let d = set count = -(count,-1)
+                        in count
+in -((g 11), (g 22))"
+-1)
+
+      (even-odd-via-set "
+let x = 0
+in letrec even(d) = if zero?(x) then 1 
+                                  else let d = set x = -(x,1)
+                                       in (odd d)
+              odd(d)  = if zero?(x) then 0 
+                                  else let d = set x = -(x,1)
+                                       in (even d)
+   in let d = set x = 13 in (odd -99)" 1)
+
+      (example-for-book-1 "
+let f = proc (x) proc (y) 
+                  begin
+                   set x = -(x,-1);
+                   -(x,y)
+                  end
+in ((f 44) 33)"
+	12)
+
+      ;; multiple arguments
+     (nested-procs2 "let f = proc(x,y) -(x,y) in (f -(10,5) 6)"
+        -1)
+            
+
+    (twice-cps "
+      let twice = proc(f, x, k)
+                    (f x  proc (z) (f z k))
+      in (twice 
+          proc (x, k) (k -(x,1))
+          11
+          proc(z) z)"
+      9)
+
+    (cps-neither-basic "
+      let f = proc (x) proc (y) -(x, y)
+          g = proc (z) -(z, 1)
+      in ((f 27) (g 11))"
+      17)
+
+  (create-empty-class
+  "class c1 extends object  3" 3)
+
+  (create-class-with-method "
+class c1 extends object 
+  field y 
+  method gety()y 33 "
+33)
+
+  (create-object "
+class c1 extends object  
+ method initialize()0 
+let o1 = new c1() in 11
+" 11)
+
+
+  (send-msg-1 "
+class c1 extends object 
+  field s 
+  method initialize()set s = 44
+  method gets()s
+  method sets(v)set s = v
+  
+let o1 = new c1() in send o1 gets()
+"
+44)
+
+  (send-msg-2 "
+class c1 extends object 
+  field s 
+  method initialize()set s = 44
+  method gets()s
+  method sets(v)set s = v
+  
+let o1 = new c1() 
+    t1 = 0
+    t2 = 0 
+in begin
+     set t1 = send o1 gets();
+     send o1 sets(33);
+     set t2 = send o1 gets();
+     list(t1, t2)
+  end
+"
+(44 33))
+
+  (test-self-1 "
+class c extends object 
+  field s
+  method initialize(v)set s = v
+  method sets(v)set s = v
+  method gets()s
+  method testit()send self sets(13)
+  
+let o = new c (11)
+       t1 = 0
+       t2 = 0
+   in begin 
+       set t1 = send o gets();
+       send o testit();
+       set t2 = send o gets();
+       list(t1,t2)
+      end" (11 13))
+
+;;   (two-queues "
+;; class queue extends object 
+;;   field q_in
+;;   field q_out
+;;   field ans
+;;   method initialize()send self reset()
+;;   method reset() 
+;;    begin 
+;;     set q_in = nil();
+;;     set q_out = nil();
+;;     send self countup()
+;;    end
+   
+;;    method empty?()if null?(q_in) then null?(q_out)
+;;                                   else 0
+;;    method enq(x)begin
+;;                   send self countup();
+;;                   set q_in = cons(x,q_in)
+;;                  end
+;;    method deq()
+;;      letrec reverse(l) = (reverse_help l nil())
+;;                  reverse_help(inp,out) = if null?(inp) then out
+;;                                          else (reverse_help 
+;;                                                  cdr(inp) cons(car(inp), out))
+;;       in if send self empty?() then 0
+;;                                 else begin
+;;                                       send self countup();
+;;                                       if null?(q_out) then
+;;                                         begin set q_out = (reverse q_in);
+;;                                               set q_in = nil()
+;;                                         end
+;;                                         else 0;
+;;                                       set ans = car(q_out);
+;;                                       set q_out = cdr(q_out);
+;;                                       ans
+;;                                      end 
+;;       method countup()1    % stub
+;;       method get_total()1  % stub
+                   
+;; let o1 = new queue ()
+;;     o2 = new queue ()
+;;     t1 = 0 t2 = 0 t3 = 0
+;;     t4 = 0 t5 = 0 t6 = 0
+;;     tot1 = 0 tot2 = 0
+;; in begin
+;;        send o1 enq(11);
+;;        send o2 enq(21);
+;;        send o1 enq(12);
+;;        send o2 enq(22);
+;;        set t1 = send o1 deq();
+;;        set t2 = send o1 deq();
+;;        set t3 = send o2 deq();
+;;        set t4 = send o2 deq();
+;;        set t5 = send o1 get_total();
+;;        set t6 = send o2 get_total();
+;;        list(t1,t2,t3,t4,t5,t6)
+;;   end" (11 12 21 22 1 1))
+
+;; next one is queue with shared counter object (passed at initialization)
+
+  (counter-1 "
+class counter extends object 
+ field count
+ method initialize()set count = 0
+ method countup()set count = -(count, -1)
+ method getcount()count
+ 
+let o1 = new counter ()
+    t1 = 0
+    t2 = 0
+in begin
+    set t1 = send o1 getcount();
+    send o1 countup();
+    set t2 = send o1 getcount();
+    list(t1,t2)
+   end
+" (0 1))
+
+  (shared-counter-1 "
+class counter extends object
+  field count
+   method initialize()set count = 0
+   method countup()set count = -(count, -1)
+   method getcount()count
+   
+class c1 extends object 
+   field n
+   field counter1
+   method initialize(a_counter)
+    begin
+     set n = 0;
+     set counter1 = a_counter
+    end
+   method countup()
+     begin
+      send counter1 countup();
+      set n = -(n,-1)
+     end
+   method getstate()list(n, send counter1 getcount())
+   
+let counter1 = new counter()
+in let o1 = new c1(counter1)
+       o2 = new c1(counter1)
+in begin
+     send o1 countup();
+     send o2 countup();
+     send o2 countup();
+     list( send o1 getstate(),
+           send o2 getstate())
+   end
+"
+((1 3) (2 3)))
+
+;;   (two-queues-with-counter "
+;; class counter extends object
+;;   field c_count
+;;    method initialize()set c_count = 0
+;;    method countup()set c_count = add1(c_count)
+;;    method getcount()c_count
+   
+;; class queue extends object
+;;   field q_in 
+;;    field q_out
+;;    field ans
+;;    field count
+;;    method initialize(the_counter)
+;;     begin
+;;       set count = the_counter;  % must do this first, because reset counts.
+;;       send self reset()
+;;      end
+    
+;;    method reset()begin set q_in = nil();
+;;                         set q_out = nil();
+;;                         send self countup()
+;;                   end
+;;    method empty?()if null?(q_in) then null?(q_out)
+;;                                   else 0
+;;    method enq(x)begin
+;;                   send self countup();
+;;                   set q_in = cons(x,q_in)
+;;                  end
+;;    method deq()
+;;      letrec reverse(l) = (reverse_help l nil())
+;;                  reverse_help(inp,out) = if null?(inp) then out
+;;                                          else (reverse_help 
+;;                                                  cdr(inp) cons(car(inp), out))
+;;       in if send self empty?() then 0
+;;                                 else begin
+;;                                       send self countup();
+;;                                       if null?(q_out) then
+;;                                         begin set q_out = (reverse q_in);
+;;                                               set q_in = nil()
+;;                                         end
+;;                                         else 0;
+;;                                       set ans = car(q_out);
+;;                                       set q_out = cdr(q_out);
+;;                                       ans
+;;                                      end
+;;       method countup()send count countup()
+;;       method get_total()send count getcount()
+   
+;; let counter1 = new counter() in
+;; let o1 = new queue (counter1)
+;;     o2 = new queue (counter1)
+;;     t1 = 0 t2 = 0 t3 = 0
+;;     t4 = 0 t5 = 0 t6 = 0
+;;     tot1 = 0 tot2 = 0
+;; in begin
+;;        send o1 enq(11);
+;;        send o2 enq(21);
+;;        send o1 enq(12);
+;;        send o2 enq(22);
+;;        set t1 = send o1 deq();
+;;        set t2 = send o1 deq();
+;;        set t3 = send o2 deq();
+;;        set t4 = send o2 deq();
+;;        set t5 = send o1 get_total();
+;;        set t6 = send o2 get_total();
+;;        list(t1,t2,t3,t4,t5,t6)
+;;   end" '(11 12 21 22 10 10))
+
+
+;; Chris's first example
+
+  (chris-1 "
+class aclass extends object 
+  field i
+  method initialize(x) set i = x
+  method m(y) -(i,-(0,y))
+  
+let o1 = new aclass(3)
+in send o1 m(2)"                        
+5)
+
+  (for-book-1 "
+class c1 extends object
+  field i
+  field j
+  method initialize(x) begin set i = x; set j = -(0,x) end
+  method countup(d) begin set i = -(i,-(0,d)); set j = -(j,d) end
+  method getstate()list(i,j)
+  
+let o1 = new c1(3)
+    t1 = 0
+    t2 = 0
+in begin
+    set t1 = send o1 getstate();
+    send o1 countup(2);
+    set t2 = send o1 getstate();
+    list(t1,t2)
+   end"
+((3 -3) (5 -5)))
+
+
+  (odd-even-via-self "
+class oddeven extends object 
+  method initialize()1
+  method even(n)if zero?(n) then 1 else send self odd (-(n,1))
+  method odd(n) if zero?(n) then 0 else send self even (-(n,1))
+  
+let o1 = new oddeven() in send o1 odd(13)"
+1)
+
+  (inherit-1 "
+class c1 extends object 
+  field ivar1
+  method initialize()set ivar1 = 1
+  
+class c2 extends c1 
+  field ivar2
+  method initialize() 
+   begin
+    super initialize(); 
+    set ivar2 = 1
+   end
+  method setiv1(n)set ivar1 = n
+  method getiv1()ivar1
+  
+let o = new c2 ()
+    t1 = 0
+in begin
+       send o setiv1(33);
+       send o getiv1()
+   end                      
+" 33)
+
+  (inherit-2 "
+class c1 extends object 
+  field ivar1
+  method initialize()set ivar1 = 1
+
+  method setiv1(n)set ivar1 = n
+  method getiv1()ivar1
+
+  method foo()1
+  method call-foo-from-superclass()send self foo()
+
+  
+class c2 extends c1 
+  field ivar2
+  method initialize() 
+   begin super initialize(); set ivar2 = 1 end
+   
+
+  method foo()2
+
+  method setiv2(n)set ivar2 = n
+  method getiv2()ivar2
+
+  method self-and-super-foo()
+    list( send self foo(),  super foo())
+
+  method test-self-from-super()
+     super call-foo-from-superclass()
+
+   
+let o = new c2 ()
+    t1 = 0 t2 = 0 t3 = 0 t4 = 0
+in begin
+       send o setiv1(33);
+       list(
+         send o getiv1(),
+         send o self-and-super-foo(),
+         send o call-foo-from-superclass(),
+         send o test-self-from-super()
+         )
+      end                      
+" (33 (2 1) 2 2))
+
+  (inherit-3 "
+class c1 extends object 
+  method initialize()1
+  method m1()1
+  
+class c2 extends c1 
+  method m1()super m1()
+  method m2()2
+  
+class c3 extends c2 
+  method m1()3
+  method m2()super m2()
+  method m3()super m1()
+  
+let o = new c3 ()
+in list( send o m1(),
+         send o m2(),
+         send o m3()
+        )
+" (3 2 1))
+
+  (chris-2 "
+class c1 extends object 
+  method initialize() 1
+  method ma()1
+  method mb()send self ma()
+  
+class c2 extends c1   % just use c1's initialize
+  method ma() 2
+  
+let x = new c2 ()
+in list(send x ma(),send x mb())
+"
+(2 2))
+
+
+  (for-book-2 "
+class c1 extends object 
+  method initialize()1
+  method m1()1
+  method m2()100
+  method m3()send self m2()
+  
+class c2 extends c1 
+  method m2()2
+  
+let o1 = new c1()
+    o2 = new c2()
+in list(send o1 m1(),		% returns 1
+        send o1 m2(),           % returns 100
+        send o1 m3(),           % returns 100
+        send o2 m1(),           % returns 1 (from c1)
+        send o2 m2(),           % returns 2 (from c2)
+        send o2 m3()            % returns 2 (c1's m3 calls c2's m2)
+       )
+"
+(1 100 100 1 2 2))
+
+  (sum-leaves "
+class tree extends object 
+  method initialize()1
+  
+class interior_node extends tree 
+  field left
+  field right
+  method initialize(l,r)
+   begin
+    set left = l; set right = r
+   end
+  method sum() -(send left sum(), -(0, send right sum()))
+  
+class leaf_node extends tree 
+  field value
+  method initialize(v)set value = v
+  method sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+"
+12)
+
+  (check-shadowed-fields "
+class c1 extends object 
+  field x
+  field y
+  method initialize(v) begin set x = v; set y = 0 end
+  method m1() x
+
+class c2 extends c1 
+  field x
+  method initialize(v1,v2) begin set x = v2; 
+                                    super initialize(v1) end
+  method m2()list(x,y)
+
+class c3 extends c2 
+  field x
+  method initialize(v1,v2,v3) begin set x = v3; 
+                                       super initialize(v1,v2)
+                                 end
+  method m3()x
+
+let o = new c3(1,2,3)
+in list (send o m1(), send o m2(), send o m3())
+"
+(1 (2 0) 3))
+
+  (static-super "
+class c1 extends object
+ method initialize () 1
+ method m2() send self m3()
+ method m3() 13
+class c2 extends c1
+ method m2() 22
+ method m3() 23
+ method m1() super m2()
+class c3 extends c2
+ method m2() 32
+ method m3() 33
+let o3 = new c3()
+in send o3 m1()"
+33)
+
+
+  (every-concept "
+class a extends object
+  field i
+  field j
+  method initialize() 1
+  method setup()
+    begin
+      set i = 15;
+      set j = 20;
+      50
+    end    
+  method f() send self g()
+  method g() -(i,-(0,j))
+
+class b extends a
+  field j
+  field k
+  method setup()
+    begin
+      set j = 100;
+      set k = 200;
+      super setup();
+      send self h()
+    end
+  method g()
+    list(i,j,k)
+  method h() super g()
+
+class c extends b
+  method g() super h()
+  method h() -(k,-(0,j))
+
+let p = proc(o)
+         let u = send o setup ()
+         in list(u,
+                 send o g(),
+                 send o f())
+in list((p new a()),
+        (p new b()),
+        (p new c()))
+"
+((50 35 35) (35 (15 100 200) (15 100 200)) (300 35 35))
+)
+
+ (colorpoint-1 "
+class point extends object
+  field x
+  field y
+  method initialize (initx, inity)
+    begin 
+      set x = initx; 
+      set y = inity 
+    end
+  method move (dx, dy) 
+    begin 
+      set x = -(x,-(0,dx)); 
+      set y = -(y,-(0,dy)) 
+    end
+  method get_location () list(x,y)
+class colorpoint extends point
+  field color
+  method set_color (c) set color = c
+  method get_color () color
+let p = new point(3, 4)
+    cp = new colorpoint(10, 20)
+in begin
+     send p move(3, 4);
+     send cp set_color(87);
+     send cp move(10, 20);
+     list(send p get_location(),    % returns (6 8)
+          send cp get_location(),   % returns (20 40)
+          send cp get_color())      % returns 87
+   end"
+((6 8) (20 40) 87)
+)
+
+
+ (colorpoint-2 "
+class point extends object
+  field x
+  field y
+  method initialize (initx, inity)
+    begin 
+      set x = initx; 
+      set y = inity 
+    end
+  method move (dx, dy) 
+    begin 
+      set x = +(x,dx);
+      set y = +(y,dy)
+    end
+  method get_location () list(x,y)
+class colorpoint extends point
+  field color
+  method set_color (c) set color = c
+  method get_color () color
+  method initialize (x,y,c)
+   begin
+     super initialize (x,y);
+     set color = c
+   end
+let p = new point(3, 4)
+    cp = new colorpoint(10, 20, 30)
+in begin
+     send p move(3, 4);
+     send cp set_color(87);
+     send cp move(10, 20);
+     list(send p get_location(),    % returns (6 8)
+          send cp get_location(),   % returns (20 40)
+          send cp get_color())      % returns 87
+   end"
+((6 8) (20 40) 87)
+
+)
+
+
+(example-for-impl "
+class c1 extends object
+  field x
+  field y
+  method initialize () 
+    begin 
+      set x = 11; 
+      set y = 12 
+    end
+  method m1 () -(x,y)
+  method m2 () send self m3()
+class c2 extends c1
+  field y
+  method initialize () 
+    begin 
+      super initialize(); 
+      set y = 22 
+    end
+  method m1 (u,v) -(-(x,u), -(y,v))
+  method m3 () 23
+class c3 extends c2
+  field x
+  field z
+  method initialize () 
+    begin 
+      super initialize(); 
+      set x = 31; 
+      set z = 32 
+    end
+  method m3 () -(x,-(y,z))
+let o3 = new c3()
+in send o3 m1(7,8)
+"
+-10)
+
+
+      ))
+  )
+
diff --git a/collects/tests/eopl/chapter9/classes/top.scm b/collects/tests/eopl/chapter9/classes/top.scm
new file mode 100755
index 0000000000..8be7bd8693
--- /dev/null
+++ b/collects/tests/eopl/chapter9/classes/top.scm
@@ -0,0 +1,66 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite with (run-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")  ; for expval constructors
+  (require "lang.scm")             ; for scan&parse
+  (require "interp.scm")           ; for value-of-program
+  (require "tests.scm")            ; for test-list
+  
+  (provide run run-all)
+  
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> Unspecified
+
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? test-list)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        ((list? sloppy-val) (list-val (map sloppy->expval sloppy-val)))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+    
+  ;; run-one : Sym -> ExpVal
+
+  ;; (run-one sym) runs the test whose name is sym
+  
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name test-list)))
+        (cond
+          ((assoc test-name test-list)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+
+  ;;  (run-all)
+
+  )
+
+
+
+
diff --git a/collects/tests/eopl/chapter9/typed-oo/checker.scm b/collects/tests/eopl/chapter9/typed-oo/checker.scm
new file mode 100755
index 0000000000..46c891e67a
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/checker.scm
@@ -0,0 +1,425 @@
+(module checker (lib "eopl.ss" "eopl")
+
+  (require "drscheme-init.scm")
+  (require "lang.scm")
+  (require "static-classes.scm")
+  (require "static-data-structures.scm")
+
+  (provide type-to-external-form type-of type-of-program)
+
+  ;; type-of-program : Program -> Type
+  ;; Page: 358 
+  (define type-of-program
+    (lambda (pgm)
+      (cases program pgm
+        (a-program (class-decls exp1)
+          (initialize-static-class-env! class-decls)
+          (for-each check-class-decl! class-decls)
+          (type-of exp1 (init-tenv))))))
+
+  ;; type-of : Exp -> Tenv
+  ;; Page: 360 and 364
+  (define type-of
+    (lambda (exp tenv)
+      (cases expression exp
+
+        (const-exp (num) (int-type))
+
+        (var-exp (var) (apply-tenv tenv var))
+
+        (diff-exp (exp1 exp2)
+          (let ((type1 (type-of exp1 tenv))
+                (type2 (type-of exp2 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (check-equal-type! type2 (int-type) exp2)
+            (int-type)))
+
+        (sum-exp (exp1 exp2)
+          (let ((type1 (type-of exp1 tenv))
+                (type2 (type-of exp2 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (check-equal-type! type2 (int-type) exp2)
+            (int-type)))
+
+        (zero?-exp (exp1)
+          (let ((type1 (type-of exp1 tenv)))
+            (check-equal-type! type1 (int-type) exp1)
+            (bool-type)))
+
+        (if-exp (test-exp true-exp false-exp)
+          (let
+            ((test-type (type-of test-exp tenv))
+             (true-type (type-of true-exp tenv))
+             (false-type (type-of false-exp tenv)))
+            ;; these tests either succeed or raise an error
+            (check-equal-type! test-type (bool-type) test-exp)
+            (check-equal-type! true-type false-type exp)
+            true-type))
+
+        (let-exp (ids rands body) 
+          (let ((new-tenv 
+                  (extend-tenv 
+                    ids
+                    (types-of-exps rands tenv)
+                    tenv)))
+            (type-of body new-tenv)))
+
+        (proc-exp (bvars bvar-types body)
+          (let ((result-type
+                  (type-of body
+                    (extend-tenv bvars bvar-types tenv))))
+            (proc-type bvar-types result-type)))
+
+        (call-exp (rator rands) 
+          (let ((rator-type (type-of rator tenv))
+                (rand-types  (types-of-exps rands tenv)))
+            (type-of-call rator-type rand-types rands exp)))
+
+        (letrec-exp (proc-result-types proc-names
+                      bvarss bvar-typess proc-bodies
+                      letrec-body)
+          (let ((tenv-for-letrec-body
+                  (extend-tenv 
+                    proc-names
+                    (map proc-type bvar-typess proc-result-types)
+                    tenv)))
+            (for-each
+              (lambda (proc-result-type bvar-types bvars proc-body)
+                (let ((proc-body-type
+                        (type-of proc-body
+                          (extend-tenv
+                            bvars
+                            bvar-types
+                            tenv-for-letrec-body)))) ;; !!
+                  (check-equal-type!
+                    proc-body-type proc-result-type proc-body)))
+              proc-result-types bvar-typess bvarss proc-bodies)
+            (type-of letrec-body tenv-for-letrec-body)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((type-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (type-of e1 tenv)))
+                   (if (null? es)
+                     v1
+                     (type-of-begins (car es) (cdr es)))))))
+            (type-of-begins exp1 exps)))
+
+        (assign-exp (id rhs)
+          (check-is-subtype!
+            (type-of rhs tenv)
+            (apply-tenv tenv id)
+            exp)
+          (void-type))
+ 
+        (list-exp (exp1 exps) 
+          (let ((type-of-car (type-of exp1 tenv)))
+            (for-each
+              (lambda (exp)
+                (check-equal-type!
+                  (type-of exp tenv)
+                  type-of-car
+                  exp))
+              exps)
+            (list-type type-of-car)))
+
+        ;; object stuff begins here
+
+          (new-object-exp (class-name rands)
+            (let ((arg-types (types-of-exps rands tenv))
+                  (c (lookup-static-class class-name)))
+              (cases static-class c
+                (an-interface (method-tenv)
+                  (report-cant-instantiate-interface class-name))
+                (a-static-class (super-name i-names
+                                  field-names field-types method-tenv)
+                  ;; check the call to initialize
+                  (type-of-call
+                    (find-method-type
+                      class-name
+                      'initialize) 
+                    arg-types
+                    rands
+                    exp)
+                  ;; and return the class name as a type
+                  (class-type class-name)))))
+
+        (self-exp ()
+          (apply-tenv tenv '%self))
+
+        (method-call-exp (obj-exp method-name rands)
+          (let ((arg-types (types-of-exps rands tenv))
+                (obj-type (type-of obj-exp tenv)))
+            (type-of-call
+              (find-method-type
+                (type->class-name obj-type)
+                method-name)
+              arg-types
+              rands
+              exp)))
+
+        (super-call-exp (method-name rands)
+          (let ((arg-types (types-of-exps rands tenv))
+                (obj-type (apply-tenv tenv '%self)))
+            (type-of-call
+              (find-method-type
+                (apply-tenv tenv '%super)
+                method-name)
+              arg-types
+              rands
+              exp)))
+
+        ;; this matches interp.scm:  interp.scm calls
+        ;; object->class-name, which fails on a non-object, so we need
+        ;; to make sure that obj-type is in fact a class type.
+        ;; interp.scm calls is-subclass?, which never raises an error,
+        ;; so we don't need to do anything with class-name here.
+
+        (cast-exp (exp class-name)
+          (let ((obj-type (type-of exp tenv)))
+            (if (class-type? obj-type)
+              (class-type class-name)
+              (report-bad-type-to-cast obj-type exp))))
+
+        ;; instanceof in interp.scm behaves the same way as cast:  it
+        ;; calls object->class-name on its argument, so we need to
+        ;; check that the argument is some kind of object, but we
+        ;; don't need to look at class-name at all.
+
+          (instanceof-exp (exp class-name)
+            (let ((obj-type (type-of exp tenv)))
+              (if (class-type? obj-type)
+                (bool-type)
+                (report-bad-type-to-instanceof obj-type exp))))
+
+        )))
+
+  (define report-cant-instantiate-interface
+    (lambda (class-name)
+      (eopl:error 'type-of-new-obj-exp
+        "Can't instantiate interface ~s"
+        class-name)))
+
+  (define types-of-exps
+    (lambda (rands tenv)
+      (map (lambda (exp) (type-of exp tenv)) rands)))
+
+  ;; type-of-call : Type * Listof(Type) * Listof(Exp) -> Type
+  ;; Page: 360
+  (define type-of-call
+    (lambda (rator-type rand-types rands exp)
+      (cases type rator-type
+        (proc-type (arg-types result-type)
+          (if (not (= (length arg-types) (length rand-types)))
+            (report-wrong-number-of-arguments arg-types rand-types
+              exp))
+          (for-each check-is-subtype! rand-types arg-types rands)
+          result-type)
+        (else
+          (report-rator-not-of-proc-type
+            (type-to-external-form rator-type)
+            exp)))))
+
+  (define report-rator-not-of-proc-type
+    (lambda (external-form-rator-type exp)
+      (eopl:error 'type-of-call
+         "rator ~s is not of proc-type ~s"
+         exp external-form-rator-type)))
+
+  (define report-wrong-number-of-arguments
+    (lambda (arg-types rand-types exp)
+      (eopl:error 'type-of-call
+        "These are not the same: ~s and ~s in ~s"
+        (map type-to-external-form arg-types)
+        (map type-to-external-form rand-types)
+        exp)))
+
+  ;; check-class-decl! : ClassDecl -> Unspecified
+  ;; Page: 367
+  (define check-class-decl!
+    (lambda (c-decl)
+      (cases class-decl c-decl
+        (an-interface-decl (i-name abs-method-decls)
+          #t)
+        (a-class-decl (class-name super-name i-names 
+                        field-types field-names method-decls)
+          (let ((sc (lookup-static-class class-name)))
+            (for-each 
+              (lambda (method-decl)
+                (check-method-decl! method-decl
+                  class-name super-name 
+                  (static-class->field-names sc)
+                  (static-class->field-types sc)))
+              method-decls))
+          (for-each 
+            (lambda (i-name)
+              (check-if-implements! class-name i-name))
+            i-names)
+          ))))
+
+
+  ;; check-method-decl! :
+  ;;   MethodDecl * ClassName * ClassName * Listof(FieldName) * \Listof(Type) 
+  ;;    -> Unspecified
+  ;; Page: 368
+  (define check-method-decl!
+    (lambda (m-decl self-name s-name f-names f-types)
+      (cases method-decl m-decl
+        (a-method-decl (res-type m-name vars var-types body)
+          (let ((tenv
+                  (extend-tenv
+                    vars var-types
+                    (extend-tenv-with-self-and-super
+                      (class-type self-name)
+                      s-name
+                      (extend-tenv f-names f-types
+                        (init-tenv))))))
+            (let ((body-type (type-of body tenv)))
+              (check-is-subtype! body-type res-type m-decl)
+              (if (eqv? m-name 'initialize) #t
+                (let ((maybe-super-type
+                        (maybe-find-method-type
+                          (static-class->method-tenv
+                            (lookup-static-class s-name))
+                          m-name)))
+                  (if maybe-super-type
+                    (check-is-subtype! 
+                      (proc-type var-types res-type)
+                        maybe-super-type body)
+                    #t)))))))))
+
+  ;; check-if-implements! : ClassName * InterfaceName -> Bool
+  ;; Page: 369
+  (define check-if-implements!
+    (lambda (c-name i-name)
+      (cases static-class (lookup-static-class i-name)
+        (a-static-class (s-name i-names f-names f-types
+                          m-tenv)
+          (report-cant-implement-non-interface 
+            c-name i-name))
+        (an-interface (method-tenv)
+          (let ((class-method-tenv
+                  (static-class->method-tenv
+                    (lookup-static-class c-name))))
+            (for-each
+              (lambda (method-binding)
+                (let ((m-name (car method-binding))
+                      (m-type (cadr method-binding)))
+                  (let ((c-method-type
+                          (maybe-find-method-type
+                            class-method-tenv
+                            m-name)))
+                    (if c-method-type
+                      (check-is-subtype!
+                        c-method-type m-type c-name)
+                      (report-missing-method
+                        c-name i-name m-name)))))
+              method-tenv))))))
+
+  (define report-cant-implement-non-interface
+    (lambda (c-name i-name)
+      (eopl:error 'check-if-implements
+         "class ~s claims to implement non-interface ~s"
+         c-name i-name)))
+
+  (define report-missing-method
+    (lambda (c-name i-name i-m-name)
+      (eopl:error 'check-if-implements
+        "class ~s claims to implement ~s, missing method ~s"
+         c-name i-name i-m-name)))
+
+;;;;;;;;;;;;;;;; types ;;;;;;;;;;;;;;;;
+
+  (define check-equal-type!
+    (lambda (t1 t2 exp)
+      (if (equal? t1 t2)
+        #t
+        (eopl:error 'type-of
+          "Types didn't match: ~s != ~s in~%~s"
+          (type-to-external-form t1)
+          (type-to-external-form t2)
+          exp))))
+
+  ;; check-is-subtype! : Type * Type * Exp -> Unspecified
+  ;; Page: 363
+  (define check-is-subtype!
+    (lambda (ty1 ty2 exp)
+      (if (is-subtype? ty1 ty2)
+        #t
+        (report-subtype-failure
+          (type-to-external-form ty1)
+          (type-to-external-form ty2)
+          exp))))
+
+  (define report-subtype-failure
+    (lambda (external-form-ty1 external-form-ty2 exp)
+      (eopl:error 'check-is-subtype!
+          "~s is not a subtype of ~s in ~%~s"
+          external-form-ty1
+          external-form-ty2
+          exp)))
+
+  ;; need this for typing cast expressions
+  ;; is-subtype? : Type * Type -> Bool
+  ;; Page: 363
+  (define is-subtype? 
+    (lambda (ty1 ty2)
+      (cases type ty1
+        (class-type (name1)
+          (cases type ty2
+            (class-type (name2)
+              (statically-is-subclass? name1 name2))
+            (else #f)))
+        (proc-type (args1 res1)
+          (cases type ty2
+            (proc-type (args2 res2)
+              (and
+                (every2? is-subtype? args2 args1)
+                (is-subtype? res1 res2)))
+            (else #f)))
+        (else (equal? ty1 ty2)))))
+
+  (define andmap
+    (lambda (pred lst1 lst2)
+      (cond
+        ((and (null? lst1) (null? lst2)) #t)
+        ((or (null? lst1) (null? lst2)) #f) ; or maybe throw error
+        ((pred (car lst1) (car lst2))
+         (andmap pred (cdr lst1) (cdr lst2)))
+        (else #f))))
+
+  (define every2? andmap)
+
+  ;; statically-is-subclass? : ClassName * ClassName -> Bool
+  ;; Page: 363
+  (define statically-is-subclass?
+    (lambda (name1 name2)
+      (or
+        (eqv? name1 name2)
+        (let ((super-name
+                (static-class->super-name
+                  (lookup-static-class name1))))
+          (if super-name
+            (statically-is-subclass? super-name name2)
+            #f))
+        (let ((interface-names
+                (static-class->interface-names
+                  (lookup-static-class name1))))
+          (memv name2 interface-names)))))
+
+  (define report-bad-type-to-cast 
+    (lambda (type exp)
+      (eopl:error 'bad-type-to-case
+        "can't cast non-object; ~s had type ~s"
+        exp
+        (type-to-external-form type))))
+
+  (define report-bad-type-to-instanceof
+    (lambda (type exp)
+      (eopl:error 'bad-type-to-case
+        "can't apply instanceof to non-object; ~s had type ~s"
+        exp
+        (type-to-external-form type))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/typed-oo/classes.scm b/collects/tests/eopl/chapter9/typed-oo/classes.scm
new file mode 100755
index 0000000000..99ae77a583
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/classes.scm
@@ -0,0 +1,237 @@
+(module classes (lib "eopl.ss" "eopl")
+
+  (require "store.scm")
+  (require "lang.scm")
+
+  ;; object interface
+  (provide object object? new-object object->class-name object->fields)
+
+  ;; method interface
+  (provide method method? a-method find-method)
+  
+  ;; class interface
+  (provide lookup-class initialize-class-env! class->super-name)
+
+;;;;;;;;;;;;;;;; objects ;;;;;;;;;;;;;;;;
+
+  ;; an object consists of a symbol denoting its class, and a list of
+  ;; references representing the managed storage for the all the
+  ;; fields. 
+
+  (define-datatype object object? 
+    (an-object
+      (class-name symbol?)
+      (fields (list-of reference?))))
+
+  (define new-object                      
+    (lambda (class-name)
+      (an-object
+        class-name
+        (map 
+          (lambda (field-id)
+            (newref (list 'uninitialized-field field-id)))
+          (class->field-names (lookup-class class-name))))))
+
+;;;;;;;;;;;;;;;; methods and method environments ;;;;;;;;;;;;;;;;
+
+  (define-datatype method method?
+    (a-method
+      (vars (list-of symbol?))
+      (body expression?)
+      (super-name symbol?)
+      (field-names (list-of symbol?))))
+
+;;;;;;;;;;;;;;;; method environments ;;;;;;;;;;;;;;;;
+
+  ;; a method environment looks like ((method-name method) ...)
+
+  (define method-environment?
+    (list-of 
+      (lambda (p)
+        (and 
+          (pair? p)
+          (symbol? (car p))
+          (method? (cadr p))))))
+
+  ;; method-env * id -> (maybe method)
+  (define assq-method-env
+    (lambda (m-env id)
+      (cond
+        ((assq id m-env) => cadr)
+        (else #f))))
+
+  ;; find-method : Sym * Sym -> Method
+  ;; Page: 345
+  (define find-method
+    (lambda (c-name name)
+      (let ((m-env (class->method-env (lookup-class c-name))))
+        (let ((maybe-pair (assq name m-env)))
+          (if (pair? maybe-pair) (cadr maybe-pair)
+            (report-method-not-found name))))))
+
+  (define report-method-not-found
+    (lambda (name)
+      (eopl:error 'find-method "unknown method ~s" name)))
+
+  ;; merge-method-envs : MethodEnv * MethodEnv -> MethodEnv
+  ;; Page: 345
+  (define merge-method-envs
+    (lambda (super-m-env new-m-env)
+      (append new-m-env super-m-env)))
+
+  ;; method-decls->method-env :
+  ;; Listof(MethodDecl) * ClassName * Listof(FieldName) -> MethodEnv
+  ;; Page: 345
+  (define method-decls->method-env
+    (lambda (m-decls super-name field-names)
+      (map
+        (lambda (m-decl)
+          (cases method-decl m-decl
+            (a-method-decl (result-type method-name vars var-types body)
+              (list method-name
+                (a-method vars body super-name field-names)))))
+        m-decls)))
+
+;;;;;;;;;;;;;;;; classes ;;;;;;;;;;;;;;;;
+
+  (define-datatype class class?
+    (a-class
+      (super-name (maybe symbol?))
+      (field-names (list-of symbol?))
+      (method-env method-environment?)))
+
+;;;;;;;;;;;;;;;; class environments ;;;;;;;;;;;;;;;;
+
+  ;; the-class-env will look like ((class-name class) ...)
+
+  ;; the-class-env : ClassEnv
+  ;; Page: 343
+  (define the-class-env '())
+
+  ;; add-to-class-env! : ClassName * Class -> Unspecified
+  ;; Page: 343
+  (define add-to-class-env!
+    (lambda (class-name class)
+      (set! the-class-env
+        (cons
+          (list class-name class)
+          the-class-env))))
+
+  ;; lookup-class : ClassName -> Class
+  (define lookup-class                    
+    (lambda (name)
+      (let ((maybe-pair (assq name the-class-env)))
+        (if maybe-pair (cadr maybe-pair)
+          (report-unknown-class name)))))
+
+  (define report-unknown-class
+    (lambda (name)
+      (eopl:error 'lookup-class "Unknown class ~s" name)))
+
+  ;; constructing classes
+
+  ;; initialize-class-env! : Listof(ClassDecl) -> Unspecified
+  ;; Page: 344
+  (define initialize-class-env!
+    (lambda (c-decls)
+      (set! the-class-env 
+        (list
+          (list 'object (a-class #f '() '()))))
+      (for-each initialize-class-decl! c-decls)))
+
+  '(define initialize-class-env!
+    (lambda (c-decls)
+      (set! the-class-env 
+        (list
+          (list 'object (a-class #f '() '()))))
+      (for-each initialize-class-decl! c-decls)))
+
+  ;; initialize-class-decl! : ClassDecl -> Unspecified
+  (define initialize-class-decl!
+    (lambda (c-decl)
+      (cases class-decl c-decl
+        ;; interfaces don't affect runtime
+        (an-interface-decl (interface-name method-decls) '())
+        (a-class-decl (class-name super-name interface-names field-types field-names method-decls)
+          (let ((field-names
+                  (append-field-names
+                    (class->field-names (lookup-class super-name))
+                    field-names)))
+            (add-to-class-env!
+              class-name
+              (a-class
+                super-name
+                field-names
+                (merge-method-envs
+                  (class->method-env (lookup-class super-name))
+                  (method-decls->method-env
+                    method-decls super-name field-names)))))))))
+
+  ;; append-field-names :  Listof(FieldName) * Listof(FieldName) 
+  ;;                       -> Listof(FieldName)
+  ;; Page: 344
+  ;; like append, except that any super-field that is shadowed by a
+  ;; new-field is replaced by a gensym
+  (define append-field-names
+    (lambda (super-fields new-fields)
+      (cond
+        ((null? super-fields) new-fields)
+        (else
+         (cons 
+           (if (memq (car super-fields) new-fields)
+             (fresh-identifier (car super-fields))
+             (car super-fields))
+           (append-field-names
+             (cdr super-fields) new-fields))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;; selectors ;;;;;;;;;;;;;;;;
+
+  (define class->super-name
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name  field-names method-env)
+          super-name))))
+
+  (define class->field-names
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name field-names method-env)
+          field-names))))
+
+  (define class->method-env
+    (lambda (c-struct)
+      (cases class c-struct
+        (a-class (super-name field-names method-env)
+          method-env))))
+
+
+  (define object->class-name
+    (lambda (obj)
+      (cases object obj
+        (an-object (class-name fields)
+          class-name))))
+
+  (define object->fields
+    (lambda (obj)
+      (cases object obj
+        (an-object (class-decl fields)
+          fields))))
+
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  (define maybe
+    (lambda (pred)
+      (lambda (v)
+        (or (not v) (pred v)))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/typed-oo/data-structures.scm b/collects/tests/eopl/chapter9/typed-oo/data-structures.scm
new file mode 100755
index 0000000000..31bb79ea98
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/data-structures.scm
@@ -0,0 +1,115 @@
+(module data-structures (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")                  ; for expression?
+  (require "store.scm")                 ; for reference?
+  (require "classes.scm")               ; for object?
+
+  (provide (all-defined))               ; too many things to list
+
+;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
+
+;;; an expressed value is either a number, a boolean, a procval, or a
+;;; reference. 
+
+  (define-datatype expval expval?
+    (num-val
+      (value number?))
+    (bool-val
+      (boolean boolean?))
+    (proc-val 
+      (proc proc?))
+    (ref-val
+      (ref reference?))
+    (obj-val
+      (obj object?))
+    (list-val
+      (l (list-of expval?)))
+    )
+
+;;; extractors:
+
+  (define expval->num
+    (lambda (v)
+      (cases expval v
+	(num-val (num) num)
+	(else (expval-extractor-error 'num v)))))
+
+  (define expval->bool
+    (lambda (v)
+      (cases expval v
+	(bool-val (bool) bool)
+	(else (expval-extractor-error 'bool v)))))
+
+  (define expval->proc
+    (lambda (v)
+      (cases expval v
+	(proc-val (proc) proc)
+	(else (expval-extractor-error 'proc v)))))
+
+  (define expval->ref
+    (lambda (v)
+      (cases expval v
+	(ref-val (ref) ref)
+	(else (expval-extractor-error 'reference v)))))
+
+  (define expval-extractor-error
+    (lambda (variant value)
+      (eopl:error 'expval-extractors "Looking for a ~s, found ~s"
+	variant value)))
+
+;;;;;;;;;;;;;;;; procedures ;;;;;;;;;;;;;;;;
+
+  (define-datatype proc proc?
+    (procedure
+      (vars (list-of symbol?))
+      (body expression?)
+      (env environment?)))
+  
+  (define-datatype environment environment?
+    (empty-env)
+    (extend-env 
+      (bvars (list-of symbol?))
+      (bvals (list-of reference?))
+      (saved-env environment?))
+    (extend-env-rec**
+      (proc-names (list-of symbol?))
+      (b-vars (list-of (list-of symbol?)))
+      (proc-bodies (list-of expression?))
+      (saved-env environment?))
+    (extend-env-with-self-and-super
+      (self object?)
+      (super-name symbol?)
+      (saved-env environment?)))
+
+  ;; env->list : Env -> List
+  ;; used for pretty-printing and debugging
+  (define env->list
+    (lambda (env)
+      (cases environment env
+	(empty-env () '())
+	(extend-env (sym val saved-env)
+	  (cons
+	    (list sym val)
+	    (env->list saved-env)))
+	(extend-env-rec** (p-names b-varss p-bodies saved-env)
+	  (cons
+	    (list 'letrec p-names '...)
+	    (env->list saved-env)))
+        (extend-env-with-self-and-super (self super-name saved-env)
+          (cons
+            (list 'self self 'super super-name)
+            (env->list saved-env))))))
+
+  ;; expval->printable : ExpVal -> List
+  ;; returns a value like its argument, except procedures get cleaned
+  ;; up with env->list 
+  (define expval->printable
+    (lambda (val)
+      (cases expval val
+	(proc-val (p)
+	  (cases proc p
+	    (procedure (var body saved-env)
+	      (list 'procedure var '... (env->list saved-env)))))
+	(else val))))
+
+  )
diff --git a/collects/tests/eopl/chapter9/typed-oo/drscheme-init.scm b/collects/tests/eopl/chapter9/typed-oo/drscheme-init.scm
new file mode 100755
index 0000000000..bc39938a6a
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/drscheme-init.scm
@@ -0,0 +1,129 @@
+;; drscheme-init.scm - compatibility file for DrScheme
+;; usage: (require "drscheme-init.scm")
+
+;;; makes structs printable, and provides basic functionality for
+;;; testing.  This includes pretty-printing and tracing.
+
+(module drscheme-init mzscheme
+  
+  ;; show the contents of define-datatype values
+  (print-struct #t)
+
+  (require (lib "pretty.ss"))
+  (provide (all-from (lib "pretty.ss")))
+
+  (require (lib "trace.ss"))
+  (provide (all-from (lib "trace.ss")))
+
+  (provide make-parameter)
+
+  (provide 
+   run-experiment
+   run-tests!
+   stop-after-first-error
+   run-quietly
+   )
+  
+  ;; safely apply procedure fn to a list of args.
+  ;; if successful, return (cons #t val)
+  ;; if eopl:error is invoked, returns (cons #f string), where string is the
+  ;; format string generated by eopl:error.  If somebody manages to raise a 
+  ;; value other than an exception, then the raised value is reported.
+  
+  (define apply-safely
+    (lambda (proc args)
+      (with-handlers ([(lambda (exn) #t)      ; catch any error
+                       (lambda (exn)          ; evaluate to a failed test result
+                         (cons #f 
+                               (if (exn? exn)
+                                   (exn-message exn)
+                                   exn)))])  
+        (let ([actual (apply proc args)])
+          (cons #t actual)))))
+
+  ;; run-experiment :
+  ;;  ((a ...) -> b) * (a ...) * b * (b * b -> bool)
+  ;;  -> (cons bool b)
+  
+  ;; usage: (run-experiment fn args correct-answer equal-answer?)
+  ;; Applies fn to args.  Compares the result to correct-answer. 
+  ;; Returns (cons bool b) where bool indicates whether the
+  ;; answer is correct.
+
+  (define run-experiment
+    (lambda (fn args correct-answer equal-answer?)
+      (let*
+          ((result (apply-safely fn args))
+           ;; ans is either the answer or the args to eopl:error
+           (error-thrown? (not (car result)))
+           (ans (cdr result)))
+          
+        (cons
+         (if (eqv? correct-answer 'error)
+             error-thrown?
+             (equal-answer? ans correct-answer))
+         ans))))
+  
+  (define stop-after-first-error (make-parameter #f))
+  (define run-quietly (make-parameter #t))
+   
+  ;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
+  ;;             -> unspecified
+
+  ;; where:
+  ;; test ::= (name arg outcome)
+  ;; outcome ::= ERROR | any
+  
+  ;; usage: (run-tests! run-fn equal-answer? tests)
+
+  ;; for each item in tests, apply run-fn to the arg.  Check to see if
+  ;; the outcome is right, comparing values using equal-answer?.
+
+  ;; print a log of the tests.
+
+  ;; at the end, print either "no bugs found" or the list of tests
+  ;; failed. 
+  
+  ;; Normally, run-tests! will recover from any error and continue to
+  ;; the end of the test suite.  This behavior can be altered by
+  ;; setting (stop-after-first-error #t).
+
+  (define (run-tests! run-fn equal-answer? tests)
+    (let ((tests-failed '()))
+      (for-each
+       (lambda (test-item)
+         (let ((name (car test-item))
+               (pgm (cadr test-item))
+               (correct-answer (caddr test-item)))
+           (printf "test: ~a~%" name)
+           (let* ((result
+                   (run-experiment
+		     run-fn (list pgm) correct-answer equal-answer?))
+                  (correct? (car result))
+                  (actual-answer (cdr result)))
+             (if (or
+                   (not correct?)
+                   (not (run-quietly)))
+               (begin
+                 (printf "~a~%" pgm)
+                 (printf "correct outcome: ~a~%" correct-answer)
+                 (printf "actual outcome:  ")
+                 (pretty-display actual-answer)))
+             (if correct?
+                 (printf "correct~%~%")
+                 (begin
+                   (printf "incorrect~%~%")
+                   ;; stop on first error if stop-after-first? is set:
+                   (if (stop-after-first-error)
+                       (error name "incorrect outcome detected")) 
+                   (set! tests-failed
+                         (cons name tests-failed)))))))
+       tests)
+      (if (null? tests-failed)
+          (printf "no bugs found~%")
+          (printf "incorrect answers on tests: ~a~%"
+            (reverse tests-failed)))))
+
+  )  
+  
+  
diff --git a/collects/tests/eopl/chapter9/typed-oo/environments.scm b/collects/tests/eopl/chapter9/typed-oo/environments.scm
new file mode 100755
index 0000000000..a14b168dd2
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/environments.scm
@@ -0,0 +1,76 @@
+(module environments (lib "eopl.ss" "eopl") 
+  
+  (require "data-structures.scm")
+  (require "store.scm")
+  (provide init-env empty-env extend-env apply-env env->list)
+
+;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
+  
+  ;; init-env : () -> environment
+
+  ;; (init-env) builds an environment in which i is bound to the
+  ;; expressed value 1, v is bound to the expressed value 5, and x is
+  ;; bound to the expressed value 10.  
+
+  (define init-env 
+    (lambda ()
+      (extend-env1
+        'i (newref (num-val 1))
+        (extend-env1
+          'v (newref (num-val 5))
+          (extend-env1
+            'x (newref (num-val 10))
+            (empty-env))))))
+
+  (define extend-env1
+    (lambda (id val env)
+      (extend-env (list id) (list val) env)))
+
+;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
+
+  (define apply-env
+    (lambda (env search-sym)
+      (cases environment env
+        (empty-env ()
+          (eopl:error 'apply-env "No binding for ~s" search-sym))
+        (extend-env (bvars bvals saved-env)
+          (cond
+            ((location search-sym bvars)
+             => (lambda (n)
+                  (list-ref bvals n)))
+            (else
+              (apply-env saved-env search-sym))))
+        (extend-env-rec** (p-names b-varss p-bodies saved-env)
+          (cond 
+            ((location search-sym p-names)
+             => (lambda (n)
+                  (newref
+                    (proc-val
+                      (procedure 
+                        (list-ref b-varss n)
+                        (list-ref p-bodies n)
+                        env)))))
+            (else (apply-env saved-env search-sym))))
+        (extend-env-with-self-and-super (self super-name saved-env)
+          (case search-sym
+            ((%self) self)
+            ((%super) super-name)
+            (else (apply-env saved-env search-sym)))))))
+
+  ;; location : Sym * Listof(Sym) -> Maybe(Int)
+  ;; (location sym syms) returns the location of sym in syms or #f is
+  ;; sym is not in syms.  We can specify this as follows:
+  ;; if (memv sym syms)
+  ;;   then (list-ref syms (location sym syms)) = sym
+  ;;   else (location sym syms) = #f
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms))
+         => (lambda (n) 
+              (+ n 1)))
+        (else #f))))
+
+  )
diff --git a/collects/tests/eopl/chapter9/typed-oo/interp.scm b/collects/tests/eopl/chapter9/typed-oo/interp.scm
new file mode 100755
index 0000000000..3c66903afd
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/interp.scm
@@ -0,0 +1,242 @@
+(module interp (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+
+  (require "lang.scm")
+  (require "data-structures.scm")
+  (require "environments.scm")
+  (require "store.scm")
+  (require "classes.scm")
+  
+  (provide value-of-program value-of instrument-let instrument-newref)
+
+;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;
+
+  (define instrument-let (make-parameter #f))
+
+  ;; say (instrument-let #t) to turn instrumentation on.
+  ;;     (instrument-let #f) to turn it off again.
+
+;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
+
+  ;; value-of-program : Program -> ExpVal
+  ;; Page: 336
+  (define value-of-program 
+    (lambda (pgm)
+      (initialize-store!)             
+      (cases program pgm
+        (a-program (class-decls body)
+          (initialize-class-env! class-decls)
+          (value-of body (init-env))))))
+
+  ;; value-of : Exp * Env -> ExpVal
+  ;; Page: 356
+  (define value-of
+    (lambda (exp env)
+      (cases expression exp
+
+        (const-exp (num) (num-val num))
+
+        (var-exp (var) (deref (apply-env env var)))
+
+        (diff-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (- val1 val2))))
+        
+        (sum-exp (exp1 exp2)
+          (let ((val1
+		  (expval->num
+		    (value-of exp1 env)))
+                (val2
+		  (expval->num
+		    (value-of exp2 env))))
+            (num-val
+	      (+ val1 val2))))
+
+        (zero?-exp (exp1)
+	  (let ((val1 (expval->num (value-of exp1 env))))
+	    (if (zero? val1)
+	      (bool-val #t)
+	      (bool-val #f))))
+
+        (if-exp (exp0 exp1 exp2) 
+          (if (expval->bool (value-of exp0 env))
+            (value-of exp1 env)
+            (value-of exp2 env)))
+
+        (let-exp (vars exps body)       
+	  (if (instrument-let)
+	    (eopl:printf "entering let ~s~%" vars))
+          (let ((new-env 
+                  (extend-env 
+                    vars
+                    (map newref (values-of-exps exps env))
+                    env)))
+            (if (instrument-let)
+              (begin
+                (eopl:printf "entering body of let ~s with env =~%" vars)
+                (pretty-print (env->list new-env))
+                (eopl:printf "store =~%")
+                (pretty-print (store->readable (get-store-as-list)))
+                (eopl:printf "~%")
+                ))
+            (value-of body new-env)))
+
+        (proc-exp (bvars types body)
+	  (proc-val
+	    (procedure bvars body env)))
+
+        (call-exp (rator rands)          
+          (let ((proc (expval->proc (value-of rator env)))
+                (args (values-of-exps rands env)))
+	    (apply-procedure proc args)))
+
+        (letrec-exp (result-types p-names b-varss b-vartypess p-bodies letrec-body)
+          (value-of letrec-body
+            (extend-env-rec** p-names b-varss p-bodies env)))
+
+        (begin-exp (exp1 exps)
+          (letrec 
+            ((value-of-begins
+               (lambda (e1 es)
+                 (let ((v1 (value-of e1 env)))
+                   (if (null? es)
+                     v1
+                     (value-of-begins (car es) (cdr es)))))))
+            (value-of-begins exp1 exps)))
+
+        (assign-exp (x e)
+          (begin
+            (setref!
+              (apply-env env x)
+              (value-of e env))
+            (num-val 27)))
+
+        ;; args need to be non-empty for type checker
+        (list-exp (exp exps)
+          (list-val
+            (cons (value-of exp env)
+              (values-of-exps exps env))))
+
+        (new-object-exp (class-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (new-object class-name)))
+            (apply-method
+              (find-method class-name 'initialize)
+              obj
+              args)
+            obj))
+
+        (self-exp ()
+          (apply-env env '%self))
+
+        (method-call-exp (obj-exp method-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (value-of obj-exp env)))
+            (apply-method
+              (find-method (object->class-name obj) method-name)
+              obj
+              args)))
+
+        (super-call-exp (method-name rands)
+          (let ((args (values-of-exps rands env))
+                (obj (apply-env env '%self)))
+            (apply-method
+              (find-method (apply-env env '%super) method-name)
+              obj
+              args)))
+
+        ;; new cases for typed-oo
+
+        (cast-exp (exp c-name)
+          (let ((obj (value-of exp env)))
+            (if (is-subclass? (object->class-name obj) c-name)
+              obj
+              (report-cast-error c-name obj))))
+
+        (instanceof-exp (exp c-name)
+          (let ((obj (value-of exp env)))
+            (if (is-subclass? (object->class-name obj) c-name)
+              (bool-val #t)
+              (bool-val #f))))
+
+        )))
+
+  (define report-cast-error
+    (lambda (c-name obj)
+      (eopl:error 'value-of "Can't cast object to type ~s:~%~s" c-name obj)))
+
+  ;; apply-procedure : Proc * Listof(ExpVal) -> ExpVal
+  (define apply-procedure
+    (lambda (proc1 args)
+      (cases proc proc1
+        (procedure (vars body saved-env)
+          (let ((new-env
+                  (extend-env
+                    vars
+                    (map newref args)
+                    saved-env)))
+            (if (instrument-let)
+              (begin
+                (eopl:printf
+                  "entering body of proc ~s with env =~%"
+                  vars)
+                (pretty-print (env->list new-env)) 
+                (eopl:printf "store =~%")
+                (pretty-print (store->readable (get-store-as-list)))
+                (eopl:printf "~%")))
+            (value-of body new-env))))))
+  
+  ;; apply-method : Method * Obj * Listof(ExpVal) -> ExpVal
+  (define apply-method                    
+    (lambda (m self args)
+      (cases method m
+        (a-method (vars body super-name field-names)
+          (value-of body
+            (extend-env vars (map newref args)
+              (extend-env-with-self-and-super
+                self super-name
+                (extend-env field-names (object->fields self)
+                  (empty-env)))))))))
+  ;; exercise: add instrumentation to apply-method, like that for
+  ;; apply-procedure. 
+
+  (define values-of-exps
+    (lambda (exps env)
+      (map
+        (lambda (exp) (value-of exp env))
+        exps)))
+
+  ;; is-subclass? : ClassName * ClassName -> Bool
+  ;; Page: 357
+  (define is-subclass?
+    (lambda (c-name1 c-name2)
+      (if (eqv? c-name1 c-name2)
+        #t
+        (let ((s-name (class->super-name (lookup-class c-name1))))
+          (if s-name
+            (is-subclass? s-name c-name2)
+            #f)))))
+
+  ;; store->readable : Listof(List(Ref,Expval)) 
+  ;;                    -> Listof(List(Ref,Something-Readable))
+  (define store->readable
+    (lambda (l)
+      (map
+        (lambda (p)
+          (cons
+            (car p)
+            (expval->printable (cadr p))))
+        l)))
+       
+  )
+  
+
+
+  
diff --git a/collects/tests/eopl/chapter9/typed-oo/lang.scm b/collects/tests/eopl/chapter9/typed-oo/lang.scm
new file mode 100755
index 0000000000..916e3ddc93
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/lang.scm
@@ -0,0 +1,207 @@
+(module lang (lib "eopl.ss" "eopl")
+  
+  ;; grammar for the TYPED-OO language.  Based on IMPLICIT-REFS:
+  ;; plus
+  ;;   multiple-argument procedures
+  ;;   multiple-declaration letrecs, and
+  ;;   multiple-declaration lets, 
+  ;;   types a la CHECKED (not INFERRED)
+  ;;   lists of expressed values
+
+  (require "drscheme-init.scm")
+  
+  (provide (all-defined))
+
+  ;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
+  
+  (define the-lexical-spec
+    '((whitespace (whitespace) skip)
+      (comment ("%" (arbno (not #\newline))) skip)
+      (identifier
+        (letter (arbno (or letter digit "_" "-" "?")))
+        symbol)
+      (number (digit (arbno digit)) number)
+      (number ("-" digit (arbno digit)) number)
+      ))
+  
+  (define the-grammar
+    '((program ((arbno class-decl) expression) a-program)
+
+      (expression (number) const-exp)
+      (expression
+        ("-" "(" expression "," expression ")")
+        diff-exp)
+
+      (expression
+        ("+" "(" expression "," expression ")")
+        sum-exp)
+      
+      (expression
+        ("zero?" "(" expression ")")
+        zero?-exp)
+
+      (expression
+        ("if" expression "then" expression "else" expression)
+        if-exp)
+
+      (expression (identifier) var-exp)
+
+      (expression
+        ("let" (arbno identifier "=" expression) "in" expression)
+        let-exp)   
+
+      (expression
+        ("proc" "(" (separated-list identifier ":" type ",") ")" expression)
+        proc-exp)
+
+      (expression
+        ("(" expression (arbno expression) ")")
+        call-exp)
+
+      (expression
+        ("letrec"
+          (arbno type identifier "(" (separated-list identifier ":" type ",") ")"
+            "=" expression)
+          "in" expression)
+        letrec-exp)
+      
+      (expression
+        ("begin" expression (arbno ";" expression) "end")
+        begin-exp)
+
+      (expression
+        ("set" identifier "=" expression)
+        assign-exp)
+
+      ;; non-empty lists for typechecked version
+      (expression
+        ("list" "(" expression (arbno "," expression) ")" )
+        list-exp)
+
+      ;; new productions for oop
+
+      (class-decl                         
+        ("class" identifier 
+          "extends" identifier 
+          (arbno "implements" identifier)
+          (arbno "field" type identifier)
+          (arbno method-decl)
+          )
+        a-class-decl)
+
+      (method-decl
+        ("method" type identifier
+          "("  (separated-list identifier  ":" type ",") ")" ; method formals
+          expression
+          )
+        a-method-decl)
+
+      (expression 
+        ("new" identifier "(" (separated-list expression ",") ")")
+        new-object-exp)
+
+      ;; this is special-cased to prevent it from mutation
+      (expression
+        ("self")
+        self-exp)
+
+      (expression
+        ("send" expression identifier
+          "("  (separated-list expression ",") ")")
+        method-call-exp)
+
+      (expression                                
+        ("super" identifier    "("  (separated-list expression ",") ")")
+        super-call-exp)
+
+      ;; new productions for typed-oo
+
+      (class-decl
+        ("interface" identifier (arbno abstract-method-decl))
+        an-interface-decl)
+
+
+      (abstract-method-decl
+        ("method" type identifier 
+          "("  (separated-list identifier ":" type ",") ")" )
+        an-abstract-method-decl)
+
+      (expression
+        ("cast" expression identifier)
+        cast-exp)
+
+      (expression
+        ("instanceof" expression identifier)
+        instanceof-exp)
+
+      (type ("int") int-type)             
+      (type ("bool") bool-type)           
+      (type ("void") void-type)      
+      (type                               
+        ("(" (separated-list type "*") "->" type ")")
+        proc-type)
+      (type
+        ("listof" type)
+        list-type)
+
+      (type (identifier) class-type) ;; new for typed oo
+
+      ))
+
+  ;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
+  
+  (sllgen:make-define-datatypes the-lexical-spec the-grammar)
+  
+  (define show-the-datatypes
+    (lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
+  
+  (define scan&parse
+    (sllgen:make-string-parser the-lexical-spec the-grammar))
+  
+  (define just-scan
+    (sllgen:make-string-scanner the-lexical-spec the-grammar))
+  
+;;;;;;;;;;;;;;;; syntactic operations on types ;;;;;;;;;;;;;;;;
+
+  (define type->class-name
+    (lambda (ty)
+      (cases type ty
+        (class-type (name) name)
+        (else (eopl:error 'type->class-name
+                "Not a class type: ~s"
+                ty)))))
+
+  (define class-type?
+    (lambda (ty)
+      (cases type ty
+        (class-type (name) #t)
+        (else #f))))
+
+  (define type-to-external-form
+    (lambda (ty)
+      (cases type ty
+        (int-type () 'int)
+        (bool-type () 'bool)
+        (void-type () 'void)
+        (class-type (name) name)
+        (list-type (ty) (list 'listof (type-to-external-form ty)))
+        (proc-type (arg-types result-type)
+          (append
+            (formal-types-to-external-form arg-types)
+            '(->)
+            (list (type-to-external-form result-type)))))))
+
+  (define formal-types-to-external-form
+    (lambda (types)
+      (if (null? types)
+        '()
+        (if (null? (cdr types))
+          (list (type-to-external-form (car types)))
+          (cons
+            (type-to-external-form (car types))
+            (cons '*
+              (formal-types-to-external-form (cdr types))))))))
+
+
+
+  )
diff --git a/collects/tests/eopl/chapter9/typed-oo/static-classes.scm b/collects/tests/eopl/chapter9/typed-oo/static-classes.scm
new file mode 100755
index 0000000000..90c0b36882
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/static-classes.scm
@@ -0,0 +1,266 @@
+(module static-classes (lib "eopl.ss" "eopl")
+
+  (require "lang.scm")
+  (require "static-data-structures.scm")
+
+  (provide (all-defined))
+
+;;;;;;;;;;;;;;;; method type environments ;;;;;;;;;;;;;;;;
+
+  ;; a method tenv looks like ((method-name type) ...)
+  ;; each method will have a proc-type
+
+  ;;;;;;;;;;;;;;;; static classes ;;;;;;;;;;;;;;;;
+
+  (define identifier? symbol?)
+
+  (define method-tenv?
+    (list-of 
+      (lambda (p)
+        (and 
+          (pair? p)
+          (symbol? (car p))
+          (type? (cadr p))))))
+
+  (define-datatype static-class static-class?
+    (a-static-class
+      (super-name (maybe identifier?))
+      (interface-names (list-of identifier?))
+      (field-names (list-of identifier?))
+      (field-types (list-of type?))
+      (method-tenv method-tenv?))
+    (an-interface
+      (method-tenv method-tenv?)))
+
+  ;; method-tenv * id -> (maybe type)
+  (define maybe-find-method-type
+    (lambda (m-env id)
+      (cond
+        ((assq id m-env) => cadr)
+        (else #f))))
+
+  ;; class-name * id -> type OR fail
+  (define find-method-type
+    (lambda (class-name id)
+      (let ((m (maybe-find-method-type 
+                 (static-class->method-tenv (lookup-static-class class-name))
+                 id)))
+        (if m m
+          (eopl:error 'find-method 
+            "unknown method ~s in class ~s"
+            id class-name)))))
+  
+  ;;;;;;;;;;;;;;;; the static class environment ;;;;;;;;;;;;;;;;
+
+  ;; the-static-class-env will look like ((class-name static-class) ...)
+
+  (define the-static-class-env '())
+
+  (define is-static-class?
+    (lambda (name)
+      (assq name the-static-class-env)))
+
+  (define lookup-static-class                    
+    (lambda (name)
+      (cond
+        ((assq name the-static-class-env)
+         => (lambda (pair) (cadr pair)))
+        (else (eopl:error 'lookup-static-class
+                "Unknown class: ~s" name)))))
+
+  (define empty-the-static-class-env!
+    (lambda ()
+      (set! the-static-class-env '())))
+
+  (define add-static-class-binding!
+    (lambda (name sc)
+      (set! the-static-class-env
+        (cons
+          (list name sc)
+          the-static-class-env))))
+
+
+  ;;;;;;;;;;;;;;;; class declarations, etc. ;;;;;;;;;;;;;;;;
+
+  ;; first, pull out all the types and put them in
+  ;; the-static-class-env.
+
+  ;; initialize-static-class-env! : Listof(ClassDecl) -> Unspecified
+  ;; Page: 362
+  (define initialize-static-class-env!
+    (lambda (c-decls)
+      (empty-the-static-class-env!)
+      (add-static-class-binding!
+        'object (a-static-class #f '() '() '() '()))
+      (for-each add-class-decl-to-static-class-env! c-decls)))
+
+  ;; add-class-decl-to-static-class-env! : ClassDecl -> Unspecified
+  ;; Page 366
+  (define add-class-decl-to-static-class-env!
+    (lambda (c-decl)
+      (cases class-decl c-decl 
+        (an-interface-decl (i-name abs-m-decls)
+          (let ((m-tenv
+                  (abs-method-decls->method-tenv abs-m-decls)))
+            (check-no-dups! (map car m-tenv) i-name)
+            (add-static-class-binding!
+              i-name (an-interface m-tenv))))
+        (a-class-decl (c-name s-name i-names
+                        f-types f-names m-decls)
+          (let ((i-names
+                  (append
+                    (static-class->interface-names
+                      (lookup-static-class s-name))
+                    i-names))
+                (f-names
+                  (append-field-names
+                    (static-class->field-names
+                      (lookup-static-class s-name))
+                    f-names))
+                (f-types
+                  (append
+                    (static-class->field-types
+                      (lookup-static-class s-name))
+                    f-types))
+                (method-tenv
+                  (let ((local-method-tenv
+                          (method-decls->method-tenv m-decls)))
+                    (check-no-dups!
+                      (map car local-method-tenv) c-name)
+                    (merge-method-tenvs
+                      (static-class->method-tenv
+                        (lookup-static-class s-name))
+                      local-method-tenv))))
+            (check-no-dups! i-names c-name)
+            (check-no-dups! f-names c-name)
+            (check-for-initialize! method-tenv c-name)
+            (add-static-class-binding! c-name
+              (a-static-class
+                s-name i-names f-names f-types method-tenv)))))))
+
+  (define abs-method-decls->method-tenv
+    (lambda (abs-m-decls)
+      (map 
+        (lambda (abs-m-decl)
+          (cases abstract-method-decl abs-m-decl
+            (an-abstract-method-decl (result-type m-name arg-ids arg-types)
+              (list m-name (proc-type arg-types result-type)))))
+        abs-m-decls)))
+
+
+  (define method-decls->method-tenv
+    (lambda (m-decls)
+      (map 
+        (lambda (m-decl)
+          (cases method-decl m-decl
+            (a-method-decl (result-type m-name arg-ids arg-types body)
+              (list m-name (proc-type arg-types result-type)))))
+        m-decls)))
+            
+  ;; append-field-names :  Listof(FieldName) * Listof(FieldName) 
+  ;;                       -> Listof(FieldName)
+  ;; Page: 344
+  ;; like append, except that any super-field that is shadowed by a
+  ;; new-field is replaced by a gensym
+  (define append-field-names
+    (lambda (super-fields new-fields)
+      (cond
+        ((null? super-fields) new-fields)
+        (else
+         (cons 
+           (if (memq (car super-fields) new-fields)
+             (fresh-identifier (car super-fields))
+             (car super-fields))
+           (append-field-names
+             (cdr super-fields) new-fields))))))
+
+  ;; new methods override old ones.  
+  (define merge-method-tenvs
+    (lambda (super-tenv new-tenv)
+      (append new-tenv super-tenv)))
+
+  (define check-for-initialize!
+    (lambda (method-tenv class-name)
+      (if (not (maybe-find-method-type method-tenv 'initialize))
+        (eopl:error 'check-for-initialize!
+          "no initialize method in class ~s"
+          class-name))))
+
+
+;;;;;;;;;;;;;;;; selectors ;;;;;;;;;;;;;;;;
+
+  (define static-class->super-name
+    (lambda (sc)
+      (cases static-class sc
+        (a-static-class (super-name interface-names
+                          field-names field-types method-types)
+          super-name)
+        (else (report-static-class-extractor-error 'super-name sc)))))
+
+
+  (define static-class->interface-names                               
+    (lambda (sc)
+      (cases static-class sc
+        (a-static-class (super-name interface-names
+                          field-names field-types method-types)
+          interface-names)
+        (else (report-static-class-extractor-error 'interface-names sc)))))
+
+
+  (define static-class->field-names
+    (lambda (sc)
+      (cases static-class sc
+        (a-static-class (super-name interface-names
+                          field-names field-types method-types)
+          field-names)
+        (else (report-static-class-extractor-error 'field-names sc)))))
+
+  (define static-class->field-types
+    (lambda (sc)
+      (cases static-class sc
+        (a-static-class (super-name interface-names
+                          field-names field-types method-types)
+          field-types)
+        (else (report-static-class-extractor-error 'field-types sc)))))
+
+  (define static-class->method-tenv
+    (lambda (sc)
+      (cases static-class sc
+        (a-static-class (super-name interface-names
+                          field-names field-types method-tenv)
+          method-tenv)
+        (an-interface (method-tenv) method-tenv))))
+
+  (define report-static-class-extractor-error
+    (lambda (sym sc)
+      (eopl:error 'static-class-extractors
+        "can't take ~s of interface ~s"
+        sym sc)))
+
+  ;; Listof(SchemeVal) * SchemeVal -> Unspecified
+  (define check-no-dups!
+    (lambda (lst blamee)
+      (let loop ((rest lst))
+        (cond
+          ((null? rest) #t)
+          ((memv (car rest) (cdr rest))
+           (eopl:error 'check-no-dups! "duplicate found among ~s in class ~s" lst
+             blamee))
+          (else (loop (cdr rest)))))))
+
+  (define fresh-identifier
+    (let ((sn 0))
+      (lambda (identifier)  
+        (set! sn (+ sn 1))
+        (string->symbol
+          (string-append
+            (symbol->string identifier)
+            "%"             ; this can't appear in an input identifier
+            (number->string sn))))))
+
+  (define maybe
+    (lambda (pred)
+      (lambda (v)
+        (or (not v) (pred v)))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/typed-oo/static-data-structures.scm b/collects/tests/eopl/chapter9/typed-oo/static-data-structures.scm
new file mode 100755
index 0000000000..ba29924925
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/static-data-structures.scm
@@ -0,0 +1,56 @@
+(module static-data-structures (lib "eopl.ss" "eopl")
+
+  ;; type environments and associated procedures.
+  ;; In chapter7/checked, this is in checker.scm.
+
+  (require "lang.scm")
+
+  (provide (all-defined))
+
+;;;;;;;;;;;;;;;; type environments ;;;;;;;;;;;;;;;;
+
+  (define-datatype type-environment type-environment?
+    (empty-tenv)
+    (extend-tenv
+      (syms (list-of symbol?))
+      (vals (list-of type?))
+      (tenv type-environment?))
+    (extend-tenv-with-self-and-super
+      (self type?)
+      (super-name symbol?)
+      (saved-env type-environment?)))
+
+  (define init-tenv
+    (lambda ()
+      (extend-tenv
+        '(i v x)
+        (list (int-type) (int-type) (int-type))
+        (empty-tenv))))
+
+  (define apply-tenv
+    (lambda (env search-sym)
+      (cases type-environment env
+        (empty-tenv ()
+          (eopl:error 'apply-tenv "No type found for ~s" search-sym))
+        (extend-tenv (bvars types saved-env)
+          (cond
+            ((location search-sym bvars)
+             => (lambda (n) (list-ref types n)))
+            (else
+              (apply-tenv saved-env search-sym))))
+        (extend-tenv-with-self-and-super (self-name super-name saved-env)
+          (case search-sym
+            ((%self) self-name)
+            ((%super) super-name)
+            (else (apply-tenv saved-env search-sym)))))))
+
+  (define location
+    (lambda (sym syms)
+      (cond
+        ((null? syms) #f)
+        ((eqv? sym (car syms)) 0)
+        ((location sym (cdr syms)) => (lambda (n) (+ n 1)))
+        (else #f))))
+
+
+)
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/typed-oo/store.scm b/collects/tests/eopl/chapter9/typed-oo/store.scm
new file mode 100755
index 0000000000..f925bdcbda
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/store.scm
@@ -0,0 +1,110 @@
+(module store (lib "eopl.ss" "eopl")
+  
+  (require "drscheme-init.scm")
+   
+  (provide initialize-store! reference? newref deref setref!
+    instrument-newref get-store-as-list)
+  
+  (define instrument-newref (make-parameter #f))
+  
+  ;;;;;;;;;;;;;;;; references and the store ;;;;;;;;;;;;;;;;
+  
+  ;;; world's dumbest model of the store:  the store is a list and a
+  ;;; reference is number which denotes a position in the list.
+
+  ;; the-store: a Scheme variable containing the current state of the
+  ;; store.  Initially set to a dummy variable.
+  (define the-store 'uninitialized)
+
+  ;; empty-store : () -> Sto
+  ;; Page: 111
+  (define empty-store
+    (lambda () '()))
+  
+  ;; initialize-store! : () -> Sto
+  ;; usage: (initialize-store!) sets the-store to the empty-store
+  ;; Page 111
+  (define initialize-store!
+    (lambda ()
+      (set! the-store (empty-store))))
+
+  ;; get-store : () -> Sto
+  ;; Page: 111
+  ;; This is obsolete.  Replaced by get-store-as-list below
+  (define get-store
+    (lambda () the-store))
+
+  ;; reference? : SchemeVal -> Bool
+  ;; Page: 111
+  (define reference?
+    (lambda (v)
+      (integer? v)))
+
+  ;; newref : ExpVal -> Ref
+  ;; Page: 111
+  (define newref
+    (lambda (val)
+      (let ((next-ref (length the-store)))
+        (set! the-store
+              (append the-store (list val)))
+        (if (instrument-newref)
+            (eopl:printf 
+             "newref: allocating location ~s with initial contents ~s~%"
+             next-ref val))                     
+        next-ref)))                     
+
+  ;; deref : Ref -> ExpVal
+  ;; Page 111
+  (define deref 
+    (lambda (ref)
+      (list-ref the-store ref)))
+
+  ;; setref! : Ref * ExpVal -> Unspecified
+  ;; Page: 112
+  (define setref!                       
+    (lambda (ref val)
+      (set! the-store
+        (letrec
+          ((setref-inner
+             ;; returns a list like store1, except that position ref1
+             ;; contains val. 
+             (lambda (store1 ref1)
+               (cond
+                 ((null? store1)
+                  (report-invalid-reference ref the-store))
+                 ((zero? ref1)
+                  (cons val (cdr store1)))
+                 (else
+                   (cons
+                     (car store1)
+                     (setref-inner
+                       (cdr store1) (- ref1 1))))))))
+          (setref-inner the-store ref)))))
+
+  (define report-invalid-reference
+    (lambda (ref the-store)
+      (eopl:error 'setref
+        "illegal reference ~s in store ~s"
+        ref the-store)))
+
+  ;; get-store-as-list : () -> Listof(List(Ref,Expval))
+  ;; Exports the current state of the store as a scheme list.
+  ;; (get-store-as-list '(foo bar baz)) = ((0 foo)(1 bar) (2 baz))
+  ;;   where foo, bar, and baz are expvals.
+  ;; If the store were represented in a different way, this would be
+  ;; replaced by something cleverer.
+  ;; Replaces get-store (p. 111)
+   (define get-store-as-list
+     (lambda ()
+       (letrec
+         ((inner-loop
+            ;; convert sto to list as if its car was location n
+            (lambda (sto n)
+              (if (null? sto)
+                '()
+                (cons
+                  (list n (car sto))
+                  (inner-loop (cdr sto) (+ n 1)))))))
+         (inner-loop the-store 0))))
+
+  )
\ No newline at end of file
diff --git a/collects/tests/eopl/chapter9/typed-oo/tests.scm b/collects/tests/eopl/chapter9/typed-oo/tests.scm
new file mode 100755
index 0000000000..c4abcd625a
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/tests.scm
@@ -0,0 +1,1275 @@
+(module tests mzscheme
+  
+  (provide tests-for-run tests-for-check)
+  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
+  
+  (define tests-for-run
+    '(
+  
+      ;; simple arithmetic
+      (positive-const "11" 11)
+      (negative-const "-33" -33)
+      (simple-arith-1 "-(44,33)" 11)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" -11)
+      (nested-arith-right "-(55, -(22,11))" 44)
+  
+      ;; simple variables
+      (test-var-1 "x" 10)
+      (test-var-2 "-(x,1)" 9)
+      (test-var-3 "-(1,x)" -9)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(0) then 3 else 4" 3)
+      (if-false "if zero?(1) then 3 else 4" 4)
+      
+      ;; test dynamic typechecking
+      (no-bool-to-diff-1 "-(zero?(0),1)" error)
+      (no-bool-to-diff-2 "-(1,zero?(0))" error)
+      (no-int-to-if "if 1 then 2 else 3" error)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
+      (if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
+      
+      ;; and make sure the other arm doesn't get evaluated.
+      (if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
+      (if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" 3)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" 2)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" 29)
+      (interp-ignores-type-info-in-proc "(proc(x : (int -> int)) -(x,1)  30)" 29)
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" 29)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" 29)
+
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" -1)
+      (nested-procs2 "let f = proc(x : int) proc (y : int) -(x,y) in ((f -(10,5)) 6)"
+        -1)
+      
+       (y-combinator-1 "
+let fix =  proc (f : bool)
+            let d = proc (x : bool) proc (z : bool) ((f (x x)) z)
+            in proc (n : bool) ((f (d d)) n)
+in let
+    t4m = proc (f : bool) proc(x : bool) if zero?(x) then 0 else -((f -(x,1)),-4)
+in let times4 = (fix t4m)
+   in (times4 3)" 12)
+      
+       ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" 32)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x)  then 0 else -((f -(x,1)), -2) in (f 4)"
+        8)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
+        20)
+
+      (HO-nested-letrecs
+"letrec int even(odd : (int -> int))  = proc(x : int) if zero?(x) then 1 else (odd -(x,1))
+   in letrec  int odd(x : int)  = if zero?(x) then 0 else ((even odd) -(x,1))
+   in (odd 13)" 1)
+
+
+      ;;;;;;;;;;;;;;;; typed oop ;;;;;;;;;;;;;;;;
+
+    (test-self-1 "
+class c extends object 
+         field int s
+         method void initialize(v : int)set s = v
+         method void sets(v : int)set s = v    
+         method int gets()s
+         method void testit()send self sets(13)
+              
+let o = new c (11)
+       t1 = 0
+       t2 = 0
+   in begin 
+       set t1 = send o gets();
+       send o testit();
+       set t2 = send o gets();
+       list(t1,t2)
+      end" (11 13))
+
+    (counter-1 "
+class counter extends object
+  field int count
+   method void initialize()set count = 0
+   method void countup()set count = +(count,1)
+   method int getcount()count
+   
+let o1 = new counter ()
+    t1 = 0
+    t2 = 0
+in begin
+    set t1 = send o1 getcount();
+    send o1 countup();
+    set t2 = send o1 getcount();
+    list(t1,t2)
+end
+" (0 1))
+
+    (shared-counter-1 "
+class counter extends object
+  field int count
+   method void initialize()set count = 0
+   method void countup()set count = +(count,1)
+   method int getcount()count
+   
+class c1 extends object 
+   field int n
+   field counter counter1
+   method void initialize(a_counter : counter)
+    begin
+     set n = 0;
+     set counter1 = a_counter
+    end
+   method void countup()
+     begin
+      send counter1 countup();
+      set n = +(n,1)
+     end
+   method listof int getstate()list(n, send counter1 getcount())
+   
+let counter1 = new counter()
+in let o1 = new c1(counter1)
+       o2 = new c1(counter1)
+in begin
+     send o1 countup();
+     send o2 countup();
+     send o2 countup();
+     list( send o1 getstate(),
+           send o2 getstate())
+   end
+" ((1 3) (2 3)))
+
+
+    (inherit-1 "
+class c1 extends object 
+  field int ivar1
+  method void initialize()set ivar1 = 1
+  
+class c2 extends c1 
+  field int ivar2
+  method void initialize() 
+   begin
+    super initialize(); 
+    set ivar2 = 1
+   end
+  method void setiv1(n : int)set ivar1 = n
+  method int getiv1()ivar1
+  
+let o = new c2 ()
+    t1 = 0
+in begin
+       send o setiv1(33);
+       send o getiv1()
+   end                      
+" 33)
+
+    (inherit-3 "
+class c1 extends object 
+  method int initialize()1
+  method int m1()1
+  
+class c2 extends c1 
+  method int initialize()1 
+  method int m1()super m1()
+  method int m2()2
+  
+class c3 extends c2 
+  method int initialize()1
+  method int m1()3
+  method int m2()super m2()
+  method int m3()super m1()
+  
+let o = new c3 ()
+in list( send o m1(),
+         send o m2(),
+         send o m3()
+        )
+" (3 2 1))
+
+    (chris-1 "
+class aclass extends object 
+  field int i
+  method void initialize(x : int) set i = x
+  method int m(y : int) +(i,y)
+  
+let o1 = new aclass(3)
+in send o1 m(2)" 5)
+
+    (chris-2 "
+class c1 extends object 
+  method int initialize() 1
+  method int ma()1
+  method int mb()send self ma()
+  
+class c2 extends c1   % just use c1's initialize
+  method int ma() 2
+  
+let x = new c2 ()
+in list(send x ma(),send x mb())
+" (2 2))
+
+    (for-book-1 "
+class c1 extends object 
+  field int i
+  field int j
+  method void initialize(x : int) begin set i = x; set j = -(0,x) end
+  method void countup(d : int) begin set i = +(i,d); set j = -(j,d) end
+  method listof int getstate()list(i,j)
+  
+let o1 = new c1(3)
+    t1 = list(1)
+    t2 = list(1)
+in begin
+    set t1 = send o1 getstate();
+    send o1 countup(2);
+    set t2 = send o1 getstate();
+    list(t1,t2)
+   end" ((3 -3) (5 -5)))
+
+
+    (odd-even-via-self "
+class oddeven extends object 
+  method int initialize()1
+  method bool even(n : int)if zero?(n) then 1 else send self odd(-(n,1))
+  method bool odd(n : int) if zero?(n) then 0 else send self even(-(n,1))
+  
+let o1 = new oddeven() in send o1 odd(13)" 1)
+
+    (for-book-2 "
+class c1 extends object 
+  method int initialize()1
+  method int m1()1
+  method int m2()100
+  method int m3()send self m2()
+  
+class c2 extends c1 
+  method int initialize()1
+  method int m2()2
+  
+let o1 = new c1()
+    o2 = new c2()
+in list(send o1 m1(),           % returns 1
+        send o1 m2(),           % returns 100
+        send o1 m3(),           % returns 100
+        send o2 m1(),           % returns 1 (from c1)
+        send o2 m2(),           % returns 2 (from c2)
+        send o2 m3()            % returns 2 (c1's m3 calls c2's m2)
+       )
+" (1 100 100 1 2 2))
+
+    (sum-leaves "
+class tree extends object 
+  method int initialize()1
+  
+class interior_node extends tree 
+  field node left
+  field node right
+  method void initialize(l : node, r : node)
+   begin
+    set left = l; set right = r
+   end
+  method int sum()+(send left sum(), send right sum())
+  
+class leaf_node extends tree 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" 12)
+
+    (sum-leaves-2 "
+interface tree
+  method int sum (l : tree, r : tree)
+  
+class interior_node extends object
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum() +(send left sum(), send right sum())
+  
+class leaf_node extends object
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" 12)
+
+    (sum-leaves-with-abstract-method "
+interface tree
+  method int sum()
+  
+class interior_node extends object 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum()+(send left sum(), send right sum())
+  
+class leaf_node extends object 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   %% need subtyping to make this ok.
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" 12)
+
+
+    (equal-trees-1 "
+interface tree
+  method int sum()
+  method bool equal(t : tree)
+  
+class interior_node extends object 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method tree getleft()left
+  method tree getright()right
+  method int sum()+(send left sum(), send right sum())
+  method bool equal(t : tree) 
+    if instanceof t interior_node
+     then if send left equal(send cast t interior_node getleft())
+          then send right equal(send cast t interior_node getright())
+          else false
+     else false 
+     
+  
+class leaf_node extends object 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  method int getvalue()value
+  method bool equal(t : tree) 
+   if instanceof t leaf_node
+    then zero?(-(value, send cast t leaf_node getvalue()))
+    else zero?(1)
+    
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 equal(o1)
+" #t)
+
+    (good-instanceof-1 "
+class c1 extends object 
+ method int initialize () 1
+class c2 extends object 
+ method int initialize () 2
+let p = proc (o : c1) instanceof o c2 in 11
+" 11)
+
+    (up-cast-1 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends c1 
+let f = proc (o : c2) send cast o c1 get() in (f new c2())
+" 2)
+
+    (up-instance-1 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends c1 
+let f = proc (o : c2) instanceof o c1 in (f new c2())
+" #t)
+
+    (duplicate-methods-1 "
+class c1 extends object
+  method int initialize() 1
+class c2 extends c1
+  method int m1() 1
+  method int m1() 2
+33" 33)
+
+    (incomparable-instanceof-2 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends object 
+  method int initialize () 100
+    
+let f = proc (o : c2) if instanceof o c1 then 1 else 2 in (f new c2())
+" 2)
+
+    (equal-trees-by-double-dispatch "
+interface tree
+  method int sum()
+  method bool equal(t : tree)
+  method bool equal_int(l : tree, r : tree)
+  method bool equal_leaf(val : int)
+  
+class interior_node extends object 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum() +(send left sum(), send right sum())
+  method bool equal(t : tree) send t equal_int(left, right)
+  method bool equal_int(l : tree, r : tree) 
+     if send left equal(l)
+     then send right equal(r)
+     else zero?(1)  % false
+     
+  method bool equal_leaf(v : int) false
+  
+class leaf_node extends object 
+  field int value
+  field bool false
+  method void initialize(v : int) begin set value = v; set
+                                      false=zero?(1) end
+  method int sum()value
+  method bool equal(t : tree) send t equal_leaf(value)
+  method bool equal_int(l : tree, r : tree) false
+  method bool equal_leaf(otherval : int) zero?(-(value, otherval))
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 equal(o1)
+" #t)
+
+    (goldberg-80 "
+class c1 extends object 
+  method int initialize () 1
+  method int test () 1
+  method int result1 () send self test ()
+  
+class c2 extends c1 
+  method int test () 2
+  
+class c3 extends c2 
+  method int result2 () send self result1 ()
+  method int result3 () super test ()
+  
+class c4 extends c3 
+  method int test () 4
+  
+let o3 = new c3 ()
+    o4 = new c4 ()
+in list(send o3 test(),
+        send o4 result1 (),
+        send o3 result2 (),   
+        send o4 result2 (),
+        send o3 result3 (),
+        send o4 result3 ())
+" (2 4 2 4 2 2))
+
+      ))
+
+  (define tests-for-check
+    '(
+      ;; tests from run-tests:
+  
+      ;; simple arithmetic
+      (positive-const "11" int)
+      (negative-const "-33" int)
+      (simple-arith-1 "-(44,33)" int)
+  
+      ;; nested arithmetic
+      (nested-arith-left "-(-(44,33),22)" int)
+      (nested-arith-right "-(55, -(22,11))" int)
+  
+      ;; simple variables
+      (test-var-1 "x" int)
+      (test-var-2 "-(x,1)" int)
+      (test-var-3 "-(1,x)" int)
+
+      (zero-test-1 "zero?(-(3,2))" bool)
+      (zero-test-2 "-(2,zero?(0))" error)
+      
+      ;; simple unbound variables
+      (test-unbound-var-1 "foo" error)
+      (test-unbound-var-2 "-(x,foo)" error)
+  
+      ;; simple conditionals
+      (if-true "if zero?(1) then 3 else 4" int)
+      (if-false "if zero?(0) then 3 else 4" int)
+
+      ;; make sure that the test and both arms get evaluated
+      ;; properly. 
+      (if-eval-test-true "if zero?(-(11,12)) then 3 else 4" int)
+      (if-eval-test-false "if zero?(-(11, 11)) then 3 else 4" int)
+      (if-eval-then "if zero?(1) then -(22,1) else -(22,2)" int)
+      (if-eval-else "if zero?(0) then -(22,1) else -(22,2)" int)
+      
+      ;; make sure types of arms agree (new for lang5-1)
+      
+      (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
+      (if-check-test-is-boolean "if 1 then 11 else 12" error)
+
+      ;; simple let
+      (simple-let-1 "let x = 3 in x" int)
+
+      ;; make sure the body and rhs get evaluated
+      (eval-let-body "let x = 3 in -(x,1)" int)
+      (eval-let-rhs "let x = -(4,1) in -(x,1)" int)
+
+      ;; check nested let and shadowing
+      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" int)
+      (check-shadowing-in-body "let x = 3 in let x = 4 in x" int)
+      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" int)
+
+      ;; simple applications
+      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int)
+      (checker-doesnt-ignore-type-info-in-proc 
+        "(proc(x : (int -> int)) -(x,1)  30)"
+        error) 
+      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int)
+      (let-to-proc-1 "(proc(f : (int -> int))(f 30)  proc(x : int)-(x,1))" int)
+
+
+      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int)
+      (nested-procs2
+        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
+        int)
+      
+      ;; simple letrecs
+      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int)
+      (simple-letrec-2
+        "letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), -2) in (f 4)"
+        int)
+
+      (simple-letrec-3
+        "let m = -5 
+ in letrec int f(x : int) = if zero?(x) then -((f -(x,1)), m) else 0 in (f 4)"
+        int)
+
+      (double-it "
+letrec int double (n : int) = if zero?(n) then 0 
+                                  else -( (double -(n,1)), -2)
+in (double 3)"
+        int)
+
+      ;; tests of expressions that produce procedures
+
+      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))
+
+      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
+      
+      (bind-a-proc-typed
+        "let f = proc (x : int) -(x,1) in (f 4)"
+        int) 
+
+      (bind-a-proc-return-proc
+        "let f = proc (x : int) -(x,1) in f"
+        (int -> int))
+
+      (type-a-ho-proc-1
+        "proc(f : (int -> bool)) (f 3)"
+        ((int  -> bool) -> bool))
+
+      (type-a-ho-proc-2
+        "proc(f : (bool -> bool)) (f 3)"
+        error)
+
+      (apply-a-ho-proc
+        "proc (x : int) proc (f : (int -> bool)) (f x)"
+        (int -> ((int -> bool) -> bool)))
+
+      (apply-a-ho-proc-2
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f x)"
+        (int -> ((int -> (int -> bool)) -> (int -> bool))) )
+
+      (apply-a-ho-proc-3
+        "proc (x : int) proc (f : (int -> (int -> bool))) (f zero?(x))"
+	error)
+
+      (apply-curried-proc
+        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
+        int)
+
+      (apply-a-proc-2-typed
+        "(proc (x : int) -(x,1) 4)" 
+        int)
+
+      (apply-a-letrec "
+letrec int f(x : int) = -(x,1)
+in (f 40)"
+        int)
+
+      (letrec-non-shadowing
+   "(proc (x : int)
+      letrec bool loop(x : bool) =(loop x)
+       in x
+     1)"
+        int)
+
+
+      (letrec-return-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in fact"
+        (int -> int))
+
+      (letrec-apply-fact "
+let times = proc (x : int) proc (y : int) -(x,y)    % not really times
+in letrec 
+     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
+   in (fact 4)"
+        int)
+
+      ;; oop tests
+      ;; these should all check.
+    (test-self-1 "
+class c extends object 
+         field int s
+         method void initialize(v : int)set s = v
+         method void sets(v : int)set s = v
+         method int gets()s
+         method void testit()send self sets(13)
+              
+let o = new c (11)
+       t1 = 0
+       t2 = 0
+   in begin 
+       set t1 = send o gets();
+       send o testit();
+       set t2 = send o gets();
+       list(t1,t2)
+      end" (listof int))
+
+    (counter-1 "
+class counter extends object
+  field int count
+   method void initialize()set count = 0
+   method void countup()set count = +(count,1)
+   method int getcount()count
+   
+let o1 = new counter ()
+    t1 = 0
+    t2 = 0
+in begin
+    set t1 = send o1 getcount();
+    send o1 countup();
+    set t2 = send o1 getcount();
+    list(t1,t2)
+end
+" (listof int))
+
+    (shared-counter-1 "
+class counter extends object
+  field int count
+   method void initialize()set count = 0
+   method void countup()set count = +(count,1)
+   method int getcount()count
+   
+class c1 extends object 
+   field int n
+   field counter counter1
+   method void initialize(a_counter : counter)
+    begin
+     set n = 0;
+     set counter1 = a_counter
+    end
+   method void countup()
+     begin
+      send counter1 countup();
+      set n = +(n,1)
+     end
+   method listof int getstate()list(n, send counter1 getcount())
+   
+let counter1 = new counter()
+in let o1 = new c1(counter1)
+       o2 = new c1(counter1)
+in begin
+     send o1 countup();
+     send o2 countup();
+     send o2 countup();
+     list( send o1 getstate(),
+           send o2 getstate())
+   end
+" (listof (listof int)))
+
+
+    (inherit-1 "
+class c1 extends object 
+  field int ivar1
+  method void initialize()set ivar1 = 1
+  
+class c2 extends c1 
+  field int ivar2
+  method void initialize() 
+   begin
+    super initialize(); 
+    set ivar2 = 1
+   end
+  method void setiv1(n : int)set ivar1 = n
+  method int getiv1()ivar1
+  
+let o = new c2 ()
+    t1 = 0
+in begin
+       send o setiv1(33);
+       send o getiv1()
+   end                      
+" int)
+
+    (inherit-3 "
+class c1 extends object 
+  method int initialize()1
+  method int m1()1
+  
+class c2 extends c1 
+  method int initialize()1 
+  method int m1()super m1()
+  method int m2()2
+  
+class c3 extends c2 
+  method int initialize()1
+  method int m1()3
+  method int m2()super m2()
+  method int m3()super m1()
+  
+let o = new c3 ()
+in list( send o m1(),
+         send o m2(),
+         send o m3()
+        )
+" (listof int))
+
+    (chris-1 "
+class aclass extends object 
+  field int i
+  method void initialize(x : int) set i = x
+  method int m(y : int) +(i,y)
+  
+let o1 = new aclass(3)
+in send o1 m(2)" int)
+
+    (chris-2 "
+class c1 extends object 
+  method int initialize() 1
+  method int ma()1
+  method int mb()send self ma()
+  
+class c2 extends c1   % just use c1's initialize
+  method int ma() 2
+  
+let x = new c2 ()
+in list(send x ma(),send x mb())
+" (listof int))
+
+    (for-book-1 "
+class c1 extends object 
+  field int i
+  field int j
+  method void initialize(x : int) begin set i = x; set j = -(0,x) end
+  method void countup(d : int) begin set i = +(i,d); set j = -(j,d) end
+  method listof int getstate()list(i,j)
+  
+let o1 = new c1(3)
+    t1 = list(1)
+    t2 = list(1)
+in begin
+    set t1 = send o1 getstate();
+    send o1 countup(2);
+    set t2 = send o1 getstate();
+    list(t1,t2)
+   end" (listof (listof int)))
+
+    (odd-even-via-self "
+class oddeven extends object 
+  method int initialize()1
+  method int even(n : int)if zero?(n) then 1 else send self odd(-(n,1))
+  method int odd(n : int) if zero?(n) then 0 else send self even(-(n,1))
+  
+let o1 = new oddeven() in send o1 odd(13)" int)
+
+    (for-book-2 "
+class c1 extends object 
+  method int initialize()1
+  method int m1()1
+  method int m2()100
+  method int m3()send self m2()
+  
+class c2 extends c1 
+  method int initialize()1
+  method int m2()2
+  
+let o1 = new c1()
+    o2 = new c2()
+in list(send o1 m1(),           % returns 1
+        send o1 m2(),           % returns 100
+        send o1 m3(),           % returns 100
+        send o2 m1(),           % returns 1 (from c1)
+        send o2 m2(),           % returns 2 (from c2)
+        send o2 m3()            % returns 2 (c1's m3 calls c2's m2)
+       )
+" (listof int))
+
+    (sum-leaves "
+class tree extends object 
+  method int initialize()1
+  
+class interior_node extends tree 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum () +(send left sum(), send right sum())
+  
+class leaf_node extends tree 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum () value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" error)
+
+    (sum-leaves-1.5 "
+class tree extends object 
+  method int initialize()1
+  method int sum () 17
+  
+class interior_node extends tree 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum () +(send left sum(), send right sum())
+  
+class leaf_node extends tree 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum () value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" int)
+
+
+    (sum-leaves-2 "
+interface tree
+  method int sum (l : tree, r : tree)
+  
+class interior_node extends object
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum() +(send left sum(), send right sum())
+  
+class leaf_node extends object
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" error)
+
+    (sum-leaves-with-abstract-method "
+interface tree
+  method int sum()
+  
+class interior_node extends object 
+  implements tree
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum()+(send left sum(), send right sum())
+  
+class leaf_node extends object
+  implements tree 
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   %% need subtyping to make this ok.
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 sum()
+" int)
+
+
+    (equal-trees-1 "
+interface tree
+  method int sum()
+  method bool equal(t : tree)
+  
+class interior_node extends object 
+  implements tree
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method tree getleft()left
+  method tree getright()right
+  method int sum()+(send left sum(), send right sum())
+  method bool equal(t : tree) 
+    if instanceof t interior_node
+     then if send left equal(send cast t interior_node getleft())
+          then send right equal(send cast t interior_node getright())
+          else zero?(1)
+     else zero?(1)
+     
+  
+class leaf_node extends object 
+  implements tree
+  field int value
+  method void initialize(v : int)set value = v
+  method int sum()value
+  method int getvalue()value
+  method bool equal(t : tree)
+   if instanceof t leaf_node
+    then zero?(-(value, send cast t leaf_node getvalue()))
+    else zero?(1)
+    
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 equal(o1)
+" bool)
+
+    (good-instanceof-1 "
+class c1 extends object 
+ method int initialize () 1
+class c2 extends object 
+ method int initialize () 2
+let p = proc (o : c1) instanceof o c2 in 11
+" int)
+
+    (up-cast-1 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends c1 
+let f = proc (o : c2) send cast o c1 get() in (f new c2())
+" int)
+
+    (up-instance-1 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends c1 
+let f = proc (o : c2) instanceof o c1 in (f new c2())
+" bool)
+
+    (duplicate-methods-1 "
+class c1 extends object
+  method int initialize() 1
+class c2 extends c1
+  method int m1() 1
+  method int m1() 2
+33" error)
+
+    (incomparable-instanceof-2 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends object 
+  method int initialize () 100
+    
+let f = proc (o : c2) if instanceof o c1 then 1 else 2 in (f new c2())
+" int)
+
+    (equal-trees-by-double-dispatch "
+interface tree
+  method int sum()
+  method bool equal(t : tree)
+  method bool equal_int(l : tree, r : tree)
+  method bool equal_leaf(val : int)
+  
+class interior_node extends object
+  implements tree 
+  field tree left
+  field tree right
+  method void initialize(l : tree, r : tree)
+   begin
+    set left = l; set right = r
+   end
+  method int sum() +(send left sum(), send right sum())
+  method bool equal(t : tree) send t equal_int(left, right)
+  method bool equal_int(l : tree, r : tree)
+     if send left equal(l)
+     then send right equal(r)
+     else zero?(1)  % false
+     
+  method bool equal_leaf(v : int) zero?(1)
+  
+class leaf_node extends object 
+  implements tree
+  field int value
+  field bool false
+  method void initialize(v : int) begin set value = v; set
+                                        false=zero?(1) end
+  method int sum()value
+  method bool equal(t : tree) send t equal_leaf(value)
+  method bool equal_int(l : tree, r : tree) false
+  method bool equal_leaf(otherval : int) zero?(-(value, otherval))
+  
+let o1 = new interior_node (
+          new interior_node (
+            new leaf_node(3),   
+            new leaf_node(4)),
+          new leaf_node(5))
+in send o1 equal(o1)
+" bool)
+
+    (goldberg-80 "
+class c1 extends object 
+  method int initialize () 1
+  method int test () 1
+  method int result1 () send self test ()
+  
+class c2 extends c1 
+  method int test () 2
+  
+class c3 extends c2 
+  method int result2 () send self result1 ()
+  method int result3 () super test ()
+  
+class c4 extends c3 
+  method int test () 4
+  
+let o3 = new c3 ()
+    o4 = new c4 ()
+in list(send o3 test(),
+        send o4 result1 (),
+        send o3 result2 (),   
+        send o4 result2 (),
+        send o3 result3 (),
+        send o4 result3 ())
+"
+      (listof int))
+
+    (check-interface-implementation-1 "
+interface i1 
+ method int foo ()
+
+class c1 extends object
+ implements i1
+ methid int initialize () 1
+ method int bar () 27
+
+13"
+      error)
+
+    (check-interface-implementation-2 "
+interface i1 
+ method int foo ()
+
+class c1 extends object
+ implements i1
+ method int initialize () 1
+ method bool foo () 27
+
+13"
+      error)
+
+    ;; with exercise 9.34, this should become an error
+
+    (bad-cast-1 "
+class c1 extends object 
+ method int initialize () 1
+class c2 extends object 
+ method int initialize () 2
+proc (o : c1) cast o c2
+"
+      (c1 -> c2))
+
+    (missing-initialize-method-1 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends object   % no initialize method!
+let f = proc (o : c2) instanceof o c1 in (f new c2())
+"
+      error)
+
+    (duplicate-methods-1 "
+class c1 extends object
+  method int initialize() 1
+class c2 extends c1
+  method int m1() 1
+  method int m1() 2
+33"
+      error)
+
+    (incomparable-instanceof-2 "
+class c1 extends object 
+  method int initialize ()1
+  method int get()2
+  
+class c2 extends object 
+  method int initialize () 100
+    
+let f = proc (o : c2) if instanceof o c1 then 1 else 2 in (f new c2())
+"
+      ;; this is stupid but legal
+      ;; exercise: make this illegal (9.34)
+      int)
+
+    (bad-super-1 "
+class c1 extends object 
+ method int initialize() 1
+ 
+class c2 extends c1 
+ method int m1() super m2()
+ 
+class c3 extends c2 
+ method int m2() 2
+ 
+class c4 extends c3 
+let o = new c4() in send o m1()
+"
+      error)
+
+    (unsupplied-method-2 "
+interface c1 
+  method int m1() 
+  
+class c2 extends object implements c1 
+  method int initialize () 0
+  method int m2 ()send self m1()
+  
+33"
+      error)
+
+    (overriding-method-changes-type-1 "
+class c1 extends object 
+  method int initialize () 1
+  method int m1() 22
+  
+class c2 extends c1 
+  method bool m1() zero?(0)
+  
+33"
+      error)
+
+    (test6-3-1 "
+class c1 extends object
+ method int initialize () 1 
+ method int m1 () 11
+ method int m2 () 12
+class c2 extends c1 
+ method int m1 () 21
+ method int m2 () 22
+ method int m3 () 23
+class c3 extends c2 
+ method int m4 () 34
+class c4 extends c3 
+ method int m2 () 42 
+proc (o : c3) send o m2()
+"
+      (c3 -> int))
+
+    ;; here c2 is bad, so the interprter runs successfully and returns
+    ;; false. 
+    (bad-instance-of-1 "
+class c1 extends object
+ method int initialize () 1
+
+instanceof new c1() c2"
+      bool)
+
+    ;; here c1 is unrelated to c2, so the interpreter runs
+    ;; successfully and returns false.
+    (bad-instance-of-2 "
+class c1 extends object
+ method int initialize () 1
+
+interface c2
+
+instanceof new c1() c2"
+      bool)
+      
+      
+      )
+  ))
+
+
diff --git a/collects/tests/eopl/chapter9/typed-oo/top.scm b/collects/tests/eopl/chapter9/typed-oo/top.scm
new file mode 100755
index 0000000000..cfefba4ab0
--- /dev/null
+++ b/collects/tests/eopl/chapter9/typed-oo/top.scm
@@ -0,0 +1,92 @@
+(module top (lib "eopl.ss" "eopl")
+  
+  ;; top level module.  Loads all required pieces.
+  ;; Run the test suite for the interpreter with (run-all).
+  ;; Run the test suite for the checker with (check-all).
+
+  (require "drscheme-init.scm")
+  (require "data-structures.scm")       ; for expval constructors
+  (require "lang.scm")                  ; for scan&parse
+  (require "checker.scm")               ; for type-of-program
+  (require "interp.scm")                ; for value-of-program
+  (require "tests.scm")                 ; for tests-for-run and tests-for-check
+
+  (provide run run-all check check-all) 
+  
+  ;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
+  
+  ;; run : String -> ExpVal
+
+  (define run
+    (lambda (string)
+      (value-of-program (scan&parse string))))
+  
+  ;; run-all : () -> unspecified
+  ;; runs all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define run-all
+    (lambda ()
+      (run-tests! run equal-answer? tests-for-run)))
+  
+  (define equal-answer?
+    (lambda (ans correct-ans)
+      (equal? ans (sloppy->expval correct-ans))))
+  
+  (define sloppy->expval 
+    (lambda (sloppy-val)
+      (cond
+        ((number? sloppy-val) (num-val sloppy-val))
+        ((boolean? sloppy-val) (bool-val sloppy-val))
+        ((list? sloppy-val) (list-val (map sloppy->expval sloppy-val)))
+        (else
+         (eopl:error 'sloppy->expval 
+                     "Can't convert sloppy value to expval: ~s"
+                     sloppy-val)))))
+  
+  ;; run-one : Sym -> ExpVal
+  ;; (run-one sym) runs the test whose name is sym
+
+  (define run-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-run)))
+        (cond
+          ((assoc test-name tests-for-run)
+           => (lambda (test)
+                (run (cadr test))))
+          (else (eopl:error 'run-one "no such test: ~s" test-name))))))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; check : String -> ExternalType
+
+  (define check
+    (lambda (string)
+      (type-to-external-form
+        (type-of-program (scan&parse string)))))
+  
+  ;; check-all : () -> Unspecified
+  ;; checks all the tests in test-list, comparing the results with
+  ;; equal-answer?  
+
+  (define check-all
+    (lambda ()
+      (run-tests! check equal? tests-for-check)))
+
+  ;; check-one : Sym -> ExpVal
+  ;; (check-one sym) checks the test whose name is sym
+  
+  (define check-one
+    (lambda (test-name)
+      (let ((the-test (assoc test-name tests-for-check)))
+        (cond
+          (the-test
+           => (lambda (test)
+                (check (cadr test))))
+          (else (eopl:error 'check-one "no such test: ~s" test-name))))))
+
+  (stop-after-first-error #t)
+  ;; (check-all)
+  ;; (run-all)
+
+  )