ps4 stuff

1 files changed, 30 insertions, 0 deletions

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))))