1 files changed, 141 insertions, 0 deletions
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?)