giles
f2817bb6be
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
fd-in x dom-list: narrows x's domain. If x is a ground number, checks membership; if x is a logic var, intersects existing domain (or sets fresh) and stores via fd-set-domain. Fails if domain becomes empty. fd-label vars: drives search by enumerating each var's domain. Each var is unified with each value in its domain, in order, via mk-mplus of singleton streams. Forward: (fd-in x dom) (fd-label (list x)) iterates x over dom. Intersection: two fd-in goals on the same var compose via dom-intersect. Disjoint domains -> empty answer set. Ground value membership check gates pass/fail. Composes with the rest of the miniKanren machinery — fresh / conde / membero etc. all work alongside. 9 new tests, 586/586 cumulative.
121 lines
1.8 KiB
Plaintext
121 lines
1.8 KiB
Plaintext
;; lib/minikanren/tests/clpfd-in-label.sx — fd-in (domain narrowing) + fd-label.
|
|
|
|
;; --- fd-in: domain narrowing ---
|
|
|
|
(mk-test
|
|
"fd-in-bare-label"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(fd-in x (list 1 2 3 4 5))
|
|
(fd-label (list x))
|
|
(== q x)))
|
|
(list 1 2 3 4 5))
|
|
|
|
(mk-test
|
|
"fd-in-intersection"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(fd-in x (list 1 2 3 4 5))
|
|
(fd-in x (list 3 4 5 6 7))
|
|
(fd-label (list x))
|
|
(== q x)))
|
|
(list 3 4 5))
|
|
|
|
(mk-test
|
|
"fd-in-disjoint-empty"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(fd-in x (list 1 2 3))
|
|
(fd-in x (list 7 8 9))
|
|
(fd-label (list x))
|
|
(== q x)))
|
|
(list))
|
|
|
|
(mk-test
|
|
"fd-in-singleton-domain"
|
|
(run*
|
|
q
|
|
(fresh (x) (fd-in x (list 5)) (fd-label (list x)) (== q x)))
|
|
(list 5))
|
|
|
|
;; --- ground value checks the domain ---
|
|
|
|
(mk-test
|
|
"fd-in-ground-in-domain"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(== x 3)
|
|
(fd-in x (list 1 2 3 4 5))
|
|
(== q x)))
|
|
(list 3))
|
|
|
|
(mk-test
|
|
"fd-in-ground-not-in-domain"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(== x 9)
|
|
(fd-in x (list 1 2 3 4 5))
|
|
(== q x)))
|
|
(list))
|
|
|
|
;; --- fd-label across multiple vars ---
|
|
|
|
(mk-test
|
|
"fd-label-multiple-vars"
|
|
(let
|
|
((res (run* q (fresh (a b) (fd-in a (list 1 2 3)) (fd-in b (list 10 20)) (fd-label (list a b)) (== q (list a b))))))
|
|
(= (len res) 6))
|
|
true)
|
|
|
|
(mk-test
|
|
"fd-label-empty-vars"
|
|
(run* q (fd-label (list)))
|
|
(list (make-symbol "_.0")))
|
|
|
|
;; --- composition with regular goals ---
|
|
|
|
(mk-test
|
|
"fd-in-with-membero-style-filtering"
|
|
(run*
|
|
q
|
|
(fresh
|
|
(x)
|
|
(fd-in
|
|
x
|
|
(list
|
|
1
|
|
2
|
|
3
|
|
4
|
|
5
|
|
6
|
|
7
|
|
8
|
|
9
|
|
10))
|
|
(fd-label (list x))
|
|
(== q x)))
|
|
(list
|
|
1
|
|
2
|
|
3
|
|
4
|
|
5
|
|
6
|
|
7
|
|
8
|
|
9
|
|
10))
|
|
|
|
(mk-tests-run!)
|