Merge pull request #534 from eraserhd/amb-choose-operator

Add element-of to :std/amb

doc/reference/amb.md

@@ -111,6 +111,13 @@ Procedural form of `amb-collect`
 
 Predicate that returns true if *e* is an exception raised because the amb search was exhausted.
 
+### element-of
+```
+(element-of list) -> any
+```
+
+Ambiguous choice from a list; may evaluate and return any element of *list*.
+
 ## Example
 
 Here is the well known dwelling house puzzle:

src/std/amb-test.ss

@@ -18,34 +18,50 @@
             (else #t))))
 
       (def (solve-dwelling-puzzle)
-        (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)))
+        (begin-amb
+         (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)))
 
-          ;; They live on different floors.
-          (required (distinct? (list baker cooper fletcher miller smith)))
+           ;; They live on different floors.
+           (required (distinct? (list baker cooper fletcher miller smith)))
 
-          ;; Baker does not live on the top floor.
-          (required (not (= baker 5)))
+           ;; Baker does not live on the top floor.
+           (required (not (= baker 5)))
 
-          ;; Cooper does not live on the bottom floor.
-          (required (not (= cooper 1)))
+           ;; Cooper does not live on the bottom floor.
+           (required (not (= cooper 1)))
 
-          ;; Fletcher does not live on either the top or the bottom floor.
-          (required (not (= fletcher 5)))
-          (required (not (= fletcher 1)))
+           ;; Fletcher does not live on either the top or the bottom floor.
+           (required (not (= fletcher 5)))
+           (required (not (= fletcher 1)))
 
-          ;; Miller lives on a higher floor than does Cooper.
-          (required (> miller cooper))
+           ;; Miller lives on a higher floor than does Cooper.
+           (required (> miller cooper))
 
-          ;; Smith does not live on a floor adjacent to Fletcher's.
-          (required (not (= (abs (- smith fletcher)) 1)))
+           ;; Smith does not live on a floor adjacent to Fletcher's.
+           (required (not (= (abs (- smith fletcher)) 1)))
 
-          ;; Fletcher does not live on a floor adjacent to Cooper's.
-          (required (not (= (abs (- fletcher cooper)) 1)))
+           ;; Fletcher does not live on a floor adjacent to Cooper's.
+           (required (not (= (abs (- fletcher cooper)) 1)))
 
-          `((baker ,baker) (cooper ,cooper) (fletcher ,fletcher) (miller ,miller) (smith ,smith))))
+           `((baker ,baker) (cooper ,cooper) (fletcher ,fletcher) (miller ,miller) (smith ,smith)))))
 
-      (check (solve-dwelling-puzzle) => '((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))))))
+      (check (solve-dwelling-puzzle) => '((baker 3) (cooper 2) (fletcher 4) (miller 5) (smith 1))))
+    (test-case "all-of"
+      (def (odds<=6)
+        (begin-amb
+         (let (x (amb 1 2 3 4 5 6))
+           (required (odd? x))
+           (all-of x))))
+      (check (odds<=6) => '(1 3 5))
+      (check (begin-amb (all-of (amb))) => '()))
+    (test-case "element-of"
+      (def (even-between-1-and-3)
+        (begin-amb
+          (let (x (element-of '(1 2 3)))
+            (required (even? x))
+            x)))
+      (check (even-between-1-and-3) => 2))))

src/std/amb.ss

@@ -9,7 +9,8 @@
         :std/misc/shuffle)
 (export begin-amb begin-amb-random amb amb-find one-of amb-collect all-of amb-assert required
         amb-do amb-do-find amb-do-collect
-        amb-exhausted?)
+        amb-exhausted?
+        element-of)
 
 (defstruct (amb-completion <error>) ())
 
@@ -113,3 +114,6 @@
       (let (next (thunk))
         (amb-results (cons next (amb-results)))
         ((amb-fail))))))
+
+(def (element-of xs)
+  (amb-do (map (cut lambda () <>) xs)))