|
|
|
@ -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 (for/list ([x (in-list variables)])
|
|
|
|
|
(if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned)))
|
|
|
|
|
;(report assignments assignments-after)
|
|
|
|
|
(define missing (length (filter (λ(v) (equal? v _unassigned)) parms)))
|
|
|
|
|
(define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables))
|
|
|
|
|
(define missing (length (filter (λ(p) (equal? p _unassigned)) parms)))
|
|
|
|
|
(if (> missing 0)
|
|
|
|
|
(begin
|
|
|
|
|
;(report missing)
|
|
|
|
|
;(report _assigned)
|
|
|
|
|
;(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))))
|
|
|
|
|
(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)])
|
|
|
|
|
(set! value (if (hash-has-key? assignments variable)
|
|
|
|
|
(hash-ref assignments variable)
|
|
|
|
|
_unassigned))
|
|
|
|
|
(when (not (equal? value _unassigned))
|
|
|
|
|
(when (value . in? . seen)
|
|
|
|
|
(set! return-value #f)
|
|
|
|
|
(return-k))
|
|
|
|
|
(hash-set! seen value #t)))
|
|
|
|
|
(define values (map (λ(v) (hash-ref assignments v _unassigned)) variables))
|
|
|
|
|
(for ([value (in-list values)]
|
|
|
|
|
#:when (not (equal? value _unassigned)))
|
|
|
|
|
(when (hash-has-key? (report seen) value)
|
|
|
|
|
(set! return-value #f)
|
|
|
|
|
(return-k))
|
|
|
|
|
(hash-set! seen value #t))
|
|
|
|
|
|
|
|
|
|
(when forward-check?
|
|
|
|
|
(for ([variable (in-list variables)])
|
|
|
|
|
(when (not (variable . in? . assignments))
|
|
|
|
|
(set! domain (hash-ref domains variable))
|
|
|
|
|
(for ([value (in-hash-keys seen)])
|
|
|
|
|
(when (value . in? . (get-field _list (hash-ref domains variable)))
|
|
|
|
|
(when (not (hash-has-key? assignments variable))
|
|
|
|
|
(let ([domain (hash-ref domains variable)])
|
|
|
|
|
(for ([value (in-hash-keys seen)]
|
|
|
|
|
#: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)
|
|
|
|
|