From 842bc7139addff134be97208a69e56283dbb5aeb Mon Sep 17 00:00:00 2001
From: bnewbold <bnewbold@eta.mit.edu>
Date: Thu, 26 Feb 2009 02:34:44 -0500
Subject: ps4 stuff

---
 ps04_combinators_amb/repl-amb.scm | 80 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 ps04_combinators_amb/repl-amb.scm

(limited to 'ps04_combinators_amb/repl-amb.scm')

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)
-- 
cgit v1.2.3