mk: phase 6B — clpfd.sx domain primitives
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Foundation for native CLP(FD). The substitution dict carries a reserved
"_fd" key holding a constraint store:
{:domains {var-name -> sorted-int-list}
:constraints (... pending constraints ...)}
This commit ships only the domain machinery + accessors:
fd-dom-from-list / fd-dom-range / fd-dom-empty? / fd-dom-singleton?
fd-dom-min / fd-dom-max / fd-dom-member? / fd-dom-intersect /
fd-dom-without
fd-store-of / fd-domain-of / fd-set-domain / fd-with-store
fd-set-domain returns nil when the domain becomes empty (failure),
which is the wire signal subsequent constraint goals will consume.
The constraints field is reserved for the next iteration.
26 new tests, 577/577 cumulative.
This commit is contained in:
133
lib/minikanren/tests/clpfd-domains.sx
Normal file
133
lib/minikanren/tests/clpfd-domains.sx
Normal file
@@ -0,0 +1,133 @@
|
||||
;; lib/minikanren/tests/clpfd-domains.sx — Phase 6 piece B: domain primitives.
|
||||
|
||||
;; --- domain construction ---
|
||||
|
||||
(mk-test
|
||||
"fd-dom-from-list-sorts"
|
||||
(fd-dom-from-list
|
||||
(list 3 1 2 1 5))
|
||||
(list 1 2 3 5))
|
||||
|
||||
(mk-test "fd-dom-from-list-empty" (fd-dom-from-list (list)) (list))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-from-list-single"
|
||||
(fd-dom-from-list (list 7))
|
||||
(list 7))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-range-1-5"
|
||||
(fd-dom-range 1 5)
|
||||
(list 1 2 3 4 5))
|
||||
|
||||
(mk-test "fd-dom-range-empty" (fd-dom-range 5 1) (list))
|
||||
|
||||
;; --- predicates ---
|
||||
|
||||
(mk-test "fd-dom-empty-yes" (fd-dom-empty? (list)) true)
|
||||
(mk-test "fd-dom-empty-no" (fd-dom-empty? (list 1)) false)
|
||||
(mk-test "fd-dom-singleton-yes" (fd-dom-singleton? (list 5)) true)
|
||||
(mk-test
|
||||
"fd-dom-singleton-multi"
|
||||
(fd-dom-singleton? (list 1 2))
|
||||
false)
|
||||
(mk-test "fd-dom-singleton-empty" (fd-dom-singleton? (list)) false)
|
||||
|
||||
(mk-test
|
||||
"fd-dom-min"
|
||||
(fd-dom-min (list 3 7 9))
|
||||
3)
|
||||
(mk-test
|
||||
"fd-dom-max"
|
||||
(fd-dom-max (list 3 7 9))
|
||||
9)
|
||||
|
||||
(mk-test
|
||||
"fd-dom-member-yes"
|
||||
(fd-dom-member?
|
||||
3
|
||||
(list 1 2 3 4))
|
||||
true)
|
||||
(mk-test
|
||||
"fd-dom-member-no"
|
||||
(fd-dom-member?
|
||||
9
|
||||
(list 1 2 3 4))
|
||||
false)
|
||||
|
||||
;; --- intersect / without ---
|
||||
|
||||
(mk-test
|
||||
"fd-dom-intersect"
|
||||
(fd-dom-intersect
|
||||
(list 1 2 3 4 5)
|
||||
(list 2 4 6))
|
||||
(list 2 4))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-intersect-disjoint"
|
||||
(fd-dom-intersect
|
||||
(list 1 2 3)
|
||||
(list 4 5 6))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-intersect-empty"
|
||||
(fd-dom-intersect (list) (list 1 2 3))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-intersect-equal"
|
||||
(fd-dom-intersect
|
||||
(list 1 2 3)
|
||||
(list 1 2 3))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-without-mid"
|
||||
(fd-dom-without
|
||||
3
|
||||
(list 1 2 3 4 5))
|
||||
(list 1 2 4 5))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-without-missing"
|
||||
(fd-dom-without 9 (list 1 2 3))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"fd-dom-without-min"
|
||||
(fd-dom-without 1 (list 1 2 3))
|
||||
(list 2 3))
|
||||
|
||||
;; --- store accessors ---
|
||||
|
||||
(mk-test "fd-domain-of-unset" (fd-domain-of {} "x") nil)
|
||||
|
||||
(mk-test
|
||||
"fd-domain-of-set"
|
||||
(let
|
||||
((s (fd-set-domain {} "x" (list 1 2 3))))
|
||||
(fd-domain-of s "x"))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"fd-set-domain-empty-fails"
|
||||
(fd-set-domain {} "x" (list))
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"fd-set-domain-overrides"
|
||||
(let
|
||||
((s (fd-set-domain {} "x" (list 1 2 3))))
|
||||
(fd-domain-of (fd-set-domain s "x" (list 5)) "x"))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"fd-set-domain-multiple-vars"
|
||||
(let
|
||||
((s (fd-set-domain (fd-set-domain {} "x" (list 1)) "y" (list 2 3))))
|
||||
(list (fd-domain-of s "x") (fd-domain-of s "y")))
|
||||
(list (list 1) (list 2 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
Reference in New Issue
Block a user