From f769d4cbbc252f2b5dd9c2c6eb494b4e8768ca15 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 11 Oct 2018 08:39:59 -0700
Subject: [PATCH] gen

---
 csp/csp.rkt  | 14 +++++++++++++-
 csp/test.rkt | 22 ++++++++++++++++------
 2 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/csp/csp.rkt b/csp/csp.rkt
index 807ac685..4cb60a81 100644
--- a/csp/csp.rkt
+++ b/csp/csp.rkt
@@ -197,7 +197,6 @@
                              (memq cname assigned-names)))))
     (unless (constraint csp) (raise ($csp-inconsistent)))
     ($csp ($csp-vars csp) (remove constraint ($csp-constraints csp)))))
-                         
 
 (define/contract (backtrack csp)
   ($csp? . -> . $csp?)
@@ -213,6 +212,19 @@
   (($csp?) (procedure?) . ->* . any/c)
   (finish-proc (backtrack (make-arcs-consistent (make-nodes-consistent csp)))))
 
+(require racket/generator)
+(define/contract (backtrack-solver csp)
+  ($csp? . -> . generator?)
+  (generator ()
+             (let loop ([csp csp])
+               (cond
+                 [(assignment-complete? csp) (yield csp)]
+                 [else
+                  (match-define ($var name vals) (select-unassigned-var csp))
+                  (for ([val (in-list (order-domain-values vals))])
+                    (with-handlers ([$csp-inconsistent? (λ (exn) #f)])
+                      (loop (infer (assign-val csp name val)))))]))))
+
 (define ($csp-ref csp name)
   (car ($csp-vals csp name)))
 
diff --git a/csp/test.rkt b/csp/test.rkt
index 5d9a1fc1..7ee0304b 100644
--- a/csp/test.rkt
+++ b/csp/test.rkt
@@ -52,11 +52,21 @@
 ;;      A+B+C
 
 (define abc (make-csp))
-(add-vars! abc '(a b c) (range 1 10))
-(define (test-solution s) (let ([a (car ($csp-vals abc 'a))]
-                                [b (car ($csp-vals abc 'b))]
-                                [c (car ($csp-vals abc 'c))])
-                            (/ (+ (* 100 a) (* 10 b) c) (+ a b c))))
+(add-vars! abc '(a b c) (range 1 3))
+(define (test-solution abc)
+  (let ([a ($csp-ref abc 'a)]
+        [b ($csp-ref abc 'b)]
+        [c ($csp-ref abc 'c)])
+    (/ (+ (* 100 a) (* 10 b) c) (+ a b c))))
+
 
 ;; todo: gather all solutins in generator
-(test-solution (solve abc))
\ No newline at end of file
+(define bs (backtrack-solver abc))
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
\ No newline at end of file