nits

csp/constraint.rkt

@@ -6,7 +6,7 @@
   (class object% 
     (super-new)
     
-    (define/public (call variables domains assignments [forward-check? #f])
+    (define/public (is-true? variables domains assignments [forward-check? #f])
       ;; Perform the constraint checking
       
       ;;  If the forwardcheck parameter is not false, besides telling if
@@ -31,7 +31,7 @@
         (set-field! _list domain
                     (for/fold ([domain-values (domain)]) 
                       ([value (in-list (domain))] 
-                       #:when (not (call variables domains (make-hash (list (cons variable value))))))
+                       #:when (not (is-true? variables domains (make-hash (list (cons variable value))))))
                       (remove value domain-values)))        
         (set! constraints (remove (list this variables) constraints))
         (hash-update! vconstraints variable (λ(val) (remove (list this variables) val)))))
@@ -50,7 +50,7 @@
          (define unassigned-variable-domain (hash-ref domains unassigned-variable))
          (for ([value (in-list (unassigned-variable-domain))])
            (hash-set! assignments unassigned-variable value)
-           (when (not (call variables domains assignments))
+           (when (not (is-true? variables domains assignments))
              (send unassigned-variable-domain hide-value value)))
          (hash-remove! assignments unassigned-variable)
          (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f
@@ -69,7 +69,7 @@
     
     (inherit forward-check)
     
-    (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned])
+    (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned])
       (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables))
       (define missing (length (filter (λ(p) (equal? p _unassigned)) parms)))
       (if (> missing 0)
@@ -85,7 +85,7 @@
   (class constraint% 
     (super-new)
     
-    (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned])
+    (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned])
       (define-values (assigned-vars unassigned-vars) 
         (partition (λ(var) (hash-has-key? assignments var)) variables))      
       (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars))
@@ -106,7 +106,7 @@
   (class constraint% 
     (super-new)
     
-    (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned])
+    (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned])
       (define singlevalue _unassigned)
       (define value #f)
       (define domain #f)

csp/solver.rkt

@@ -74,30 +74,26 @@
               [else
                (set! want-to-return #t) (return-k)]))          
           
-          (let/ec break-loop2
-            (let loop2 ()
-              ;; We have a variable. Do we have any values left?
-              (when (null? values)                
-                ;; No. Go back to last variable, if there's one, else exit.
-                (for/or ([i (in-naturals)])
-                  (hash-remove! assignments variable)
-                  (when (null? queue) (set! want-to-return #t) (return-k))
-                  (set!-values (variable values pushdomains) (pop-vvp-values! queue))
-                  (for-each-send pop-state pushdomains)
-                  (not (null? values))))              
-              
-              ;; Got a value. Check it.
-              (hash-set! assignments variable (car-pop! values))
-              (for-each-send push-state pushdomains)
-              (let/ec break-for-loop
-                (if (for/or ([cvpair (in-list (hash-ref vconstraints variable))])
-                      (match-define (list constraint variables) cvpair)
-                      (not (send constraint call variables domains assignments pushdomains)))
-                    (break-for-loop)
-                    (break-loop2)))
-              
-              (for-each-send pop-state pushdomains)
-              (loop2)))
+          (let constraint-checking-loop ()
+            ;; We have a variable. Do we have any values left?
+            (when (null? values)                
+              ;; No. Go back to last variable, if there is one, otherwise solver is done.
+              (for/or ([i (in-naturals)])
+                (hash-remove! assignments variable)
+                (when (null? queue) (set! want-to-return #t) (return-k))
+                (set!-values (variable values pushdomains) (pop-vvp-values! queue))
+                (for-each-send pop-state pushdomains)
+                (not (null? values))))              
+            
+            ;; Got a value. Check it.
+            (hash-set! assignments variable (car-pop! values))
+            (for-each-send push-state pushdomains)
+            (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))])
+                    (match-define (list constraint variables) cvpair)
+                    (not (send constraint is-true? variables domains assignments pushdomains)))
+              ;; constraint failed, so try again
+              (for-each-send pop-state pushdomains) 
+              (constraint-checking-loop)))
           
           ;; Push state before looking for next variable.
           (set! queue (cons (vvp variable values pushdomains) queue))