mk: phase 6B — clpfd.sx domain primitives
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:
2026-05-08 14:06:19 +00:00
parent 25f709549e
commit c71da0e1cf
2 changed files with 258 additions and 0 deletions

View 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!)