simplify

csp/constraint.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require racket/class sugar/container "helper.rkt" "variable.rkt")
+(require racket/class sugar/container sugar/debug racket/list "helper.rkt" "variable.rkt")
 (provide (all-defined-out))
 
 (define constraint%
@@ -29,41 +29,32 @@
         (define variable (car variables))
         (define domain (hash-ref domains variable))
         (set-field! _list domain
-                    (for/fold ([domain-values (get-field _list domain)]) 
+                    (for/fold ([domain-values (send domain get-values)]) 
-                      ([value (in-list (get-field _list domain))] 
+                      ([value (in-list (send domain get-values))] 
                        #:when (not (call 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)))))
     
+    ;;  Helper method for generic forward checking
+    ;;  Currently, this method acts only when there's a single
+    ;;  unassigned variable.
     (define/public (forward-check variables domains assignments [_unassigned Unassigned])
-      ;;  Helper method for generic forward checking
+      (define unassigned-variables 
-      ;;  Currently, this method acts only when there's a single
+        (filter-not (λ(v) (hash-has-key? assignments v)) variables))
-      ;;  unassigned variable.
+      (cond
-      (define return-result (void))      
+        ;; Remove from the unassigned variable's domain 
-      (let/ec break
+        ;; all values that break our variable's constraints.
-        (set! return-result #t)
+        [(= (length unassigned-variables) 1)
-        (define unassignedvariable _unassigned)
+         (define unassigned-variable (car unassigned-variables))
-        (for ([variable (in-list variables)] 
+         (define domain (hash-ref domains unassigned-variable))
-              #:when (not (hash-has-key? assignments variable)))
+         (for ([value (in-list (send domain get-values))])
-          (if (equal? unassignedvariable _unassigned)
+           (hash-set! assignments unassigned-variable value)
-              (set! unassignedvariable variable)
+           (when (not (call variables domains assignments))
-              (break)))
+             (send domain hide-value value)))
-        (when (not (equal? unassignedvariable _unassigned))
+         (hash-remove! assignments unassigned-variable)
-          
+         (not (send domain values-empty?))]
-          ;; Remove from the unassigned variable's domain all
+        [else #t]))
-          ;; values which break our variable's constraints.
-          (define domain (hash-ref domains unassignedvariable))
-          (when (not (null? (get-field _list domain)))
-            (for ([value (in-list (get-field _list domain))])
-              (hash-set! assignments unassignedvariable value)
-              (when (not (send this call variables domains assignments))
-                (send domain hide-value value)))
-            (hash-remove! assignments unassignedvariable))
-          (when (null? (get-field _list domain))
-            (set! return-result #f)
-            (break))))
-      return-result)
     ))
 
 (define constraint%? (is-a?/c constraint%))
@@ -160,10 +151,10 @@
           (for ([variable (in-list variables)])
             (when (not (variable . in? . assignments))
               (set! domain (hash-ref domains variable))
-              (when (not (singlevalue . in? . (get-field _list domain)))
+              (when (not (singlevalue . in? . (send domain get-values)))
                 (set! return-value #f)
                 (return-k))
-              (for ([value (in-list (get-field _list domain))])
+              (for ([value (in-list (send domain get-values))])
                 (when (not (equal? value singlevalue))
                   (send domain hide-value value))))))
         (set! return-value #t)

csp/domain.rkt

@@ -48,6 +48,11 @@
       (set! _list (remove value _list))
       (py-append! _hidden value))
     
+    (define/public (get-values)
+      _list)
+    
+    (define/public (values-empty?)
+      (null? _list))
     
     (define/public (domain-pop!)
       (py-pop! _list))

csp/problem.rkt

@@ -52,7 +52,7 @@
       (define domain (if (domain%? domain-or-values)
                          (send domain-or-values copy)
                          (new domain% [set domain-or-values])))
-      (when (null? (get-field _list domain)) 
+      (when (send domain values-empty?) 
         (error 'add-variable "domain value is null"))
       (hash-set! _variable-domains variable domain))
     
@@ -114,6 +114,6 @@
       
       (if (for/or ([domain (in-hash-values variable-domains)])
             (send domain reset-state)
-            (null? (get-field _list domain)))
+            (send domain values-empty?))
           (values null null null)
           (values variable-domains constraints vconstraints)))))