tweaks

csp/constraint.rkt

@@ -66,23 +66,14 @@
     (field [_func func][_assigned assigned])
     
     (inherit forward-check)
+    
     (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned])
-      ;(report assignments assignments-before)
+      (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables))
-      (define parms (for/list ([x (in-list variables)])
+      (define missing (length (filter (λ(p) (equal? p _unassigned)) parms)))
-                      (if (hash-has-key? assignments x) (hash-ref assignments x)  _unassigned)))
-      ;(report assignments assignments-after)
-      (define missing (length (filter (λ(v) (equal? v _unassigned)) parms)))
       (if (> missing 0)
-          (begin 
+          (and (or _assigned (apply _func parms))
-            ;(report missing)
+               (or (not forward-check?) (not (= missing 1))
-            ;(report _assigned)
+                   (forward-check variables domains assignments)))
-            ;(report parms)
-            ;(report (apply _func parms))
-            ;(report forwardcheck)
-            ;(report assignments assignments-to-fc)
-            (and (or _assigned (apply _func parms))
-                 (or (not forward-check?) (not (= missing 1))
-                     (forward-check variables domains assignments))))
           (apply _func parms)))
     
     ))
@@ -96,27 +87,25 @@
     
     (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned])
       (define seen (make-hash))
-      (define value #f)
-      (define domain #f)
       (define return-value (void))
+      
       (let/ec return-k
-        (for ([variable (in-list variables)])
+        (define values (map (λ(v) (hash-ref assignments v _unassigned)) variables))
-          (set! value (if (hash-has-key? assignments variable) 
+        (for ([value (in-list values)]
-                          (hash-ref assignments variable)  
+              #:when (not (equal? value _unassigned)))
-                          _unassigned))
+          (when (hash-has-key? (report seen) value)
-          (when (not (equal? value _unassigned))
+            (set! return-value #f)
-            (when (value . in? . seen)
+            (return-k))
-              (set! return-value #f)
+          (hash-set! seen value #t))
-              (return-k))
+        
-            (hash-set! seen value #t)))
         (when forward-check?
           (for ([variable (in-list variables)])
-            (when (not (variable . in? . assignments))
+            (when (not (hash-has-key? assignments variable))
-              (set! domain (hash-ref domains variable))
+              (let ([domain (hash-ref domains variable)])
-              (for ([value (in-hash-keys seen)])
+                (for ([value (in-hash-keys seen)]
-                (when (value . in? . (get-field _list (hash-ref domains variable)))
+                      #:when (member value (send domain get-values)))
                   (send domain hide-value value)
-                  (when (null? (get-field _list (hash-ref domains variable)))
+                  (when (send domain values-empty?)
                     (set! return-value #f)
                     (return-k)))))))
         (set! return-value #t)