solutions to 4.35, 4.36 and 4.37

[sicp.git] / src / sicp / amb-eli.rkt

diff --git a/src/sicp/amb-eli.rkt b/src/sicp/amb-eli.rkt
new file mode 100644 (file)
index 0000000..737fd82
--- /dev/null
+++ b/src/sicp/amb-eli.rkt
@@ -0,0 +1,42 @@
+#lang racket
+(provide amb assert)
+
+(define failures null)
+
+(define (fail)
+  (if (pair? failures)
+      ((first failures))
+      (error "no more choices!")))
+
+(define (amb/thunks choices)
+  (let/cc k (set! failures (cons k failures)))
+  (if (pair? choices)
+      (let ([choice (first choices)])
+        (set! choices (rest choices))
+        (choice))
+      (begin (set! failures (rest failures))
+             (fail))))
+
+(define-syntax-rule (amb E ...)
+  (amb/thunks (list (lambda () E) ...)))
+
+(define (assert condition)
+  (unless condition (fail)))
+
+(define (collect/thunk n thunk)
+  (define results null)
+  (let/cc too-few
+    (set! failures (list too-few))
+    (define result (thunk))
+    (set! results (cons result results))
+    (set! n (sub1 n))
+    (unless (zero? n) (fail)))
+  (set! failures null)
+  (reverse results))
+
+(define-syntax collect
+  (syntax-rules ()
+    ;; collect N results
+    [(_ N E) (collect/thunk N (lambda () E))]
+    ;; collect all results
+    [(_ E) (collect/thunk -1 (lambda () E))]))