From db950ffbdf0cc267e3254255e5d3daefd06392fa Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Tue, 24 Feb 2009 19:53:41 -0500
Subject: problem set 3 files

---
 ps03_evalapply/bnewbold_interp.scm    | 141 +++++++++++++++
 ps03_evalapply/bnewbold_ps3.txt       |  38 ++++
 ps03_evalapply/general-procedures.scm | 141 +++++++++++++++
 ps03_evalapply/ghelper.scm            | 102 +++++++++++
 ps03_evalapply/interp.scm             | 131 ++++++++++++++
 ps03_evalapply/kons.scm               |  12 ++
 ps03_evalapply/load-general.scm       |  17 ++
 ps03_evalapply/load.scm               |  13 ++
 ps03_evalapply/ps.txt                 | 317 ++++++++++++++++++++++++++++++++++
 ps03_evalapply/repl.scm               |  48 +++++
 ps03_evalapply/rtdata.scm             |  88 ++++++++++
 ps03_evalapply/syntax.scm             | 188 ++++++++++++++++++++
 ps03_evalapply/utils.scm              |  17 ++
 13 files changed, 1253 insertions(+)
 create mode 100644 ps03_evalapply/bnewbold_interp.scm
 create mode 100644 ps03_evalapply/bnewbold_ps3.txt
 create mode 100644 ps03_evalapply/general-procedures.scm
 create mode 100644 ps03_evalapply/ghelper.scm
 create mode 100644 ps03_evalapply/interp.scm
 create mode 100644 ps03_evalapply/kons.scm
 create mode 100644 ps03_evalapply/load-general.scm
 create mode 100644 ps03_evalapply/load.scm
 create mode 100644 ps03_evalapply/ps.txt
 create mode 100644 ps03_evalapply/repl.scm
 create mode 100644 ps03_evalapply/rtdata.scm
 create mode 100644 ps03_evalapply/syntax.scm
 create mode 100644 ps03_evalapply/utils.scm

diff --git a/ps03_evalapply/bnewbold_interp.scm b/ps03_evalapply/bnewbold_interp.scm
new file mode 100644
index 0000000..67bcad1
--- /dev/null
+++ b/ps03_evalapply/bnewbold_interp.scm
@@ -0,0 +1,141 @@
+(declare (usual-integrations eval apply))
+
+(define (default-eval expression environment)
+  (cond ((application? expression)
+	 (apply (eval (operator expression) environment)
+		(operands expression)
+		environment))
+	(else
+	 (error "Unknown expression type" expression))))
+
+(define (default-apply procedure operands calling-environment)
+  (error "Unknown procedure type" procedure))
+
+
+
+(define eval
+  (make-generic-operator 2 default-eval))
+
+(defhandler eval
+  (lambda (expression environment) expression)
+  self-evaluating?)
+
+(defhandler eval lookup-variable-value variable?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (text-of-quotation expression))
+  quoted?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (make-compound-procedure
+     (lambda-parameters expression)
+     (lambda-body expression)
+     environment))
+  lambda?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (if (eval (if-predicate expression) environment)
+	(eval (if-consequent expression) environment)
+	(eval (if-alternative expression) environment)))
+  if?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (eval (cond->if expression) environment))
+  cond?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (eval (let->combination expression) environment))
+  let?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (evaluate-sequence (begin-actions expression)
+		       environment))
+  begin?)
+
+(define (evaluate-sequence actions environment)
+  (cond ((null? actions)
+	 (error "Empty sequence"))
+	((null? (rest-exps actions))
+	 (eval (first-exp actions) environment))
+	(else
+	 (eval (first-exp actions) environment)
+	 (evaluate-sequence (rest-exps actions) environment))))
+
+(defhandler eval
+  (lambda (expression environment)
+    (define-variable! (definition-variable expression)
+      (eval (definition-value expression) environment)
+      environment)
+    (definition-variable expression))
+  definition?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (set-variable-value! (assignment-variable expression)
+      (eval (assignment-value expression) environment)
+      environment))
+  assignment?)
+
+(define apply
+  (make-generic-operator 3 default-apply))
+
+(defhandler apply
+  (lambda (procedure operands calling-environment)
+    (apply-primitive-procedure procedure
+      (evaluate-list operands calling-environment)))
+  strict-primitive-procedure?)
+
+(define (evaluate-list operands calling-environment)
+  (cond ((null? operands) '())
+	((null? (rest-operands operands))
+	 (list (eval (first-operand operands)
+		     calling-environment)))
+	(else
+	 (cons (eval (first-operand operands)
+		     calling-environment)
+	       (evaluate-list (rest-operands operands)
+			      calling-environment)))))
+
+(defhandler apply
+  (lambda (procedure operands calling-environment)
+    (if (not (= (length (procedure-parameters procedure))
+		(length operands)))
+	(error "Wrong number of operands supplied"))
+    (let ((arguments
+	   (map (lambda (parameter operand)
+		  (evaluate-procedure-operand parameter
+					      operand
+					      calling-environment))
+		(procedure-parameters procedure)
+		operands)))
+      (eval (procedure-body procedure)
+	    (extend-environment
+	     (map procedure-parameter-name
+		  (procedure-parameters procedure))
+	     arguments
+	     (procedure-environment procedure)))))
+  compound-procedure?)
+
+(defhandler apply
+  (lambda (proc-vector operands calling-environment)
+    (vector-map 
+     (lambda (proc) (apply proc
+			   operands 
+			   calling-environment))
+     proc-vector))
+  vector?)
+
+(define evaluate-procedure-operand
+  (make-generic-operator 3
+			 (lambda (parameter operand environment)
+			   (eval operand environment))))
+
+(define procedure-parameter-name
+  (make-generic-operator 1 (lambda (x) x)))
+
diff --git a/ps03_evalapply/bnewbold_ps3.txt b/ps03_evalapply/bnewbold_ps3.txt
new file mode 100644
index 0000000..3d80a95
--- /dev/null
+++ b/ps03_evalapply/bnewbold_ps3.txt
@@ -0,0 +1,38 @@
+;;; 6.945 Problem Set #3
+;;; 02/25/2009
+;;; Bryan Newbold <bnewbold@mit.edu>
+
+
+Problem 3.1
+------------------------
+(shouldn't be too hard, handling vectors of procedures as procedures)
+
+
+Problem 3.2
+------------------------
+(use tagged variable symbols?)
+(use tagged function symbols?)
+
+Problem 3.3
+------------------------
+a.
+(description)
+
+b.
+(description...?)
+
+
+Problem 3.4
+------------------------
+a.
+(non-memoizing: generation of random lists? generators? streams?)
+
+b.
+(not sure)
+
+c.
+(not sure)
+
+Problem 3.5
+------------------------
+(ahhh! open ended project!)
diff --git a/ps03_evalapply/general-procedures.scm b/ps03_evalapply/general-procedures.scm
new file mode 100644
index 0000000..2412500
--- /dev/null
+++ b/ps03_evalapply/general-procedures.scm
@@ -0,0 +1,141 @@
+;;; Modifications to provide for general procedures.
+
+;;; Syntax extension: allow decorated parameter names.
+
+(defhandler procedure-parameter-name car pair?)
+
+
+;;; run-time-data extension
+
+(define (delay expression environment)
+  (vector 'delayed expression environment))
+
+(define (delay-memo expression environment)
+  (vector 'delayed-memo expression environment))
+
+(define (delayed? x)
+  (and (vector? x)
+       (eq? (vector-ref x 0) 'delayed)))
+
+(define (delayed-memo? x)
+  (and (vector? x)
+       (eq? (vector-ref x 0) 'delayed-memo)))
+
+(define (deferred? x)
+  (or (delayed? x) (delayed-memo? x)))
+
+(define (undelayed-memo? x)
+  (and (vector? x)
+       (eq? (vector-ref x 0) 'undelayed-memo)))
+  
+(define (delayed-expression x)
+  (vector-ref x 1))
+
+(define (delayed-environment x)
+  (vector-ref x 2))
+
+
+(define (undelay-memo! x value)
+  (vector-set! x 0 'undelayed-memo)
+  (vector-set! x 1 value)
+  (vector-set! x 2 the-empty-environment))
+
+(define (undelayed-value x)
+  (vector-ref x 1))
+
+;;; Evaluator extension -- change to IF:
+;;;  Must have actual predicate value to proceed from IF.
+
+(defhandler eval
+  (lambda (expression environment)
+    (if (undelay!
+	 (eval (if-predicate expression) environment))
+	(eval (if-consequent expression) environment)
+	(eval (if-alternative expression) environment)))
+  if?)
+
+
+;;; Apply extension:
+;;;  Must have actual procedure to apply it.
+
+(defhandler apply
+  (lambda (procedure operands calling-environment)
+    (apply (undelay! procedure)
+	   operands
+	   calling-environment))
+  deferred?)
+
+
+;;; Must have values of arguments for strict primitives.
+
+(define (evaluate-list operands calling-environment)
+  (cond ((null? operands) '())
+	((null? (rest-operands operands))
+	 (list (undelay! (eval (first-operand operands)
+			       calling-environment))))
+	(else
+	 (cons (undelay! (eval (first-operand operands)
+			       calling-environment))
+	       (evaluate-list (rest-operands operands)
+			      calling-environment)))))
+
+
+(defhandler evaluate-procedure-operand
+  (lambda (parameter operand environment)
+    (delay operand environment))
+  lazy?)
+
+(defhandler evaluate-procedure-operand
+  (lambda (parameter operand environment)
+    (delay-memo operand environment))
+  lazy-memo?)
+
+(define undelay!
+  (make-generic-operator 1 (lambda (x) x)))
+
+(defhandler undelay!
+  (lambda (object)
+    (undelay! (eval (delayed-expression object)
+		    (delayed-environment object))))
+  delayed?)
+
+(defhandler undelay!
+  (lambda (object)
+    (let ((value
+	   (undelay! (eval (delayed-expression object)
+			   (delayed-environment object)))))
+      (undelay-memo! object value)
+      value))
+  delayed-memo?)
+
+(defhandler undelay!
+  undelayed-value
+  undelayed-memo?)
+
+
+;;; For printing output
+
+(defhandler write
+  (compose write undelay!)
+  deferred?)
+
+(defhandler write-line
+  (compose write-line undelay!)
+  deferred?)
+
+(defhandler pp
+  (compose pp undelay!)
+  deferred?)
+
+
+(defhandler write
+  (compose write undelayed-value)
+  undelayed-memo?)
+
+(defhandler write-line
+  (compose write-line undelayed-value)
+  undelayed-memo?)
+
+(defhandler pp
+  (compose pp undelayed-value)
+  undelayed-memo?)
diff --git a/ps03_evalapply/ghelper.scm b/ps03_evalapply/ghelper.scm
new file mode 100644
index 0000000..7b8613d
--- /dev/null
+++ b/ps03_evalapply/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/ps03_evalapply/interp.scm b/ps03_evalapply/interp.scm
new file mode 100644
index 0000000..f16ad8b
--- /dev/null
+++ b/ps03_evalapply/interp.scm
@@ -0,0 +1,131 @@
+(declare (usual-integrations eval apply))
+
+(define (default-eval expression environment)
+  (cond ((application? expression)
+	 (apply (eval (operator expression) environment)
+		(operands expression)
+		environment))
+	(else
+	 (error "Unknown expression type" expression))))
+
+(define (default-apply procedure operands calling-environment)
+  (error "Unknown procedure type" procedure))
+
+
+
+(define eval
+  (make-generic-operator 2 default-eval))
+
+(defhandler eval
+  (lambda (expression environment) expression)
+  self-evaluating?)
+
+(defhandler eval lookup-variable-value variable?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (text-of-quotation expression))
+  quoted?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (make-compound-procedure
+     (lambda-parameters expression)
+     (lambda-body expression)
+     environment))
+  lambda?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (if (eval (if-predicate expression) environment)
+	(eval (if-consequent expression) environment)
+	(eval (if-alternative expression) environment)))
+  if?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (eval (cond->if expression) environment))
+  cond?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (eval (let->combination expression) environment))
+  let?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (evaluate-sequence (begin-actions expression)
+		       environment))
+  begin?)
+
+(define (evaluate-sequence actions environment)
+  (cond ((null? actions)
+	 (error "Empty sequence"))
+	((null? (rest-exps actions))
+	 (eval (first-exp actions) environment))
+	(else
+	 (eval (first-exp actions) environment)
+	 (evaluate-sequence (rest-exps actions) environment))))
+
+(defhandler eval
+  (lambda (expression environment)
+    (define-variable! (definition-variable expression)
+      (eval (definition-value expression) environment)
+      environment)
+    (definition-variable expression))
+  definition?)
+
+(defhandler eval
+  (lambda (expression environment)
+    (set-variable-value! (assignment-variable expression)
+      (eval (assignment-value expression) environment)
+      environment))
+  assignment?)
+
+(define apply
+  (make-generic-operator 3 default-apply))
+
+(defhandler apply
+  (lambda (procedure operands calling-environment)
+    (apply-primitive-procedure procedure
+      (evaluate-list operands calling-environment)))
+  strict-primitive-procedure?)
+
+(define (evaluate-list operands calling-environment)
+  (cond ((null? operands) '())
+	((null? (rest-operands operands))
+	 (list (eval (first-operand operands)
+		     calling-environment)))
+	(else
+	 (cons (eval (first-operand operands)
+		     calling-environment)
+	       (evaluate-list (rest-operands operands)
+			      calling-environment)))))
+
+(defhandler apply
+  (lambda (procedure operands calling-environment)
+    (if (not (= (length (procedure-parameters procedure))
+		(length operands)))
+	(error "Wrong number of operands supplied"))
+    (let ((arguments
+	   (map (lambda (parameter operand)
+		  (evaluate-procedure-operand parameter
+					      operand
+					      calling-environment))
+		(procedure-parameters procedure)
+		operands)))
+      (eval (procedure-body procedure)
+	    (extend-environment
+	     (map procedure-parameter-name
+		  (procedure-parameters procedure))
+	     arguments
+	     (procedure-environment procedure)))))
+  compound-procedure?)
+
+(define evaluate-procedure-operand
+  (make-generic-operator 3
+			 (lambda (parameter operand environment)
+			   (eval operand environment))))
+
+(define procedure-parameter-name
+  (make-generic-operator 1 (lambda (x) x)))
diff --git a/ps03_evalapply/kons.scm b/ps03_evalapply/kons.scm
new file mode 100644
index 0000000..4fc7b73
--- /dev/null
+++ b/ps03_evalapply/kons.scm
@@ -0,0 +1,12 @@
+;;; A valuable special form -- the nonstrict version of CONS:
+
+(define (kons? exp)
+  (and (pair? exp)
+       (eq? (car exp) 'kons)))
+
+(defhandler eval
+  (lambda (expression environment)
+    (cons (delay-memo (cadr expression) environment)
+	  (delay-memo (caddr expression) environment)))
+  kons?)
+
diff --git a/ps03_evalapply/load-general.scm b/ps03_evalapply/load-general.scm
new file mode 100644
index 0000000..569aeba
--- /dev/null
+++ b/ps03_evalapply/load-general.scm
@@ -0,0 +1,17 @@
+(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 "interp" generic-evaluation-environment)
+(load "repl" generic-evaluation-environment)
+
+;;; This allows nonstrict definitions.
+(load "general-procedures" generic-evaluation-environment)
+(load "kons" generic-evaluation-environment)
+
+(ge generic-evaluation-environment)
\ No newline at end of file
diff --git a/ps03_evalapply/load.scm b/ps03_evalapply/load.scm
new file mode 100644
index 0000000..ebca908
--- /dev/null
+++ b/ps03_evalapply/load.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 "bnewbold_interp" generic-evaluation-environment)
+(load "repl" generic-evaluation-environment)
+
+(ge generic-evaluation-environment)
diff --git a/ps03_evalapply/ps.txt b/ps03_evalapply/ps.txt
new file mode 100644
index 0000000..389affa
--- /dev/null
+++ b/ps03_evalapply/ps.txt
@@ -0,0 +1,317 @@
+
+
+                MASSACHVSETTS INSTITVTE OF TECHNOLOGY
+      Department of Electrical Engineering and Computer Science
+
+                          6.945 Spring 2009
+                            Problem Set 3
+
+  Issued: Wed. 18 Feb. 2009                    Due: Wed. 25 Feb. 2009
+
+Reading:
+    SICP, From Chapter 4: 4.1 and 4.2; (pp. 359--411)
+    en.wikipedia.org/wiki/Evaluation_strategy
+    www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR44
+
+Code: load.scm, utils.scm, ghelper.scm, 
+      syntax.scm, rtdata.scm, interp.scm, repl.scm
+      general-procedures.scm
+   code is on the class web page... no reason to kill more trees.
+
+
+Evaluators for Extended Scheme
+
+You will be working with an evaluator system for an extended version
+of Scheme similar to the ones described in SICP, Chapter 4.  Without a
+good understanding of how the evaluator is structured it is very easy
+to become confused between the programs that the evaluator is
+interpreting, the procedures that implement the evaluator itself, and
+Scheme procedures called by the evaluator.  You will need to study
+Chapter 4 through subsection 4.2.2 carefully in order to do this
+assignment.
+
+The interpreters in the code that we will work with in this problem
+set are built on the generic operations infrastructure we developed in
+the last problem set.  (Actually, there is a small change: we specify
+a handler with "defhandler" as an alias for "assign-operation".  Also,
+we allow handlers to be specified without declaring all of the
+arguments, avoiding the need for "any?".)  Indeed, in these
+interpreters, unlike the ones in SICP, EVAL and APPLY are generic
+operations!  That means that we may easily extend the types of
+expressons (by adding new handlers to EVAL) and the types of
+procedures (by adding new handlers to APPLY).
+
+Before beginning work on this problem set you should carefully read
+the code in interp.scm.  Also, look at the difference between the
+ghelper.scm in this problem set and the ghelper.scm in the previous
+set.
+
+		    Using the generic interpreter
+
+Download the supplied code to a fresh directory in your computer.
+Get a fresh Scheme system, and load the file load.scm:
+
+   (load "<your-code-directory>/load")
+
+Initialize the evaluator:
+
+   (init)
+
+You will get a prompt:
+
+   eval> 
+
+You can enter an expression at the prompt:
+
+   eval> (define cube (lambda (x) (* x x x)))
+   cube
+   
+   eval> (cube 3)
+   27
+
+The evaluator code we supplied does not have an error system of its
+own, so it reverts to the underlying Scheme error system.  (Maybe an
+interesting little project?  It is worth understanding how to make
+exception-handling systems!)  If you get an error, clear the error
+with two control Cs and then continue the evaluator with "(go)" at the
+Scheme.  If you redo "(init)" you will lose the definition of cube,
+because a new environment will be made.
+
+   eval> (cube a)
+   ;Unbound variable a
+   ;Quit!
+
+   (go)
+
+   eval> (cube 4)
+   64
+
+   eval> (define (fib n)
+            (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
+   fib
+
+   eval> (fib 10)
+   55
+
+You can always get out of the generic evaluator and get back to the
+underlying Scheme system by quitting (with two control Cs).
+
+-------------
+Problem 3.1: Warmup
+
+In mathematical text a common abuse of notation is to identify a
+tuple of functions with a function that returns a tuple of values.
+For example, (written in Lisp prefix form)
+
+ If   (cos 0.6) ==> 0.8253356149096783 
+ and  (sin 0.6) ==> 0.5646424733950354
+
+ then we expect
+
+ ((vector cos sin) 0.6) ==> #(0.8253356149096783 0.5646424733950354)
+
+This requires that an extension to APPLY so it can handle Scheme
+vectors as a kind of function.  Make this extension; demonstrate it;
+show that it interoperates with more conventional code.
+-------------
+
+
+-------------
+Problem 3.2: Unbound-variable handling
+
+In Lisps, including Scheme, attempting to evaluate an unbound symbol
+is an unbound-variable error.  However, in some algebraic processes it
+is sensible to allow an unbound symbol to be a self-evaluating object.
+For example, if we generically extend arithmetic to build algebraic
+expressions with symbolic values, it is sometimes useful to allow the
+following: 
+
+(+ (* 2 3) (* 4 5)) ==> 26
+
+(+ (* a 3) (* 4 5)) ==> (+ (* a 3) 20)
+
+In this case, the symbol "a" is unbound and self-evaluating.  The
+operators "*" and "+" are extended to just build expressions when
+their arguments are not reducible to numbers.  
+
+Make generic extensions to +, *, -, /, and to EVAL, to allow this kind
+of behavior. 
+
+Also augment APPLY to allow literal functions, known only by their
+names:
+
+(+ (f 3) (* 4 5)) ==> (+ (f 3) 20)
+
+These extensions to EVAL and APPLY are generally dangerous, because
+they hide real unbound-variable errors.  Make them contingent on the
+value of a user-settable variable: ALLOW-SELF-EVALUATING-SYMBOLS.
+-------------
+
+Much more powerful extensions are available once we accept generic
+operations at this level.  For example, we can allow procedures to
+have both strict and non-strict arguments.  
+
+   If you don't know what we are talking about here please read 
+   the article: http://en.wikipedia.org/wiki/Evaluation_strategy.
+
+If you load the file general-procedures.scm into the underlying
+Scheme, after loading (with '(load "load")') the generic interpreter,
+you will find that there are extensions that allow us to define
+procedures with some formal parameters asking for the matching
+arguments to be lazy (or lazy and memoized).  Other undecorated
+parameters take their arguments strictly.  These extensions make it
+relatively easy to play otherwise painful games.  For example, we may
+define the UNLESS conditional as an ordinary procedure:
+
+   ;Quit!
+
+   (load "general-procedures" generic-evaluation-environment)
+   ;Loading "general-procedures.scm"... 
+   ;Warning: Replacing top-level handler
+   ;... done
+   ;Value: #[compound-procedure 17 operator]
+
+
+   (go)
+
+   eval> (define unless
+           (lambda (condition (usual lazy) (exception lazy))
+	     (if condition exception usual)))
+
+We may use the usual define abbreviations (see syntax.scm):
+
+   eval> (define (unless condition (usual lazy) (exception lazy))
+	   (if condition exception usual))
+   unless
+
+   eval> (define (ffib n)
+	   (unless (< n 2)
+		   (+ (ffib (- n 1)) (ffib (- n 2)))
+		   n))
+   ffib
+
+   eval> (ffib 10)
+   55
+
+Notice that UNLESS is declared to be strict in its first argument (the
+predicate) but nonstrict in the alternatives: neither alternative will
+be evaluated until it is necessary.
+
+Additionally, if we include the file kons.scm we get a special form
+that is the non-strict memoized version of CONS.  This immediately
+gives us the power of infinite streams:
+
+   ;Quit!
+
+   (load "kons" generic-evaluation-environment)
+   ;Loading "kons.scm"... done
+   ;Value: #[compound-procedure 19 operator]
+
+   (go)
+
+   eval> (define (add-streams s1 s2)
+	   (kons (+ (car s1) (car s2))
+		 (add-streams (cdr s1) (cdr s2))))
+   add-streams
+
+   eval> (define (ref-stream stream n)
+	   (if (= n 0)
+	       (car stream)
+	       (ref-stream (cdr stream) (- n 1))))
+   ref-stream
+
+   eval> (define fibs
+	   (kons 0
+		 (kons 1
+		       (add-streams (cdr fibs) fibs))))
+   fibs
+
+   eval> (ref-stream fibs 10)
+   55
+
+   eval> (ref-stream fibs 20)
+   6765
+
+   eval> (ref-stream fibs 30)
+   832040
+
+   eval> (ref-stream fibs 40)
+   102334155
+
+
+-------------
+Problem 3.3: Streams
+
+a. The non-strict procedure KONS adds great power to the system.
+Notice that there is no need to make CAR or CDR different to obtain
+the use of streams.  In a short paragraph explain why KONS is almost
+sufficient.  It may be instructive to read an ancient paper by
+Friedman and Wise:
+   www.cs.indiana.edu/cgi-bin/techreports/TRNNN.cgi?trnum=TR44
+
+b. Unfortunately, the addition of KONS does not, in itself, solve all
+stream problems.  For example, the difficulty alluded to in SICP
+section 4.2.3 (p. 411) does not automatically dissipate.  If we make
+the following definitions:
+
+   (define (map-stream proc items)
+     (kons (proc (car items))
+	   (map-stream proc (cdr items))))
+
+   (define (scale-stream items factor)
+     (map-stream (lambda (x) (* x factor))
+		 items))
+
+   (define (integral integrand initial-value dt)
+     (define int
+       (kons initial-value
+	     (add-streams (scale-stream integrand dt)
+			  int)))
+     int)
+
+   (define (solve f y0 dt)
+     (define y (integral dy y0 dt))
+     (define dy (map-stream f y))
+     y)
+
+and then we try:
+
+   (ref-stream (solve (lambda (x) x) 1 0.001) 1000)
+
+we will get an error (try it!).  Why?  Explain the error.  What other
+declarations should be made in these stream-procedure definitions to
+fix all such errors?
+-------------
+
+
+-------------
+Problem 3.4: Why not?
+
+a. The KONS special form is equivalent to a CONS with both arguments
+lazy and memoized.  If the arguments were not memoized the computation
+(ref-stream fibs 40) in Problem 3.3a above would take a very long
+time.  Is there ever any advantage to not memoizing?  When might it
+matter?
+
+b. Why, given that CONS is a strict procedure imported from Scheme,
+could we not have defined KONS simply as:
+
+   (define (kons (a lazy memo) (d lazy memo))
+     (cons a d))
+?
+
+c. More generally, the Lisp community has avoided changing CONS to be
+KONS, as recommended by Friedman and Wise.  What potentially serious
+problems are avoided by using CONS rather than KONS?  Assume that we
+do not care about small constant factors in performance.
+-------------
+
+
+-------------
+Problem 3.5: Your turn
+
+Invent some fun, interesting construct that can easily be implemented
+using generic EVAL/APPLY that would be rather painful without that
+kind of generic support.  Show us the construct, the implementation,
+and some illustrative examples.  Enjoy!
+-------------
diff --git a/ps03_evalapply/repl.scm b/ps03_evalapply/repl.scm
new file mode 100644
index 0000000..94a0500
--- /dev/null
+++ b/ps03_evalapply/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/ps03_evalapply/rtdata.scm b/ps03_evalapply/rtdata.scm
new file mode 100644
index 0000000..dad3d7a
--- /dev/null
+++ b/ps03_evalapply/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/ps03_evalapply/syntax.scm b/ps03_evalapply/syntax.scm
new file mode 100644
index 0000000..7c058e4
--- /dev/null
+++ b/ps03_evalapply/syntax.scm
@@ -0,0 +1,188 @@
+;;; -*- Mode:Scheme; Base:10 -*- 
+
+(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 (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 (permanent-assignment? exp) (tagged-list? exp 'set!!))
diff --git a/ps03_evalapply/utils.scm b/ps03_evalapply/utils.scm
new file mode 100644
index 0000000..cac9281
--- /dev/null
+++ b/ps03_evalapply/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)
-- 
cgit v1.2.3