ps4 stuff

12 files changed, 1058 insertions, 0 deletions

diff --git a/ps04_combinators_amb/analyze-amb.scm b/ps04_combinators_amb/analyze-amb.scm
new file mode 100644
index 0000000..5d5ad56
--- /dev/null
+++ b/ps04_combinators_amb/analyze-amb.scm
@@ -0,0 +1,208 @@
+;;;; Analyzing interpreter with AMB.
+;;;   Execution procedures take environment 
+;;;   and two continuations: SUCCEED and FAIL
+
+(define (ambeval exp env succeed fail)
+  ((analyze exp) env succeed fail))
+
+(define analyze
+  (make-generic-operator 1
+    (lambda (exp)
+      (cond ((application? exp) (analyze-application exp))
+	    (else (error "Unknown expression type" exp))))))
+
+(define (analyze-self-evaluating exp)
+  (lambda (env succeed fail)
+    (succeed exp fail)))
+
+(defhandler analyze analyze-self-evaluating self-evaluating?)
+
+
+(define (analyze-quoted exp)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env succeed fail)
+      (succeed qval fail))))
+
+(defhandler analyze analyze-quoted quoted?)
+
+
+(define (analyze-variable exp)
+  (lambda (env succeed fail)
+    (succeed (lookup-variable-value exp env) fail)))
+
+(defhandler analyze analyze-variable variable?)
+
+(define (analyze-lambda exp)
+  (let ((vars (lambda-parameters exp))
+        (bproc (analyze (lambda-body exp))))
+    (lambda (env succeed fail)
+      (succeed (make-compound-procedure vars bproc env)
+	       fail))))
+
+(defhandler analyze analyze-lambda lambda?)
+
+
+(define (analyze-if exp)
+  (let ((pproc (analyze (if-predicate exp)))
+        (cproc (analyze (if-consequent exp)))
+        (aproc (analyze (if-alternative exp))))
+    (lambda (env succeed fail)
+      (pproc env
+	     (lambda (pred-value pred-fail)
+	       (if (true? pred-value)
+		   (cproc env succeed pred-fail)
+		   (aproc env succeed pred-fail)))
+	     fail))))
+
+(defhandler analyze analyze-if if?)
+
+(define (analyze-sequence exps)
+  (define (sequentially proc1 proc2)
+    (lambda (env succeed fail)
+      (proc1 env
+	     (lambda (proc1-value proc1-fail)
+	       (proc2 env succeed proc1-fail))
+	     fail)))
+  (define (loop first-proc rest-procs)
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (if (null? exps) (error "Empty sequence"))
+  (let ((procs (map analyze exps)))
+    (loop (car procs) (cdr procs))))
+
+(defhandler analyze
+  (lambda (exp)
+    (analyze-sequence (begin-actions exp)))
+  begin?)
+
+(define (analyze-application exp)
+  (let ((fproc (analyze (operator exp)))
+        (aprocs (map analyze (operands exp))))
+    (lambda (env succeed fail)
+      (fproc env
+	     (lambda (proc proc-fail)
+	       (get-args aprocs env
+			 (lambda (args args-fail)
+			   (execute-application proc
+						args
+						succeed
+						args-fail))
+			 proc-fail))
+	     fail))))
+
+(define (get-args aprocs env succeed fail)
+  (cond ((null? aprocs) (succeed '() fail))
+	((null? (cdr aprocs))
+	 ((car aprocs) env
+	  (lambda (arg fail)
+	    (succeed (list arg) fail))
+	  fail))
+	(else
+	 ((car aprocs) env
+	  (lambda (arg fail)
+	    (get-args (cdr aprocs) env
+		      (lambda (args fail)
+			(succeed (cons arg args)
+				 fail))
+		      fail))
+	  fail))))
+
+(define execute-application
+  (make-generic-operator 4
+    (lambda (proc args succeed fail)
+      (error "Unknown procedure type" proc))))
+
+(defhandler execute-application
+  (lambda (proc args succeed fail)
+    (succeed (apply-primitive-procedure proc args) fail))
+  strict-primitive-procedure?)
+
+(defhandler execute-application
+  (lambda (proc args succeed fail)
+    ((procedure-body proc)
+     (extend-environment (procedure-parameters proc)
+			 args
+			 (procedure-environment proc))
+     succeed
+     fail))
+  compound-procedure?)
+
+;;; There are two useful kinds of assignments in AMB
+;;; interpreters.  Undoable assignments and permanent
+;;; assignments.  The default is the undoable assignment.
+
+(define (analyze-undoable-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+	     (lambda (new-val val-fail)
+	       (let ((old-val (lookup-variable-value var env)))
+		 (set-variable-value! var new-val env)
+		 (succeed 'OK
+		   (lambda ()
+		     (set-variable-value! var old-val env)
+		     (val-fail)))))
+	     fail))))
+
+(defhandler analyze
+  analyze-undoable-assignment
+  assignment?)
+
+
+(define (analyze-permanent-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+	     (lambda (new-val val-fail)
+	       (set-variable-value! var new-val env)
+	       (succeed 'OK fail))
+	     fail))))
+
+(defhandler analyze
+  analyze-permanent-assignment
+  permanent-assignment?)
+
+(define (analyze-definition exp)
+  (let ((var (definition-variable exp))
+        (vproc (analyze (definition-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+	     (lambda (new-val val-fail)
+	       (define-variable! var new-val env)
+	       (succeed var val-fail))
+	     fail))))
+
+(defhandler analyze analyze-definition definition?)
+
+
+;;; AMB, itself!
+
+(define (analyze-amb exp)
+  (let ((aprocs (map analyze (amb-alternatives exp))))
+    (lambda (env succeed fail)
+      (let loop ((alts aprocs))
+	(if (null? alts)
+	    (fail)
+	    ((car alts) env
+	                succeed
+			(lambda ()
+			  (loop (cdr alts)))))))))
+
+(defhandler analyze analyze-amb amb?)
+
+
+;;; Macros (definitions are in syntax.scm)
+
+(defhandler analyze
+  (lambda (exp)
+    (analyze (cond->if exp)))
+  cond?)
+
+(defhandler analyze
+  (lambda (exp)
+    (analyze (let->combination exp)))
+  let?)
diff --git a/ps04_combinators_amb/analyze.scm b/ps04_combinators_amb/analyze.scm
new file mode 100644
index 0000000..8f83b74
--- /dev/null
+++ b/ps04_combinators_amb/analyze.scm
@@ -0,0 +1,120 @@
+;;;; Separating analysis from execution.
+;;;   Generic analysis, but not prepared for
+;;;   extension to handle nonstrict operands.
+
+(define (eval exp env)
+  ((analyze exp) env))
+
+(define analyze
+  (make-generic-operator 1
+    (lambda (exp)
+      (cond ((application? exp)
+	     (analyze-application exp))
+	    (else
+	     (error "Unknown expression type"
+		    exp))))))
+
+(define (analyze-self-evaluating exp)
+  (lambda (env) exp))
+
+(defhandler analyze analyze-self-evaluating self-evaluating?)
+
+
+(define (analyze-quoted exp)
+  (let ((qval (text-of-quotation exp)))
+    (lambda (env) qval)))
+
+(defhandler analyze analyze-quoted quoted?)
+
+
+(define (analyze-variable exp)
+  (lambda (env) (lookup-variable-value exp env)))
+
+(defhandler analyze analyze-variable variable?)
+
+(define (analyze-if exp)
+  (let ((pproc (analyze (if-predicate exp)))
+        (cproc (analyze (if-consequent exp)))
+        (aproc (analyze (if-alternative exp))))
+    (lambda (env)
+      (if (true? (pproc env)) (cproc env) (aproc env)))))
+
+(defhandler analyze analyze-if if?)
+
+
+(define (analyze-lambda exp)
+  (let ((vars (lambda-parameters exp))
+        (bproc (analyze (lambda-body exp))))
+    (lambda (env)
+      (make-compound-procedure vars bproc env))))
+
+(defhandler analyze analyze-lambda lambda?)
+
+(define (analyze-application exp)
+  (let ((fproc (analyze (operator exp)))
+        (aprocs (map analyze (operands exp))))
+    (lambda (env)
+      (execute-application (fproc env)
+	(map (lambda (aproc) (aproc env))
+	     aprocs)))))
+
+(define execute-application
+  (make-generic-operator 2
+    (lambda (proc args)
+      (error "Unknown procedure type" proc))))
+
+(defhandler execute-application
+  apply-primitive-procedure
+  strict-primitive-procedure?)
+
+(defhandler execute-application
+  (lambda (proc args)
+    ((procedure-body proc)
+     (extend-environment 
+      (procedure-parameters proc)
+      args
+      (procedure-environment proc))))
+  compound-procedure?)
+
+(define (analyze-sequence exps)
+  (define (sequentially proc1 proc2)
+    (lambda (env) (proc1 env) (proc2 env)))
+  (define (loop first-proc rest-procs)
+    (if (null? rest-procs)
+        first-proc
+        (loop (sequentially first-proc (car rest-procs))
+              (cdr rest-procs))))
+  (if (null? exps) (error "Empty sequence"))
+  (let ((procs (map analyze exps)))
+    (loop (car procs) (cdr procs))))
+
+(defhandler analyze
+  (lambda (exp)
+    (analyze-sequence (begin-actions exp)))
+  begin?)
+
+
+(define (analyze-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env)
+      (set-variable-value! var (vproc env) env)
+      'ok)))
+
+(defhandler analyze analyze-assignment assignment?)
+
+
+(define (analyze-definition exp)
+  (let ((var (definition-variable exp))
+        (vproc (analyze (definition-value exp))))
+    (lambda (env)
+      (define-variable! var (vproc env) env)
+      'ok)))
+
+(defhandler analyze analyze-definition definition?)
+
+;;; Macros (definitions are in syntax.scm)
+
+(defhandler analyze (compose analyze cond->if) cond?)
+
+(defhandler analyze (compose analyze let->combination) let?)
diff --git a/ps04_combinators_amb/ghelper.scm b/ps04_combinators_amb/ghelper.scm
new file mode 100644
index 0000000..7b8613d
--- /dev/null
+++ b/ps04_combinators_amb/ghelper.scm
@@ -0,0 +1,102 @@
+;;;;           Most General Generic-Operator Dispatch
+
+(declare (usual-integrations))
+
+;;; Generic-operator dispatch is implemented here by a discrimination
+;;; list, where the arguments passed to the operator are examined by
+;;; predicates that are supplied at the point of attachment of a
+;;; handler (by ASSIGN-OPERATION).
+
+;;; To be the correct branch all arguments must be accepted by
+;;; the branch predicates, so this makes it necessary to
+;;; backtrack to find another branch where the first argument
+;;; is accepted if the second argument is rejected.  Here
+;;; backtracking is implemented by OR.
+
+(define (make-generic-operator arity default-operation)
+  (let ((record (make-operator-record arity)))
+
+    (define (operator . arguments)
+      (if (not (= (length arguments) arity))
+          (error:wrong-number-of-arguments operator arity arguments))
+      (let ((succeed
+	     (lambda (handler)
+	       (apply handler arguments))))
+	(let per-arg
+	    ((tree (operator-record-tree record))
+	     (args arguments)
+	     (fail
+	      (lambda ()
+		(error:no-applicable-methods operator arguments))))
+	  (let per-pred ((tree tree) (fail fail))
+	    (cond ((pair? tree)
+		   (if ((caar tree) (car args))
+		       (if (pair? (cdr args))
+			   (per-arg (cdar tree)
+				    (cdr args)
+				    (lambda ()
+				      (per-pred (cdr tree) fail)))
+			   (succeed (cdar tree)))
+		       (per-pred (cdr tree) fail)))
+		  ((null? tree)
+		   (fail))
+		  (else
+		   (succeed tree)))))))
+
+    (hash-table/put! *generic-operator-table* operator record)
+    (if default-operation
+	(assign-operation operator default-operation))
+    operator))
+
+(define *generic-operator-table*
+  (make-eq-hash-table))
+
+(define (make-operator-record arity) (cons arity '()))
+(define (operator-record-arity record) (car record))
+(define (operator-record-tree record) (cdr record))
+(define (set-operator-record-tree! record tree) (set-cdr! record tree))
+
+(define (assign-operation operator handler . argument-predicates)
+  (let ((record
+         (let ((record (hash-table/get *generic-operator-table* operator #f))
+               (arity (length argument-predicates)))
+           (if record
+               (begin
+                 (if (not (<= arity (operator-record-arity record)))
+                     (error "Incorrect operator arity:" operator))
+                 record)
+               (let ((record (make-operator-record arity)))
+                 (hash-table/put! *generic-operator-table* operator record)
+                 record)))))
+    (set-operator-record-tree! record
+                               (bind-in-tree argument-predicates
+                                             handler
+                                             (operator-record-tree record))))
+  operator)
+
+(define defhandler assign-operation)
+
+(define (bind-in-tree keys handler tree)
+  (let loop ((keys keys) (tree tree))
+    (if (pair? keys)
+	(let find-key ((tree* tree))
+	  (if (pair? tree*)
+	      (if (eq? (caar tree*) (car keys))
+		  (begin
+		    (set-cdr! (car tree*)
+			      (loop (cdr keys) (cdar tree*)))
+		    tree)
+		  (find-key (cdr tree*)))
+	      (cons (cons (car keys)
+			  (loop (cdr keys) '()))
+		    tree)))
+	(if (pair? tree)
+	    (let ((p (last-pair tree)))
+	      (if (not (null? (cdr p)))
+		  (warn "Replacing a handler:" (cdr p) handler))
+	      (set-cdr! p handler)
+	      tree)
+	    (begin
+	      (if (not (null? tree))
+		  (warn "Replacing top-level handler:" tree handler))
+	      handler)))))
\ No newline at end of file
diff --git a/ps04_combinators_amb/load-amb.scm b/ps04_combinators_amb/load-amb.scm
new file mode 100644
index 0000000..6f3d1a8
--- /dev/null
+++ b/ps04_combinators_amb/load-amb.scm
@@ -0,0 +1,14 @@
+(load "utils" user-initial-environment)
+(load "ghelper" user-initial-environment)
+(load "syntax" user-initial-environment)
+(load "rtdata" user-initial-environment)
+
+
+(define generic-evaluation-environment
+  (extend-top-level-environment user-initial-environment))
+
+(load "analyze-amb" generic-evaluation-environment)
+(load "repl-amb" generic-evaluation-environment)
+
+
+(ge generic-evaluation-environment)
\ No newline at end of file
diff --git a/ps04_combinators_amb/load-analyze.scm b/ps04_combinators_amb/load-analyze.scm
new file mode 100644
index 0000000..02e447e
--- /dev/null
+++ b/ps04_combinators_amb/load-analyze.scm
@@ -0,0 +1,13 @@
+(load "utils" user-initial-environment)
+(load "ghelper" user-initial-environment)
+(load "syntax" user-initial-environment)
+(load "rtdata" user-initial-environment)
+
+
+(define generic-evaluation-environment
+  (extend-top-level-environment user-initial-environment))
+
+(load "analyze" generic-evaluation-environment)
+(load "repl" generic-evaluation-environment)
+
+(ge generic-evaluation-environment)
\ No newline at end of file
diff --git a/ps04_combinators_amb/multiple-dwelling.scm b/ps04_combinators_amb/multiple-dwelling.scm
new file mode 100644
index 0000000..4ab0311
--- /dev/null
+++ b/ps04_combinators_amb/multiple-dwelling.scm
@@ -0,0 +1,30 @@
+
+(define (require p)
+  (if (not p) (amb)))
+
+(define (distinct l)
+  (cond ((null? l) true)
+	((null? (cdr l)) true)
+	((member (car l) (cdr l)) false)
+	(else (distinct (cdr l)))))
+
+(define (multiple-dwelling)
+  (let ((baker    (amb 1 2 3 4 5))
+        (cooper   (amb 1 2 3 4 5))
+        (fletcher (amb 1 2 3 4 5))
+        (miller   (amb 1 2 3 4 5))
+        (smith    (amb 1 2 3 4 5)))
+    (require
+     (distinct (list baker cooper fletcher miller smith)))
+    (require (not (= baker 5)))
+    (require (not (= cooper 1)))
+    (require (not (= fletcher 5)))
+    (require (not (= fletcher 1)))
+    (require (> miller cooper))
+    (require (not (= (abs (- smith fletcher)) 1)))
+    (require (not (= (abs (- fletcher cooper)) 1)))
+    (list (list 'baker baker)
+          (list 'cooper cooper)
+          (list 'fletcher fletcher)
+          (list 'miller miller)
+          (list 'smith smith))))
diff --git a/ps04_combinators_amb/ps.txt b/ps04_combinators_amb/ps.txt
new file mode 100644
index 0000000..56df0d8
--- /dev/null
+++ b/ps04_combinators_amb/ps.txt
@@ -0,0 +1,148 @@
+
+                MASSACHVSETTS INSTITVTE OF TECHNOLOGY
+      Department of Electrical Engineering and Computer Science
+
+                          6.945 Spring 2009
+                            Problem Set 4
+
+  Issued: Wed. 25 Feb. 2009                    Due: Wed. 4 Mar. 2009
+
+Reading:
+    SICP, From Chapter 4: section 4.1.7--4.2 (from PS03)
+                          section 4.3; (pp. 412--437)
+
+Code: utils.scm, ghelper.scm, syntax.scm, rtdata.scm,
+      load-analyze.scm, analyze.scm, repl.scm
+      load-amb.scm, analyze-amb.scm repl-amb.scm
+      multiple-dwelling.scm
+
+
+		       Heavy Evaluator Hacking
+
+In this problem set we build interpreters in a different direction.
+We start with the essential EVAL/APPLY interpreter, written as an
+analyzer of the syntax into a compiler of compositions of execution
+procedures -- a small combinator language.  We will warm up by making
+modifications to this evaluator.
+
+Next, we will change the evaluator to include AMB expressions.  To add
+AMB, the execution procedures will all have a different shape: in
+addition to the environment, each will take two "continuation
+procedures" SUCCEED and FAIL.  In general, when a computation comes up
+with a value it will invoke SUCCEED with the proposed value and a
+complaint department which, if invoked, will try to produce an
+alternate value.  If a computation cannot come up with a value, it
+will invoke the complaint department passed to it in the FAIL
+continuation.
+
+An important lesson to be learned here is how to use continuation
+procedures to partially escape the expression structure of the
+language.  By construction, a functional expression has a unique
+value.  However, in the AMB system an expression may be ambiguous as
+to its value...  Think about how we arrange that to make sense!
+
+---------------------------------------------------------------------
+
+	     Separating Syntactic Analysis from Execution
+		      (Compiling to Combinators)
+
+It is important to read SICP section 4.1.7 carefully here.  When you
+load "load-analyze.scm" you will get an evaluator similar to the one
+described in this section.  
+
+
+-------------
+Problem 4.1: Warmup
+
+It is often valuable to have procedures that can take an indefinite
+number of arguments.  The addition and multiplication procedures in
+Scheme are examples of such procedures.  Traditionally, a user may
+specify such a procedure in a definition by making the bound-variable
+specification of a lambda expression a symbol rather than a list of
+formal parameters.  That symbol is expected to be bound to the list of
+arguments supplied.  For example, to make a procedure that takes
+several arguments and returns a list of the squares of the arguments
+supplied, one may write:
+
+(lambda x (map square x))
+
+or
+
+(define (ss . x) (map square x))
+
+and then
+
+(ss 1 2 3 4) ==> (1 4 9 16)
+
+Modify the analyzing interpreter to allow this construction.  
+
+Hint: you do not need to change the code involving DEFINE or LAMBDA
+in syntax.scm!  This is entirely a change in analyze.scm
+
+Demonstrate that your modification allows this kind of procedure, and
+that it does not cause other troubles.
+-------------
+
+-------------
+Problem 4.2: Infix notation
+
+Many people like infix notation for small arithmetic expressions.  It
+is not hard to write a special form, (INFIX <infix-string>), that
+takes a character string, parses it as an infix expression with the
+usual precedence rules, and reduces it to Lisp.  Note that to do this
+you really don't have to delve into the combinator target mechanism of
+the evaluator, since this can be accomplished as a "macro" in the same
+way that COND and LET are implemented (see syntax.scm).
+
+So, for example, we should be able to write the program:
+
+(define (quadratic a b c)
+  (let ((discriminant (infix "b**2-4*a*c")))
+    (infix "(-b+sqrt(discriminant))/(2*a)")))
+
+Hint: Do not try to parse numbers!  That is hard -- let Scheme do it
+for you: use string->number (see MIT Scheme documentation).  Just
+pass the substring that specifies the number to string->number to get
+the numerical value.
+
+Write the INFIX special form, install it in the evaluator, and
+demonstrate that it works.
+
+Please! Unless you have lots of time to burn, do not write a complete
+infix parser for some entire language, like Python (easy) or Java
+(hard)!  We just want parsing of simple arithmetic expressions.
+-------------
+
+
+---------------------------------------------------------------------
+
+		 AMB and Nondeterministic Programming
+
+Now comes the real fun part of this problem set!  Please read section
+4.3 of SICP carefully before starting this part.  This interpreter
+requires a change in the interface structure of the combinators that
+code compiles into, so it is quite different.  Of course, our system
+differs from the one in SICP in that it is implemented with generic
+extension capability.  The loader for the interpreter extended for AMB
+is "load-analyze.scm".
+
+-------------
+Problem 4.3: Warmup: Programming with AMB
+
+Run the multiple-dwelling program (to get a feeling for how to use the
+system).
+
+Do exercises 4.38, 4.39, and 4.40 (p. 419) from SICP.  
+
+Note: we supply the multiple-dwelling.scm program so you need not type
+it in. 
+-------------
+
+-------------
+Problem 4.4:
+
+Modify the AMB interpreter to record and report the number of
+alternatives examined in exploring a search space.  What is this
+number for the simple multiple-dwelling program?  For your best
+improvement of it from your work in exercise 4.40, above.
+-------------
diff --git a/ps04_combinators_amb/repl-amb.scm b/ps04_combinators_amb/repl-amb.scm
new file mode 100644
index 0000000..c7b6ccb
--- /dev/null
+++ b/ps04_combinators_amb/repl-amb.scm
@@ -0,0 +1,80 @@
+(declare (usual-integrations write write-line pp eval))
+
+(define write
+  (make-generic-operator 1
+    (access write user-initial-environment)))
+
+(define write-line
+  (make-generic-operator 1
+    (access write-line user-initial-environment)))
+
+(define pp
+  (make-generic-operator 1
+    (access pp user-initial-environment)))
+
+(define (procedure-printable-representation procedure)
+  `(compound-procedure
+    ,(procedure-parameters procedure)
+    ,(procedure-body procedure)
+    <procedure-environment>))
+
+(defhandler write
+  (compose write procedure-printable-representation)
+  compound-procedure?)
+
+(defhandler write-line
+  (compose write-line procedure-printable-representation)
+  compound-procedure?)
+
+(defhandler pp
+  (compose pp procedure-printable-representation)
+  compound-procedure?)
+
+ 
+(define (read) (prompt-for-command-expression "eval> "))
+
+(define the-global-environment)
+
+
+;;; Initialization and driver loop
+
+(define (evaluator exp succeed fail)
+  ((analyze exp)
+   the-global-environment
+   succeed
+   fail))
+
+(define input-prompt ";;; Amb-Eval input:\n")
+
+(define output-prompt "\n;;; Amb-Eval value:\n")
+
+(define (init)
+  (set! the-global-environment
+	(extend-environment '() '() the-empty-environment))
+  (driver-loop))
+
+(define (driver-loop)
+  (define (internal-loop try-again)
+    (let ((input
+           (prompt-for-command-expression input-prompt)))
+      (if (eq? input 'try-again)
+          (try-again)
+          (begin
+            (newline)
+            (display ";;; Starting a new problem ")
+            (evaluator
+             input
+             (lambda (val next-alternative)
+               (display output-prompt)
+               (pp val)
+               (internal-loop next-alternative))
+             (lambda ()
+               (display ";;; There are no more values of ")
+               (pp input)
+               (driver-loop)))))))
+  (internal-loop
+   (lambda ()
+     (display ";;; There is no current problem")
+     (driver-loop))))
+
+(define go driver-loop)
diff --git a/ps04_combinators_amb/repl.scm b/ps04_combinators_amb/repl.scm
new file mode 100644
index 0000000..b8ff8b7
--- /dev/null
+++ b/ps04_combinators_amb/repl.scm
@@ -0,0 +1,48 @@
+(declare (usual-integrations write write-line pp eval))
+
+(define write
+  (make-generic-operator 1
+    (access write user-initial-environment)))
+
+(define write-line
+  (make-generic-operator 1
+    (access write-line user-initial-environment)))
+
+(define pp
+  (make-generic-operator 1
+    (access pp user-initial-environment)))
+
+(define (procedure-printable-representation procedure)
+  `(compound-procedure
+    ,(procedure-parameters procedure)
+    ,(procedure-body procedure)
+    <procedure-environment>))
+
+(defhandler write
+  (compose write procedure-printable-representation)
+  compound-procedure?)
+
+(defhandler write-line
+  (compose write-line procedure-printable-representation)
+  compound-procedure?)
+
+(defhandler pp
+  (compose pp procedure-printable-representation)
+  compound-procedure?)
+
+ 
+(define (read) (prompt-for-command-expression "eval> "))
+
+(define the-global-environment)
+
+(define (init)
+  (set! the-global-environment
+	(extend-environment '() '() the-empty-environment))
+  (repl))
+
+(define (repl)
+  (let ((input (read)))
+    (write-line (eval input the-global-environment))
+    (repl)))
+
+(define go repl)
diff --git a/ps04_combinators_amb/rtdata.scm b/ps04_combinators_amb/rtdata.scm
new file mode 100644
index 0000000..dad3d7a
--- /dev/null
+++ b/ps04_combinators_amb/rtdata.scm
@@ -0,0 +1,88 @@
+;;; -*- Mode:Scheme -*- 
+
+(declare (usual-integrations))
+
+(define the-unspecified-value (list 'the-unspecified-value))
+
+(define (true? x)
+  (if x true false))
+
+(define (false? x)
+  (if x false true))
+
+;;; Primitive procedures are inherited from Scheme.
+
+(define strict-primitive-procedure? procedure?)
+(define apply-primitive-procedure apply)
+
+
+;;; Compound procedures
+
+(define (make-compound-procedure vars bproc env)
+  (vector 'compound-procedure vars bproc env))
+
+(define (compound-procedure? obj)
+  (and (vector? obj)
+       (eq? (vector-ref obj 0) 'compound-procedure)))
+
+(define (procedure-parameters p) (vector-ref p 1))
+(define (procedure-body p) (vector-ref p 2))
+(define (procedure-environment p) (vector-ref p 3))
+
+;;; An ENVIRONMENT is a chain of FRAMES, made of vectors.
+
+(define (extend-environment variables values base-environment)
+  (if (fix:= (length variables) (length values))
+      (vector variables values base-environment)
+      (if (fix:< (length variables) (length values))
+	  (error "Too many arguments supplied" variables values)
+	  (error "Too few arguments supplied" variables values))))
+
+(define (environment-variables env) (vector-ref env 0))
+(define (environment-values env) (vector-ref env 1))
+(define (environment-parent env) (vector-ref env 2))
+
+(define the-empty-environment '())
+
+(define (lookup-variable-value var env)
+  (let plp ((env env))
+    (if (eq? env the-empty-environment)
+	(lookup-scheme-value var)
+	(let scan
+	    ((vars (vector-ref env 0))
+	     (vals (vector-ref env 1)))
+	  (cond ((null? vars) (plp (vector-ref env 2)))
+		((eq? var (car vars)) (car vals))
+		(else (scan (cdr vars) (cdr vals))))))))
+
+;;; Extension to make underlying Scheme values available to interpreter
+
+(define (lookup-scheme-value var)
+  (lexical-reference generic-evaluation-environment var))
+
+(define (define-variable! var val env)
+  (if (eq? env the-empty-environment)
+      (error "Unbound variable -- DEFINE" var) ;should not happen.
+      (let scan
+	  ((vars (vector-ref env 0))
+	   (vals (vector-ref env 1)))
+	(cond ((null? vars)
+	       (vector-set! env 0 (cons var (vector-ref env 0)))
+	       (vector-set! env 1 (cons val (vector-ref env 1))))
+	      ((eq? var (car vars))
+	       (set-car! vals val))
+	      (else
+	       (scan (cdr vars) (cdr vals)))))))
+
+(define (set-variable-value! var val env)
+  (let plp ((env env))
+    (if (eq? env the-empty-environment)
+	(error "Unbound variable -- SET!" var)
+	(let scan
+	    ((vars (vector-ref env 0))
+	     (vals (vector-ref env 1)))
+	  (cond ((null? vars) (plp (vector-ref env 2)))
+		((eq? var (car vars)) (set-car! vals val))
+		(else (scan (cdr vars) (cdr vals))))))))
+
+
diff --git a/ps04_combinators_amb/syntax.scm b/ps04_combinators_amb/syntax.scm
new file mode 100644
index 0000000..40ba784
--- /dev/null
+++ b/ps04_combinators_amb/syntax.scm
@@ -0,0 +1,190 @@
+;;; -*- Mode:Scheme -*- 
+
+(declare (usual-integrations))
+
+;;; Self-evaluating entities
+
+(define (self-evaluating? exp)
+  (or (number? exp)
+      (eq? exp #t)
+      (eq? exp #f)
+      (string? exp)))	; Our prompt (viz., "EVAL==> ") is a string.
+
+;;; Variables
+
+(define (variable? exp) (symbol? exp))
+
+(define (same-variable? var1 var2) (eq? var1 var2))  ;; Nice abstraction
+
+;;; Special forms (in general)
+
+(define (tagged-list? exp tag)
+  (and (pair? exp)
+       (eq? (car exp) tag)))
+
+;;; Quotations
+
+(define (quoted? exp) (tagged-list? exp 'quote))
+
+(define (text-of-quotation quot) (cadr quot))
+
+;;; Assignment--- SET!
+
+(define (assignment? exp) (tagged-list? exp 'set!))
+(define (permanent-assignment? exp) (tagged-list? exp 'set!!))
+
+(define (assignment-variable assn) (cadr  assn))
+(define (assignment-value    assn) (caddr assn))
+
+;;; Definitions
+
+(define (definition? exp) (tagged-list? exp 'define))
+
+(define (definition-variable defn)
+  (if (variable? (cadr defn))			;;   (DEFINE  foo      ...)
+      (cadr  defn)
+      (caadr defn)))				;;   (DEFINE (foo ...) ...)
+
+(define (definition-value defn)
+  (if (variable? (cadr defn))			;;   (DEFINE  foo        ...)
+      (caddr defn)
+      (cons 'lambda				;;   (DEFINE (foo p...) b...)
+            (cons (cdadr defn)			;; = (DEFINE  foo
+                  (cddr  defn)))))		;;     (LAMBDA (p...) b...))
+
+;;; LAMBDA expressions
+
+(define (lambda? exp) (tagged-list? exp 'lambda))
+(define (lambda-parameters lambda-exp) (cadr lambda-exp))
+(define (lambda-body lambda-exp)
+  (let ((full-body (cddr lambda-exp)))
+    (sequence->begin full-body)))
+
+
+(define declaration? pair?)
+
+(define (parameter-name var-decl)
+  (if (pair? var-decl)
+      (car var-decl)
+      var-decl))
+
+(define (lazy? var-decl)
+  (and (pair? var-decl)
+       (memq 'lazy (cdr var-decl))
+       (not (memq 'memo (cdr var-decl)))))
+
+(define (lazy-memo? var-decl)
+  (and (pair? var-decl)
+       (memq 'lazy (cdr var-decl))
+       (memq 'memo (cdr var-decl))))
+
+(define (sequence->begin seq)
+  (cond ((null? seq) seq)
+	((null? (cdr seq)) (car seq))
+	((begin? (car seq)) seq)
+	(else (make-begin seq))))
+
+(define (make-begin exp) (cons 'begin exp))
+
+;;; If conditionals
+
+(define (if? exp) (tagged-list? exp 'if))
+
+(define (if-predicate exp) (cadr exp))
+
+(define (if-consequent exp) (caddr exp))
+
+(define (if-alternative exp)
+  (if (not (null? (cdddr exp)))
+      (cadddr exp)
+      'the-unspecified-value))
+
+(define (make-if pred conseq alternative)
+  (list 'IF pred conseq alternative))
+
+
+;;; COND Conditionals
+
+(define (cond? exp) (tagged-list? exp 'cond))
+
+(define (clauses cndl) (cdr cndl))
+(define (no-clauses? clauses) (null? clauses))
+(define (first-clause clauses) (car clauses))
+(define (rest-clauses clauses) (cdr clauses))
+(define (else-clause? clause) (eq? (predicate clause) 'else))
+
+(define (predicate clause) (car clause))
+
+(define (actions clause)
+  (sequence->begin (cdr clause)))
+
+(define (cond->if cond-exp)
+  (define (expand clauses)
+    (cond ((no-clauses? clauses)
+	   (list 'error "COND: no values matched"))
+	  ((else-clause? (car clauses))
+	   (if (no-clauses? (cdr clauses))
+	       (actions (car clauses))
+	       (error "else clause isn't last -- INTERP" exp)))
+	  (else
+	   (make-if (predicate (car clauses))
+		    (actions (car clauses))
+		    (expand (cdr clauses))))))
+  (expand (clauses cond-exp)))
+
+
+;;; BEGIN expressions (a.k.a. sequences)
+
+(define (begin? exp) (tagged-list? exp 'begin))
+(define (begin-actions begin-exp) (cdr begin-exp))
+
+(define (last-exp? seq) (null? (cdr seq)))
+(define (first-exp seq) (car seq))
+(define (rest-exps seq) (cdr seq))
+(define no-more-exps? null?)		; for non-tail-recursive vers.
+
+;;; LET expressions
+
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-bound-variables let-exp)
+  (map car (cadr let-exp)))
+(define (let-values let-exp) (map cadr (cadr let-exp)))
+(define (let-body let-exp) (sequence->begin (cddr let-exp)))
+(define (let->combination let-exp)
+  (let ((names (let-bound-variables let-exp))
+	(values (let-values let-exp))
+	(body (let-body let-exp)))
+    (cons (list 'LAMBDA names body)
+	  values)))
+
+;;; Procedure applications -- NO-ARGS? and LAST-OPERAND? added
+
+(define (application? exp)
+  (pair? exp))
+
+(define (no-args? exp)				;; Added for tail recursion
+  (and (pair? exp)
+       (null? (cdr exp))))
+
+(define (args-application? exp)			;; Changed from 5.2.1
+  (and (pair? exp)
+       (not (null? (cdr exp)))))
+
+
+(define (operator app) (car app))
+(define (operands app) (cdr app))
+
+(define (last-operand? args)			;; Added for tail recursion
+  (null? (cdr args)))
+
+(define (no-operands? args) (null? args))
+(define (first-operand args) (car args))
+(define (rest-operands args) (cdr args))
+
+;;; Another special form that will be needed later.
+
+(define (amb? exp)
+  (and (pair? exp) (eq? (car exp) 'amb)))
+
+(define (amb-alternatives exp) (cdr exp))
+
diff --git a/ps04_combinators_amb/utils.scm b/ps04_combinators_amb/utils.scm
new file mode 100644
index 0000000..cac9281
--- /dev/null
+++ b/ps04_combinators_amb/utils.scm
@@ -0,0 +1,17 @@
+(declare (usual-integrations))
+
+
+(define (identity x) x)
+
+(define (any? x) #t)
+
+
+(define ((compose f g) x) (f (g x)))
+
+
+;;; This is to keep the Scheme printer from going into an infinite
+;;; loop if you try to print a circular data structure, such as an
+;;; environment
+
+(set! *unparser-list-depth-limit* 10)
+(set! *unparser-list-breadth-limit* 10)