gen

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

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))
+(define bs (backtrack-solver abc))
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)
+(bs)