Merge loops/minikanren into architecture: full miniKanren-on-SX library
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Squash merge of 76 commits from loops/minikanren. Adds lib/minikanren/ — a complete miniKanren-on-SX implementation built on top of lib/guest/match.sx, validating the lib-guest unify-and-match kit as intended. Modules (20 .sx files, ~1700 LOC): unify, stream, goals, fresh, conde, condu, conda, run, relations, peano, intarith, project, nafc, matche, fd, queens, defrel, clpfd, tabling Phases 1–5 fully done (core miniKanren API, all classic relations, matche, conda, project, nafc). Phase 6 — native CLP(FD): domain primitives, fd-in / fd-eq / fd-neq / fd-lt / fd-lte / fd-plus / fd-times / fd-distinct / fd-label, with constraint reactivation iterating to fixed point. N-queens via FD: 4-queens 2 solutions, 5-queens 10 solutions (vs naive timeout past N=4). Phase 7 — naive ground-arg tabling: table-1 / table-2 / table-3. Fibonacci canary: tab-fib(25) = 75025 in seconds, naive fib(25) times out at 60s. Ackermann via table-3: A(3,3) = 61. 71 test files, 644+ tests passing across the suite. Producer/consumer SLG (cyclic patho, mutual recursion) deferred — research-grade work. The lib-guest validation experiment is conclusive: lib/minikanren/ unify.sx adds ~50 lines of local logic (custom cfg, deep walk*, fresh counter) over lib/guest/match.sx's ~100-line kit. The kit earns its keep ~3× by line count.
This commit is contained in:
49
lib/minikanren/tests/appendo3.sx
Normal file
49
lib/minikanren/tests/appendo3.sx
Normal file
@@ -0,0 +1,49 @@
|
||||
;; lib/minikanren/tests/appendo3.sx — 3-list append.
|
||||
|
||||
(mk-test
|
||||
"appendo3-forward"
|
||||
(run*
|
||||
q
|
||||
(appendo3
|
||||
(list 1 2)
|
||||
(list 3 4)
|
||||
(list 5 6)
|
||||
q))
|
||||
(list
|
||||
(list 1 2 3 4 5 6)))
|
||||
|
||||
(mk-test
|
||||
"appendo3-empty-everything"
|
||||
(run* q (appendo3 (list) (list) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"appendo3-recover-middle"
|
||||
(run*
|
||||
q
|
||||
(appendo3
|
||||
(list 1 2)
|
||||
q
|
||||
(list 5 6)
|
||||
(list 1 2 3 4 5 6)))
|
||||
(list (list 3 4)))
|
||||
|
||||
(mk-test
|
||||
"appendo3-empty-middle"
|
||||
(run*
|
||||
q
|
||||
(appendo3
|
||||
(list 1 2)
|
||||
(list)
|
||||
(list 3 4)
|
||||
q))
|
||||
(list (list 1 2 3 4)))
|
||||
|
||||
(mk-test
|
||||
"appendo3-empty-first-and-last"
|
||||
(run*
|
||||
q
|
||||
(appendo3 (list) (list 1 2 3) (list) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
33
lib/minikanren/tests/arith-prog.sx
Normal file
33
lib/minikanren/tests/arith-prog.sx
Normal file
@@ -0,0 +1,33 @@
|
||||
;; lib/minikanren/tests/arith-prog.sx — arithmetic progression generation.
|
||||
|
||||
(mk-test
|
||||
"arith-progo-zero-len"
|
||||
(run* q (arith-progo 5 1 0 q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"arith-progo-1-to-5"
|
||||
(run* q (arith-progo 1 1 5 q))
|
||||
(list (list 1 2 3 4 5)))
|
||||
|
||||
(mk-test
|
||||
"arith-progo-evens-from-0"
|
||||
(run* q (arith-progo 0 2 5 q))
|
||||
(list (list 0 2 4 6 8)))
|
||||
|
||||
(mk-test
|
||||
"arith-progo-descending"
|
||||
(run* q (arith-progo 10 -1 4 q))
|
||||
(list (list 10 9 8 7)))
|
||||
|
||||
(mk-test
|
||||
"arith-progo-zero-step"
|
||||
(run* q (arith-progo 7 0 3 q))
|
||||
(list (list 7 7 7)))
|
||||
|
||||
(mk-test
|
||||
"arith-progo-negative-start"
|
||||
(run* q (arith-progo -3 2 4 q))
|
||||
(list (list -3 -1 1 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
54
lib/minikanren/tests/btree-walko.sx
Normal file
54
lib/minikanren/tests/btree-walko.sx
Normal file
@@ -0,0 +1,54 @@
|
||||
;; lib/minikanren/tests/btree-walko.sx — walk a leaves-of-binary-tree relation
|
||||
;; using matche dispatch on (:leaf v) and (:node left right) patterns.
|
||||
|
||||
(define
|
||||
btree-walko
|
||||
(fn
|
||||
(tree v)
|
||||
(matche
|
||||
tree
|
||||
((:leaf x) (== v x))
|
||||
((:node l r) (conde ((btree-walko l v)) ((btree-walko r v)))))))
|
||||
|
||||
;; A small test tree: ((1 2) (3 (4 5))).
|
||||
(define
|
||||
test-btree
|
||||
(list
|
||||
:node (list :node (list :leaf 1) (list :leaf 2))
|
||||
(list
|
||||
:node (list :leaf 3)
|
||||
(list :node (list :leaf 4) (list :leaf 5)))))
|
||||
|
||||
(mk-test
|
||||
"btree-walko-enumerates-all-leaves"
|
||||
(let
|
||||
((leaves (run* q (btree-walko test-btree q))))
|
||||
(and
|
||||
(= (len leaves) 5)
|
||||
(and
|
||||
(some (fn (l) (= l 1)) leaves)
|
||||
(and
|
||||
(some (fn (l) (= l 2)) leaves)
|
||||
(and
|
||||
(some (fn (l) (= l 3)) leaves)
|
||||
(and
|
||||
(some (fn (l) (= l 4)) leaves)
|
||||
(some (fn (l) (= l 5)) leaves)))))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"btree-walko-find-3-membership"
|
||||
(run 1 q (btree-walko test-btree 3))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"btree-walko-find-99-not-present"
|
||||
(run* q (btree-walko test-btree 99))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"btree-walko-leaf-only"
|
||||
(run* q (btree-walko (list :leaf 42) q))
|
||||
(list 42))
|
||||
|
||||
(mk-tests-run!)
|
||||
87
lib/minikanren/tests/classics.sx
Normal file
87
lib/minikanren/tests/classics.sx
Normal file
@@ -0,0 +1,87 @@
|
||||
;; lib/minikanren/tests/classics.sx — small classic-style puzzles that
|
||||
;; exercise the full system end to end (relations + conde + matche +
|
||||
;; fresh + run*). Each test is a self-contained miniKanren program.
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Pet puzzle (3 friends, 3 pets, 1-each).
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(mk-test
|
||||
"classics-pet-puzzle"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(a b c)
|
||||
(== q (list a b c))
|
||||
(permuteo (list :dog :cat :fish) (list a b c))
|
||||
(== b :fish)
|
||||
(conde ((== a :cat)) ((== a :fish)))))
|
||||
(list (list :cat :fish :dog)))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Family-relations puzzle (uses membero on a fact list).
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
parent-facts
|
||||
(list
|
||||
(list "alice" "bob")
|
||||
(list "alice" "carol")
|
||||
(list "bob" "dave")
|
||||
(list "carol" "eve")
|
||||
(list "dave" "frank")))
|
||||
|
||||
(define parento (fn (x y) (membero (list x y) parent-facts)))
|
||||
|
||||
(define grandparento (fn (x z) (fresh (y) (parento x y) (parento y z))))
|
||||
|
||||
(mk-test
|
||||
"classics-grandparents-of-frank"
|
||||
(run* q (grandparento q "frank"))
|
||||
(list "bob"))
|
||||
|
||||
(mk-test
|
||||
"classics-grandchildren-of-alice"
|
||||
(run* q (grandparento "alice" q))
|
||||
(list "dave" "eve"))
|
||||
|
||||
;; -----------------------------------------------------------------------
|
||||
;; Symbolic differentiation, matche-driven.
|
||||
;; Variable :x: d/dx x = 1
|
||||
;; Sum (:+ a b): d/dx (a+b) = (da + db)
|
||||
;; Product (:* a b): d/dx (a*b) = (da*b + a*db)
|
||||
;; -----------------------------------------------------------------------
|
||||
|
||||
(define
|
||||
diffo
|
||||
(fn
|
||||
(expr var d)
|
||||
(matche
|
||||
expr
|
||||
(:x (== d 1))
|
||||
((:+ a b)
|
||||
(fresh
|
||||
(da db)
|
||||
(== d (list :+ da db))
|
||||
(diffo a var da)
|
||||
(diffo b var db)))
|
||||
((:* a b)
|
||||
(fresh
|
||||
(da db)
|
||||
(== d (list :+ (list :* da b) (list :* a db)))
|
||||
(diffo a var da)
|
||||
(diffo b var db))))))
|
||||
|
||||
(mk-test "classics-diff-of-x" (run* q (diffo :x :x q)) (list 1))
|
||||
|
||||
(mk-test
|
||||
"classics-diff-of-x-plus-x"
|
||||
(run* q (diffo (list :+ :x :x) :x q))
|
||||
(list (list :+ 1 1)))
|
||||
|
||||
(mk-test
|
||||
"classics-diff-of-x-times-x"
|
||||
(run* q (diffo (list :* :x :x) :x q))
|
||||
(list (list :+ (list :* 1 :x) (list :* :x 1))))
|
||||
|
||||
(mk-tests-run!)
|
||||
52
lib/minikanren/tests/clpfd-distinct.sx
Normal file
52
lib/minikanren/tests/clpfd-distinct.sx
Normal file
@@ -0,0 +1,52 @@
|
||||
;; lib/minikanren/tests/clpfd-distinct.sx — fd-distinct (alldifferent).
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-empty"
|
||||
(run* q (fd-distinct (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-singleton"
|
||||
(run* q (fd-distinct (list 5)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-pair-distinct"
|
||||
(run* q (fd-distinct (list 1 2)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-pair-equal-fails"
|
||||
(run* q (fd-distinct (list 5 5)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-3-perms-of-3"
|
||||
(let
|
||||
((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-distinct (list a b c)) (fd-label (list a b c)) (== q (list a b c))))))
|
||||
(= (len res) 6))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-4-perms-of-4-count"
|
||||
(let
|
||||
((res (run* q (fresh (a b c d) (fd-in a (list 1 2 3 4)) (fd-in b (list 1 2 3 4)) (fd-in c (list 1 2 3 4)) (fd-in d (list 1 2 3 4)) (fd-distinct (list a b c d)) (fd-label (list a b c d)) (== q (list a b c d))))))
|
||||
(= (len res) 24))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"fd-distinct-pigeonhole-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(a b c d)
|
||||
(fd-in a (list 1 2 3))
|
||||
(fd-in b (list 1 2 3))
|
||||
(fd-in c (list 1 2 3))
|
||||
(fd-in d (list 1 2 3))
|
||||
(fd-distinct (list a b c d))
|
||||
(fd-label (list a b c d))
|
||||
(== q (list a b c d))))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
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!)
|
||||
120
lib/minikanren/tests/clpfd-in-label.sx
Normal file
120
lib/minikanren/tests/clpfd-in-label.sx
Normal file
@@ -0,0 +1,120 @@
|
||||
;; 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!)
|
||||
82
lib/minikanren/tests/clpfd-neq.sx
Normal file
82
lib/minikanren/tests/clpfd-neq.sx
Normal file
@@ -0,0 +1,82 @@
|
||||
;; lib/minikanren/tests/clpfd-neq.sx — fd-neq with constraint propagation.
|
||||
|
||||
;; --- ground / domain interaction ---
|
||||
|
||||
(mk-test
|
||||
"fd-neq-ground-distinct"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-neq x 5)
|
||||
(fd-in x (list 4 5 6))
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 4 6))
|
||||
|
||||
(mk-test
|
||||
"fd-neq-ground-equal-fails"
|
||||
(run* q (fresh (x) (== x 5) (fd-neq x 5) (== q x)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-neq-symmetric"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-neq 7 x)
|
||||
(fd-in x (list 5 6 7 8 9))
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 5 6 8 9))
|
||||
|
||||
;; --- two vars with overlapping domains ---
|
||||
|
||||
(mk-test
|
||||
"fd-neq-pair-from-3"
|
||||
(let
|
||||
((res (run* q (fresh (x y) (fd-in x (list 1 2 3)) (fd-in y (list 1 2 3)) (fd-neq x y) (fd-label (list x y)) (== q (list x y))))))
|
||||
(= (len res) 6))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"fd-all-distinct-3-of-3"
|
||||
(let
|
||||
((res (run* q (fresh (a b c) (fd-in a (list 1 2 3)) (fd-in b (list 1 2 3)) (fd-in c (list 1 2 3)) (fd-neq a b) (fd-neq a c) (fd-neq b c) (fd-label (list a b c)) (== q (list a b c))))))
|
||||
(= (len res) 6))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"fd-pigeonhole-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(a b c)
|
||||
(fd-in a (list 1 2))
|
||||
(fd-in b (list 1 2))
|
||||
(fd-in c (list 1 2))
|
||||
(fd-neq a b)
|
||||
(fd-neq a c)
|
||||
(fd-neq b c)
|
||||
(fd-label (list a b c))
|
||||
(== q (list a b c))))
|
||||
(list))
|
||||
|
||||
;; --- propagation when one side becomes ground ---
|
||||
|
||||
(mk-test
|
||||
"fd-neq-propagates-after-ground"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y)
|
||||
(fd-in x (list 1 2 3))
|
||||
(fd-in y (list 1 2 3))
|
||||
(fd-neq x y)
|
||||
(== x 2)
|
||||
(fd-label (list y))
|
||||
(== q y)))
|
||||
(list 1 3))
|
||||
|
||||
(mk-tests-run!)
|
||||
128
lib/minikanren/tests/clpfd-ord.sx
Normal file
128
lib/minikanren/tests/clpfd-ord.sx
Normal file
@@ -0,0 +1,128 @@
|
||||
;; lib/minikanren/tests/clpfd-ord.sx — fd-lt / fd-lte / fd-eq.
|
||||
|
||||
;; --- fd-lt ---
|
||||
|
||||
(mk-test
|
||||
"fd-lt-narrows-x-against-num"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-lt x 3)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"fd-lt-narrows-x-against-num-symmetric"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-lt 3 x)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 4 5))
|
||||
|
||||
(mk-test
|
||||
"fd-lt-pair-ordered"
|
||||
(let
|
||||
((res (run* q (fresh (x y) (fd-in x (list 1 2 3 4)) (fd-in y (list 1 2 3 4)) (fd-lt x y) (fd-label (list x y)) (== q (list x y))))))
|
||||
(= (len res) 6))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"fd-lt-impossible-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 5 6 7))
|
||||
(fd-lt x 3)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list))
|
||||
|
||||
;; --- fd-lte ---
|
||||
|
||||
(mk-test
|
||||
"fd-lte-includes-equal"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-lte x 3)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"fd-lte-equal-bound"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-lte 3 x)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 3 4 5))
|
||||
|
||||
;; --- fd-eq ---
|
||||
|
||||
(mk-test
|
||||
"fd-eq-bind"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-eq x 3)
|
||||
(== q x)))
|
||||
(list 3))
|
||||
|
||||
(mk-test
|
||||
"fd-eq-out-of-domain-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3))
|
||||
(fd-eq x 5)
|
||||
(== q x)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-eq-two-vars-share-domain"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y)
|
||||
(fd-in x (list 1 2 3))
|
||||
(fd-in y (list 2 3 4))
|
||||
(fd-eq x y)
|
||||
(fd-label (list x y))
|
||||
(== q (list x y))))
|
||||
(list (list 2 2) (list 3 3)))
|
||||
|
||||
;; --- combine fd-lt + fd-neq for "between" puzzle ---
|
||||
|
||||
(mk-test
|
||||
"fd-lt-neq-combined"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y z)
|
||||
(fd-in x (list 1 2 3))
|
||||
(fd-in y (list 1 2 3))
|
||||
(fd-in z (list 1 2 3))
|
||||
(fd-lt x y)
|
||||
(fd-lt y z)
|
||||
(fd-label (list x y z))
|
||||
(== q (list x y z))))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
62
lib/minikanren/tests/clpfd-plus.sx
Normal file
62
lib/minikanren/tests/clpfd-plus.sx
Normal file
@@ -0,0 +1,62 @@
|
||||
;; lib/minikanren/tests/clpfd-plus.sx — fd-plus (x + y = z).
|
||||
|
||||
(mk-test
|
||||
"fd-plus-all-ground"
|
||||
(run* q (fresh (z) (fd-plus 2 3 z) (== q z)))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-recover-x"
|
||||
(run* q (fresh (x) (fd-plus x 3 5) (== q x)))
|
||||
(list 2))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-recover-y"
|
||||
(run* q (fresh (y) (fd-plus 2 y 5) (== q y)))
|
||||
(list 3))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-impossible-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(z)
|
||||
(fd-plus 2 3 z)
|
||||
(== z 99)
|
||||
(== q z)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-domain-check"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 3 4 5))
|
||||
(fd-plus x 3 5)
|
||||
(== q x)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-pairs-summing-to-5"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y)
|
||||
(fd-in x (list 1 2 3 4))
|
||||
(fd-in y (list 1 2 3 4))
|
||||
(fd-plus x y 5)
|
||||
(fd-label (list x y))
|
||||
(== q (list x y))))
|
||||
(list
|
||||
(list 1 4)
|
||||
(list 2 3)
|
||||
(list 3 2)
|
||||
(list 4 1)))
|
||||
|
||||
(mk-test
|
||||
"fd-plus-z-derived"
|
||||
(run* q (fresh (z) (fd-plus 7 8 z) (== q z)))
|
||||
(list 15))
|
||||
|
||||
(mk-tests-run!)
|
||||
85
lib/minikanren/tests/clpfd-times.sx
Normal file
85
lib/minikanren/tests/clpfd-times.sx
Normal file
@@ -0,0 +1,85 @@
|
||||
;; lib/minikanren/tests/clpfd-times.sx — fd-times (x * y = z).
|
||||
|
||||
(mk-test
|
||||
"fd-times-3-4"
|
||||
(run* q (fresh (z) (fd-times 3 4 z) (== q z)))
|
||||
(list 12))
|
||||
|
||||
(mk-test
|
||||
"fd-times-recover-divisor"
|
||||
(run* q (fresh (x) (fd-times x 5 30) (== q x)))
|
||||
(list 6))
|
||||
|
||||
(mk-test
|
||||
"fd-times-non-divisible-fails"
|
||||
(run* q (fresh (x) (fd-times x 5 31) (== q x)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"fd-times-by-zero"
|
||||
(run* q (fresh (z) (fd-times 0 99 z) (== q z)))
|
||||
(list 0))
|
||||
|
||||
(mk-test
|
||||
"fd-times-zero-by-anything-zero"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(fd-in x (list 1 2 3))
|
||||
(fd-times x 0 0)
|
||||
(fd-label (list x))
|
||||
(== q x)))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"fd-times-12-divisor-pairs"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y)
|
||||
(fd-in
|
||||
x
|
||||
(list
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6))
|
||||
(fd-in
|
||||
y
|
||||
(list
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6))
|
||||
(fd-times x y 12)
|
||||
(fd-label (list x y))
|
||||
(== q (list x y))))
|
||||
(list
|
||||
(list 2 6)
|
||||
(list 3 4)
|
||||
(list 4 3)
|
||||
(list 6 2)))
|
||||
|
||||
(mk-test
|
||||
"fd-times-square-of-each"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x z)
|
||||
(fd-in x (list 1 2 3 4 5))
|
||||
(fd-times x x z)
|
||||
(fd-label (list x))
|
||||
(== q (list x z))))
|
||||
(list
|
||||
(list 1 1)
|
||||
(list 2 4)
|
||||
(list 3 9)
|
||||
(list 4 16)
|
||||
(list 5 25)))
|
||||
|
||||
(mk-tests-run!)
|
||||
75
lib/minikanren/tests/conda.sx
Normal file
75
lib/minikanren/tests/conda.sx
Normal file
@@ -0,0 +1,75 @@
|
||||
;; lib/minikanren/tests/conda.sx — Phase 5 piece A tests for `conda`.
|
||||
|
||||
;; --- conda commits to first non-failing head, keeps ALL its answers ---
|
||||
|
||||
(mk-test
|
||||
"conda-first-clause-keeps-all"
|
||||
(run*
|
||||
q
|
||||
(conda
|
||||
((mk-disj (== q 1) (== q 2)))
|
||||
((== q 100))))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"conda-skips-failing-head"
|
||||
(run*
|
||||
q
|
||||
(conda
|
||||
((== 1 2))
|
||||
((mk-disj (== q 10) (== q 20)))))
|
||||
(list 10 20))
|
||||
|
||||
(mk-test
|
||||
"conda-all-fail"
|
||||
(run*
|
||||
q
|
||||
(conda ((== 1 2)) ((== 3 4))))
|
||||
(list))
|
||||
|
||||
(mk-test "conda-no-clauses" (run* q (conda)) (list))
|
||||
|
||||
;; --- conda DIFFERS from condu: conda keeps all head answers ---
|
||||
|
||||
(mk-test
|
||||
"conda-vs-condu-divergence"
|
||||
(list
|
||||
(run*
|
||||
q
|
||||
(conda
|
||||
((mk-disj (== q 1) (== q 2)))
|
||||
((== q 100))))
|
||||
(run*
|
||||
q
|
||||
(condu
|
||||
((mk-disj (== q 1) (== q 2)))
|
||||
((== q 100)))))
|
||||
(list (list 1 2) (list 1)))
|
||||
|
||||
;; --- conda head's rest-goals run on every head answer ---
|
||||
|
||||
(mk-test
|
||||
"conda-rest-goals-run-on-all-answers"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x r)
|
||||
(conda
|
||||
((mk-disj (== x 1) (== x 2))
|
||||
(== r (list :tag x))))
|
||||
(== q r)))
|
||||
(list (list :tag 1) (list :tag 2)))
|
||||
|
||||
;; --- if rest-goals fail on a head answer, that head answer is filtered;
|
||||
;; the clause does not fall through to next clauses (per soft-cut). ---
|
||||
|
||||
(mk-test
|
||||
"conda-rest-fails-no-fallthrough"
|
||||
(run*
|
||||
q
|
||||
(conda
|
||||
((mk-disj (== q 1) (== q 2)) (== q 99))
|
||||
((== q 200))))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
89
lib/minikanren/tests/conde.sx
Normal file
89
lib/minikanren/tests/conde.sx
Normal file
@@ -0,0 +1,89 @@
|
||||
;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`.
|
||||
;;
|
||||
;; Note on ordering: conde clauses are wrapped in Zzz (inverse-eta delay),
|
||||
;; so applying the conde goal to a substitution returns thunks. mk-mplus
|
||||
;; suspends-and-swaps when its left operand is paused, giving fair
|
||||
;; interleaving — this is exactly what makes recursive relations work,
|
||||
;; but it does mean conde answers can interleave rather than appear in
|
||||
;; strict left-to-right clause order.
|
||||
|
||||
;; --- single-clause conde ≡ conj of clause body ---
|
||||
|
||||
(mk-test
|
||||
"conde-one-clause"
|
||||
(let ((q (mk-var "q"))) (run* q (conde ((== q 7)))))
|
||||
(list 7))
|
||||
|
||||
(mk-test
|
||||
"conde-one-clause-multi-goals"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(run* q (conde ((fresh (x) (== x 5) (== q (list x x)))))))
|
||||
(list (list 5 5)))
|
||||
|
||||
;; --- multi-clause: produces one row per clause (interleaved) ---
|
||||
|
||||
(mk-test
|
||||
"conde-three-clauses-as-set"
|
||||
(let
|
||||
((qs (run* q (conde ((== q 1)) ((== q 2)) ((== q 3))))))
|
||||
(and
|
||||
(= (len qs) 3)
|
||||
(and
|
||||
(some (fn (x) (= x 1)) qs)
|
||||
(and
|
||||
(some (fn (x) (= x 2)) qs)
|
||||
(some (fn (x) (= x 3)) qs)))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"conde-mixed-success-failure-as-set"
|
||||
(let
|
||||
((qs (run* q (conde ((== q "a")) ((== 1 2)) ((== q "b"))))))
|
||||
(and
|
||||
(= (len qs) 2)
|
||||
(and (some (fn (x) (= x "a")) qs) (some (fn (x) (= x "b")) qs))))
|
||||
true)
|
||||
|
||||
;; --- conde with conjuncts inside clauses ---
|
||||
|
||||
(mk-test
|
||||
"conde-clause-conj-as-set"
|
||||
(let
|
||||
((rows (run* q (fresh (x y) (conde ((== x 1) (== y 10)) ((== x 2) (== y 20))) (== q (list x y))))))
|
||||
(and
|
||||
(= (len rows) 2)
|
||||
(and
|
||||
(some (fn (r) (= r (list 1 10))) rows)
|
||||
(some (fn (r) (= r (list 2 20))) rows))))
|
||||
true)
|
||||
|
||||
;; --- nested conde ---
|
||||
|
||||
(mk-test
|
||||
"conde-nested-yields-three"
|
||||
(let
|
||||
((qs (run* q (conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))))))
|
||||
(and
|
||||
(= (len qs) 3)
|
||||
(and
|
||||
(some (fn (x) (= x 1)) qs)
|
||||
(and
|
||||
(some (fn (x) (= x 2)) qs)
|
||||
(some (fn (x) (= x 3)) qs)))))
|
||||
true)
|
||||
|
||||
;; --- conde all clauses fail → empty stream ---
|
||||
|
||||
(mk-test
|
||||
"conde-all-fail"
|
||||
(run*
|
||||
q
|
||||
(conde ((== 1 2)) ((== 3 4))))
|
||||
(list))
|
||||
|
||||
;; --- empty conde: no clauses ⇒ fail ---
|
||||
|
||||
(mk-test "conde-no-clauses" (run* q (conde)) (list))
|
||||
|
||||
(mk-tests-run!)
|
||||
86
lib/minikanren/tests/condu.sx
Normal file
86
lib/minikanren/tests/condu.sx
Normal file
@@ -0,0 +1,86 @@
|
||||
;; lib/minikanren/tests/condu.sx — Phase 2 piece D tests for `onceo` and `condu`.
|
||||
|
||||
;; --- onceo: at most one answer ---
|
||||
|
||||
(mk-test
|
||||
"onceo-single-success-passes-through"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((onceo (== q 7)) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 7))
|
||||
|
||||
(mk-test
|
||||
"onceo-multi-success-trimmed-to-one"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((onceo (mk-disj (== q 1) (== q 2) (== q 3))) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"onceo-failure-stays-failure"
|
||||
((onceo (== 1 2)) empty-s)
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"onceo-conde-trimmed"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((onceo (conde ((== q "a")) ((== q "b")))) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list "a"))
|
||||
|
||||
;; --- condu: first clause with successful head wins ---
|
||||
|
||||
(mk-test
|
||||
"condu-first-clause-wins"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 10 ((condu ((== q 1)) ((== q 2))) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"condu-skips-failing-head"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 10 ((condu ((== 1 2)) ((== q 100)) ((== q 200))) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 100))
|
||||
|
||||
(mk-test
|
||||
"condu-all-fail-empty"
|
||||
((condu ((== 1 2)) ((== 3 4)))
|
||||
empty-s)
|
||||
(list))
|
||||
|
||||
(mk-test "condu-empty-clauses-fail" ((condu) empty-s) (list))
|
||||
|
||||
;; --- condu commits head's first answer; rest-goals can still backtrack
|
||||
;; within that committed substitution but cannot revisit other heads. ---
|
||||
|
||||
(mk-test
|
||||
"condu-head-onceo-rest-runs"
|
||||
(let
|
||||
((q (mk-var "q")) (r (mk-var "r")))
|
||||
(let
|
||||
((res (stream-take 10 ((condu ((mk-disj (== q 1) (== q 2)) (== r 99))) empty-s))))
|
||||
(map (fn (s) (list (mk-walk q s) (mk-walk r s))) res)))
|
||||
(list (list 1 99)))
|
||||
|
||||
(mk-test
|
||||
"condu-rest-goals-can-fail-the-clause"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 10 ((condu ((== q 1) (== 2 3)) ((== q 99))) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
35
lib/minikanren/tests/counto.sx
Normal file
35
lib/minikanren/tests/counto.sx
Normal file
@@ -0,0 +1,35 @@
|
||||
;; lib/minikanren/tests/counto.sx — count occurrences of x in l (intarith).
|
||||
|
||||
(mk-test
|
||||
"counto-empty"
|
||||
(run* q (counto 1 (list) q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"counto-not-found"
|
||||
(run* q (counto 99 (list 1 2 3) q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"counto-once"
|
||||
(run* q (counto 2 (list 1 2 3) q))
|
||||
(list 1))
|
||||
(mk-test
|
||||
"counto-thrice"
|
||||
(run*
|
||||
q
|
||||
(counto
|
||||
1
|
||||
(list 1 2 1 3 1)
|
||||
q))
|
||||
(list 3))
|
||||
(mk-test
|
||||
"counto-all-same"
|
||||
(run*
|
||||
q
|
||||
(counto 7 (list 7 7 7 7) q))
|
||||
(list 4))
|
||||
(mk-test
|
||||
"counto-string"
|
||||
(run* q (counto "x" (list "x" "y" "x") q))
|
||||
(list 2))
|
||||
|
||||
(mk-tests-run!)
|
||||
48
lib/minikanren/tests/cyclic-graph.sx
Normal file
48
lib/minikanren/tests/cyclic-graph.sx
Normal file
@@ -0,0 +1,48 @@
|
||||
;; lib/minikanren/tests/cyclic-graph.sx — demonstrates the naive-patho
|
||||
;; behaviour on a cyclic graph. Without Phase-7 tabling/SLG, the search
|
||||
;; produces ever-longer paths revisiting the cycle. `run n` truncates;
|
||||
;; `run*` would diverge.
|
||||
|
||||
(define cyclic-edges (list (list :a :b) (list :b :a) (list :b :c)))
|
||||
|
||||
(define cyclic-edgeo (fn (x y) (membero (list x y) cyclic-edges)))
|
||||
|
||||
(define
|
||||
cyclic-patho
|
||||
(fn
|
||||
(x y path)
|
||||
(conde
|
||||
((cyclic-edgeo x y) (== path (list x y)))
|
||||
((fresh (z mid) (cyclic-edgeo x z) (cyclic-patho z y mid) (conso x mid path))))))
|
||||
|
||||
;; --- direct edge ---
|
||||
|
||||
(mk-test
|
||||
"cyclic-direct"
|
||||
(run 1 q (cyclic-patho :a :b q))
|
||||
(list (list :a :b)))
|
||||
|
||||
;; --- runs first 5 paths from a to b: bare edge, then increasing
|
||||
;; numbers of cycle traversals (a->b->a->b, etc.) ---
|
||||
|
||||
(mk-test
|
||||
"cyclic-enumerates-prefix-via-run-n"
|
||||
(let
|
||||
((paths (run 5 q (cyclic-patho :a :b q))))
|
||||
(and
|
||||
(= (len paths) 5)
|
||||
(and
|
||||
(every? (fn (p) (= (first p) :a)) paths)
|
||||
(every? (fn (p) (= (last p) :b)) paths))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"cyclic-finds-c-via-cycle-or-direct"
|
||||
(let
|
||||
((paths (run 3 q (cyclic-patho :a :c q))))
|
||||
(and
|
||||
(>= (len paths) 1)
|
||||
(some (fn (p) (= p (list :a :b :c))) paths)))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
40
lib/minikanren/tests/defrel.sx
Normal file
40
lib/minikanren/tests/defrel.sx
Normal file
@@ -0,0 +1,40 @@
|
||||
;; lib/minikanren/tests/defrel.sx — Prolog-style relation definition macro.
|
||||
|
||||
(defrel
|
||||
(my-membero x l)
|
||||
((fresh (d) (conso x d l)))
|
||||
((fresh (a d) (conso a d l) (my-membero x d))))
|
||||
|
||||
(mk-test
|
||||
"defrel-defines-membero"
|
||||
(run* q (my-membero q (list 1 2 3)))
|
||||
(list 1 2 3))
|
||||
|
||||
(defrel
|
||||
(my-listo l)
|
||||
((nullo l))
|
||||
((fresh (a d) (conso a d l) (my-listo d))))
|
||||
|
||||
(mk-test
|
||||
"defrel-listo-bounded"
|
||||
(run 3 q (my-listo q))
|
||||
(list
|
||||
(list)
|
||||
(list (make-symbol "_.0"))
|
||||
(list (make-symbol "_.0") (make-symbol "_.1"))))
|
||||
|
||||
;; Multi-arg relation with arithmetic.
|
||||
|
||||
(defrel
|
||||
(my-pluso a b c)
|
||||
((== a :z) (== b c))
|
||||
((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (my-pluso a-1 b c-1))))
|
||||
|
||||
(mk-test
|
||||
"defrel-pluso-2-3"
|
||||
(run*
|
||||
q
|
||||
(my-pluso (list :s (list :s :z)) (list :s (list :s (list :s :z))) q))
|
||||
(list (list :s (list :s (list :s (list :s (list :s :z)))))))
|
||||
|
||||
(mk-tests-run!)
|
||||
31
lib/minikanren/tests/enumerate.sx
Normal file
31
lib/minikanren/tests/enumerate.sx
Normal file
@@ -0,0 +1,31 @@
|
||||
;; lib/minikanren/tests/enumerate.sx — index-each-element relation.
|
||||
|
||||
(mk-test
|
||||
"enumerate-i-empty"
|
||||
(run* q (enumerate-i (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"enumerate-i-three"
|
||||
(run* q (enumerate-i (list :a :b :c) q))
|
||||
(list
|
||||
(list (list 0 :a) (list 1 :b) (list 2 :c))))
|
||||
|
||||
(mk-test
|
||||
"enumerate-i-strings"
|
||||
(run* q (enumerate-i (list "x" "y" "z") q))
|
||||
(list
|
||||
(list (list 0 "x") (list 1 "y") (list 2 "z"))))
|
||||
|
||||
(mk-test
|
||||
"enumerate-from-i-100"
|
||||
(run* q (enumerate-from-i 100 (list :x :y :z) q))
|
||||
(list
|
||||
(list (list 100 :x) (list 101 :y) (list 102 :z))))
|
||||
|
||||
(mk-test
|
||||
"enumerate-from-i-singleton"
|
||||
(run* q (enumerate-from-i 0 (list :only) q))
|
||||
(list (list (list 0 :only))))
|
||||
|
||||
(mk-tests-run!)
|
||||
75
lib/minikanren/tests/fd.sx
Normal file
75
lib/minikanren/tests/fd.sx
Normal file
@@ -0,0 +1,75 @@
|
||||
;; lib/minikanren/tests/fd.sx — Phase 6 piece A: ino + all-distincto.
|
||||
|
||||
;; --- ino ---
|
||||
|
||||
(mk-test
|
||||
"ino-element-in-domain"
|
||||
(run* q (ino q (list 1 2 3)))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test "ino-empty-domain" (run* q (ino q (list))) (list))
|
||||
|
||||
(mk-test
|
||||
"ino-singleton-domain"
|
||||
(run* q (ino q (list 42)))
|
||||
(list 42))
|
||||
|
||||
;; --- all-distincto ---
|
||||
|
||||
(mk-test
|
||||
"all-distincto-empty"
|
||||
(run* q (all-distincto (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"all-distincto-singleton"
|
||||
(run* q (all-distincto (list 1)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"all-distincto-distinct-three"
|
||||
(run* q (all-distincto (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"all-distincto-duplicate-fails"
|
||||
(run* q (all-distincto (list 1 2 1)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"all-distincto-adjacent-duplicate-fails"
|
||||
(run* q (all-distincto (list 1 1 2)))
|
||||
(list))
|
||||
|
||||
;; --- ino + all-distincto: classic enumerate-all-permutations ---
|
||||
|
||||
(mk-test
|
||||
"fd-puzzle-three-distinct-from-domain"
|
||||
(let
|
||||
((perms (run* q (fresh (a b c) (== q (list a b c)) (ino a (list 1 2 3)) (ino b (list 1 2 3)) (ino c (list 1 2 3)) (all-distincto (list a b c))))))
|
||||
(and
|
||||
(= (len perms) 6)
|
||||
(and
|
||||
(some (fn (p) (= p (list 1 2 3))) perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 1 3 2)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 2 1 3)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 2 3 1)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 3 1 2)))
|
||||
perms)
|
||||
(some
|
||||
(fn (p) (= p (list 3 2 1)))
|
||||
perms))))))))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
39
lib/minikanren/tests/flat-mapo.sx
Normal file
39
lib/minikanren/tests/flat-mapo.sx
Normal file
@@ -0,0 +1,39 @@
|
||||
;; lib/minikanren/tests/flat-mapo.sx — concatMap-style relation.
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-empty"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list x x))) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-duplicate-each"
|
||||
(run*
|
||||
q
|
||||
(flat-mapo
|
||||
(fn (x r) (== r (list x x)))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list
|
||||
(list 1 1 2 2 3 3)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-empty-from-each"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list))) (list :a :b :c) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-singleton-from-each-is-identity"
|
||||
(run* q (flat-mapo (fn (x r) (== r (list x))) (list :a :b :c) q))
|
||||
(list (list :a :b :c)))
|
||||
|
||||
(mk-test
|
||||
"flat-mapo-tag-each"
|
||||
(run*
|
||||
q
|
||||
(flat-mapo
|
||||
(fn (x r) (== r (list :tag x)))
|
||||
(list 1 2)
|
||||
q))
|
||||
(list (list :tag 1 :tag 2)))
|
||||
|
||||
(mk-tests-run!)
|
||||
42
lib/minikanren/tests/flatteno.sx
Normal file
42
lib/minikanren/tests/flatteno.sx
Normal file
@@ -0,0 +1,42 @@
|
||||
(mk-test "flatteno-empty" (run* q (flatteno (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-atom"
|
||||
(run* q (flatteno 5 q))
|
||||
(list (list 5)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-flat-list"
|
||||
(run* q (flatteno (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-singleton"
|
||||
(run* q (flatteno (list 1) q))
|
||||
(list (list 1)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-nested-once"
|
||||
(run*
|
||||
q
|
||||
(flatteno (list 1 (list 2 3) 4) q))
|
||||
(list (list 1 2 3 4)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-nested-twice"
|
||||
(run*
|
||||
q
|
||||
(flatteno
|
||||
(list
|
||||
1
|
||||
(list 2 (list 3 4))
|
||||
5)
|
||||
q))
|
||||
(list (list 1 2 3 4 5)))
|
||||
|
||||
(mk-test
|
||||
"flatteno-keywords"
|
||||
(run* q (flatteno (list :a (list :b :c) :d) q))
|
||||
(list (list :a :b :c :d)))
|
||||
|
||||
(mk-tests-run!)
|
||||
48
lib/minikanren/tests/foldl-o.sx
Normal file
48
lib/minikanren/tests/foldl-o.sx
Normal file
@@ -0,0 +1,48 @@
|
||||
;; lib/minikanren/tests/foldl-o.sx — relational left fold.
|
||||
|
||||
(mk-test
|
||||
"foldl-o-empty"
|
||||
(run* q (foldl-o pluso-i (list) 42 q))
|
||||
(list 42))
|
||||
|
||||
(mk-test
|
||||
"foldl-o-sum"
|
||||
(run*
|
||||
q
|
||||
(foldl-o
|
||||
pluso-i
|
||||
(list 1 2 3 4 5)
|
||||
0
|
||||
q))
|
||||
(list 15))
|
||||
|
||||
(mk-test
|
||||
"foldl-o-product"
|
||||
(run*
|
||||
q
|
||||
(foldl-o
|
||||
*o-i
|
||||
(list 1 2 3 4)
|
||||
1
|
||||
q))
|
||||
(list 24))
|
||||
|
||||
(mk-test
|
||||
"foldl-o-reverse-via-flip-conso"
|
||||
(run*
|
||||
q
|
||||
(foldl-o
|
||||
(fn (acc x r) (conso x acc r))
|
||||
(list 1 2 3 4)
|
||||
(list)
|
||||
q))
|
||||
(list (list 4 3 2 1)))
|
||||
|
||||
(mk-test
|
||||
"foldl-o-with-init"
|
||||
(run*
|
||||
q
|
||||
(foldl-o pluso-i (list 1 2 3) 100 q))
|
||||
(list 106))
|
||||
|
||||
(mk-tests-run!)
|
||||
38
lib/minikanren/tests/foldr-o.sx
Normal file
38
lib/minikanren/tests/foldr-o.sx
Normal file
@@ -0,0 +1,38 @@
|
||||
;; lib/minikanren/tests/foldr-o.sx — relational right fold.
|
||||
|
||||
(mk-test
|
||||
"foldr-o-empty"
|
||||
(run* q (foldr-o conso (list) (list 99) q))
|
||||
(list (list 99)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-conso-rebuilds-list"
|
||||
(run* q (foldr-o conso (list 1 2 3) (list) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-appendo-flattens"
|
||||
(run*
|
||||
q
|
||||
(foldr-o
|
||||
appendo
|
||||
(list
|
||||
(list 1 2)
|
||||
(list 3)
|
||||
(list 4 5))
|
||||
(list)
|
||||
q))
|
||||
(list (list 1 2 3 4 5)))
|
||||
|
||||
(mk-test
|
||||
"foldr-o-with-acc-init"
|
||||
(run*
|
||||
q
|
||||
(foldr-o
|
||||
conso
|
||||
(list 1 2)
|
||||
(list 9 9)
|
||||
q))
|
||||
(list (list 1 2 9 9)))
|
||||
|
||||
(mk-tests-run!)
|
||||
101
lib/minikanren/tests/fresh.sx
Normal file
101
lib/minikanren/tests/fresh.sx
Normal file
@@ -0,0 +1,101 @@
|
||||
;; lib/minikanren/tests/fresh.sx — Phase 2 piece B tests for `fresh`.
|
||||
|
||||
;; --- empty fresh: pure goal grouping ---
|
||||
|
||||
(mk-test
|
||||
"fresh-empty-vars-equiv-conj"
|
||||
(stream-take 5 ((fresh () (== 1 1)) empty-s))
|
||||
(list empty-s))
|
||||
|
||||
(mk-test
|
||||
"fresh-empty-vars-no-goals-is-succeed"
|
||||
(stream-take 5 ((fresh ()) empty-s))
|
||||
(list empty-s))
|
||||
|
||||
;; --- single var ---
|
||||
|
||||
(mk-test
|
||||
"fresh-one-var-bound"
|
||||
(let
|
||||
((s (first (stream-take 5 ((fresh (x) (== x 7)) empty-s)))))
|
||||
(first (vals s)))
|
||||
7)
|
||||
|
||||
;; --- multiple vars + multiple goals ---
|
||||
|
||||
(mk-test
|
||||
"fresh-two-vars-three-goals"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(x y)
|
||||
(== x 10)
|
||||
(== y 20)
|
||||
(== q (list x y)))))
|
||||
(mk-walk* q (first (stream-take 5 (g empty-s)))))
|
||||
(list 10 20))
|
||||
|
||||
(mk-test
|
||||
"fresh-three-vars"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(a b c)
|
||||
(== a 1)
|
||||
(== b 2)
|
||||
(== c 3)
|
||||
(== q (list a b c)))))
|
||||
(mk-walk* q (first (stream-take 5 (g empty-s)))))
|
||||
(list 1 2 3))
|
||||
|
||||
;; --- fresh interacts with disj ---
|
||||
|
||||
(mk-test
|
||||
"fresh-with-disj"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((g (fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))))
|
||||
(let
|
||||
((res (stream-take 5 (g empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res))))
|
||||
(list 1 2))
|
||||
|
||||
;; --- nested fresh ---
|
||||
|
||||
(mk-test
|
||||
"fresh-nested"
|
||||
(let
|
||||
((q (mk-var "q"))
|
||||
(g
|
||||
(fresh
|
||||
(x)
|
||||
(fresh
|
||||
(y)
|
||||
(== x 1)
|
||||
(== y 2)
|
||||
(== q (list x y))))))
|
||||
(mk-walk* q (first (stream-take 5 (g empty-s)))))
|
||||
(list 1 2))
|
||||
|
||||
;; --- call-fresh (functional alternative) ---
|
||||
|
||||
(mk-test
|
||||
"call-fresh-binds-and-walks"
|
||||
(let
|
||||
((s (first (stream-take 5 ((call-fresh (fn (x) (== x 99))) empty-s)))))
|
||||
(first (vals s)))
|
||||
99)
|
||||
|
||||
(mk-test
|
||||
"call-fresh-distinct-from-outer-vars"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((g (call-fresh (fn (x) (mk-conj (== x 5) (== q (list x x)))))))
|
||||
(mk-walk* q (first (stream-take 5 (g empty-s))))))
|
||||
(list 5 5))
|
||||
|
||||
(mk-tests-run!)
|
||||
260
lib/minikanren/tests/goals.sx
Normal file
260
lib/minikanren/tests/goals.sx
Normal file
@@ -0,0 +1,260 @@
|
||||
;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx.
|
||||
;;
|
||||
;; Streams use a tagged shape internally (`(:s head tail)`) so that mature
|
||||
;; cells can have thunk tails — SX has no improper pairs. Test assertions
|
||||
;; therefore stream-take into a plain SX list, or check goal effects via
|
||||
;; mk-walk on the resulting subst, instead of inspecting raw streams.
|
||||
|
||||
;; --- stream-take base cases (input streams use s-cons / mzero) ---
|
||||
|
||||
(mk-test
|
||||
"stream-take-zero-from-mature"
|
||||
(stream-take 0 (s-cons (empty-subst) mzero))
|
||||
(list))
|
||||
|
||||
(mk-test "stream-take-from-mzero" (stream-take 5 mzero) (list))
|
||||
|
||||
(mk-test
|
||||
"stream-take-mature-pair"
|
||||
(stream-take 5 (s-cons :a (s-cons :b mzero)))
|
||||
(list :a :b))
|
||||
|
||||
(mk-test
|
||||
"stream-take-fewer-than-available"
|
||||
(stream-take 1 (s-cons :a (s-cons :b mzero)))
|
||||
(list :a))
|
||||
|
||||
(mk-test
|
||||
"stream-take-all-with-neg-1"
|
||||
(stream-take -1 (s-cons :a (s-cons :b (s-cons :c mzero))))
|
||||
(list :a :b :c))
|
||||
|
||||
;; --- stream-take forces immature thunks ---
|
||||
|
||||
(mk-test
|
||||
"stream-take-forces-thunk"
|
||||
(stream-take 5 (fn () (s-cons :x mzero)))
|
||||
(list :x))
|
||||
|
||||
(mk-test
|
||||
"stream-take-forces-nested-thunks"
|
||||
(stream-take 5 (fn () (fn () (s-cons :y mzero))))
|
||||
(list :y))
|
||||
|
||||
;; --- mk-mplus interleaves ---
|
||||
|
||||
(mk-test
|
||||
"mplus-empty-left"
|
||||
(stream-take 5 (mk-mplus mzero (s-cons :r mzero)))
|
||||
(list :r))
|
||||
|
||||
(mk-test
|
||||
"mplus-empty-right"
|
||||
(stream-take 5 (mk-mplus (s-cons :l mzero) mzero))
|
||||
(list :l))
|
||||
|
||||
(mk-test
|
||||
"mplus-mature-mature"
|
||||
(stream-take
|
||||
5
|
||||
(mk-mplus (s-cons :a (s-cons :b mzero)) (s-cons :c (s-cons :d mzero))))
|
||||
(list :a :b :c :d))
|
||||
|
||||
(mk-test
|
||||
"mplus-with-paused-left-swaps"
|
||||
(stream-take
|
||||
5
|
||||
(mk-mplus
|
||||
(fn () (s-cons :a (s-cons :b mzero)))
|
||||
(s-cons :c (s-cons :d mzero))))
|
||||
(list :c :d :a :b))
|
||||
|
||||
;; --- mk-bind ---
|
||||
|
||||
(mk-test
|
||||
"bind-empty-stream"
|
||||
(stream-take 5 (mk-bind mzero (fn (s) (unit s))))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"bind-singleton-identity"
|
||||
(stream-take
|
||||
5
|
||||
(mk-bind (s-cons 5 mzero) (fn (x) (unit x))))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"bind-flat-multi"
|
||||
(stream-take
|
||||
10
|
||||
(mk-bind
|
||||
(s-cons 1 (s-cons 2 mzero))
|
||||
(fn (x) (s-cons x (s-cons (* x 10) mzero)))))
|
||||
(list 1 10 2 20))
|
||||
|
||||
(mk-test
|
||||
"bind-fail-prunes-some"
|
||||
(stream-take
|
||||
10
|
||||
(mk-bind
|
||||
(s-cons 1 (s-cons 2 (s-cons 3 mzero)))
|
||||
(fn (x) (if (= x 2) mzero (unit x)))))
|
||||
(list 1 3))
|
||||
|
||||
;; --- core goals: succeed / fail ---
|
||||
|
||||
(mk-test
|
||||
"succeed-yields-singleton"
|
||||
(stream-take 5 (succeed empty-s))
|
||||
(list empty-s))
|
||||
|
||||
(mk-test "fail-yields-mzero" (stream-take 5 (fail empty-s)) (list))
|
||||
|
||||
;; --- == ---
|
||||
|
||||
(mk-test
|
||||
"eq-ground-success"
|
||||
(stream-take 5 ((== 1 1) empty-s))
|
||||
(list empty-s))
|
||||
|
||||
(mk-test
|
||||
"eq-ground-failure"
|
||||
(stream-take 5 ((== 1 2) empty-s))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"eq-binds-var"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-walk
|
||||
x
|
||||
(first (stream-take 5 ((== x 7) empty-s)))))
|
||||
7)
|
||||
|
||||
(mk-test
|
||||
"eq-list-success"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-walk
|
||||
x
|
||||
(first
|
||||
(stream-take
|
||||
5
|
||||
((== x (list 1 2)) empty-s)))))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"eq-list-mismatch-fails"
|
||||
(stream-take
|
||||
5
|
||||
((== (list 1 2) (list 1 3)) empty-s))
|
||||
(list))
|
||||
|
||||
;; --- conj2 / mk-conj ---
|
||||
|
||||
(mk-test
|
||||
"conj2-both-bind"
|
||||
(let
|
||||
((x (mk-var "x")) (y (mk-var "y")))
|
||||
(let
|
||||
((s (first (stream-take 5 ((conj2 (== x 1) (== y 2)) empty-s)))))
|
||||
(list (mk-walk x s) (mk-walk y s))))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"conj2-conflict-empty"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(stream-take
|
||||
5
|
||||
((conj2 (== x 1) (== x 2)) empty-s)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"conj-empty-is-succeed"
|
||||
(stream-take 5 ((mk-conj) empty-s))
|
||||
(list empty-s))
|
||||
|
||||
(mk-test
|
||||
"conj-single-is-goal"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-walk
|
||||
x
|
||||
(first
|
||||
(stream-take 5 ((mk-conj (== x 99)) empty-s)))))
|
||||
99)
|
||||
|
||||
(mk-test
|
||||
"conj-three-bindings"
|
||||
(let
|
||||
((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
|
||||
(let
|
||||
((s (first (stream-take 5 ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s)))))
|
||||
(list (mk-walk x s) (mk-walk y s) (mk-walk z s))))
|
||||
(list 1 2 3))
|
||||
|
||||
;; --- disj2 / mk-disj ---
|
||||
|
||||
(mk-test
|
||||
"disj2-both-succeed"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((disj2 (== q 1) (== q 2)) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"disj2-fail-or-succeed"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((disj2 fail (== q 5)) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"disj-empty-is-fail"
|
||||
(stream-take 5 ((mk-disj) empty-s))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"disj-three-clauses"
|
||||
(let
|
||||
((q (mk-var "q")))
|
||||
(let
|
||||
((res (stream-take 5 ((mk-disj (== q "a") (== q "b") (== q "c")) empty-s))))
|
||||
(map (fn (s) (mk-walk q s)) res)))
|
||||
(list "a" "b" "c"))
|
||||
|
||||
;; --- conj/disj nesting ---
|
||||
|
||||
(mk-test
|
||||
"disj-of-conj"
|
||||
(let
|
||||
((x (mk-var "x")) (y (mk-var "y")))
|
||||
(let
|
||||
((res (stream-take 5 ((mk-disj (mk-conj (== x 1) (== y 2)) (mk-conj (== x 3) (== y 4))) empty-s))))
|
||||
(map (fn (s) (list (mk-walk x s) (mk-walk y s))) res)))
|
||||
(list (list 1 2) (list 3 4)))
|
||||
|
||||
;; --- ==-check ---
|
||||
|
||||
(mk-test
|
||||
"eq-check-no-occurs-fails"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(stream-take 5 ((==-check x (list 1 x)) empty-s)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"eq-check-no-occurs-non-occurring-succeeds"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-walk
|
||||
x
|
||||
(first (stream-take 5 ((==-check x 5) empty-s)))))
|
||||
5)
|
||||
|
||||
(mk-tests-run!)
|
||||
70
lib/minikanren/tests/graph.sx
Normal file
70
lib/minikanren/tests/graph.sx
Normal file
@@ -0,0 +1,70 @@
|
||||
;; lib/minikanren/tests/graph.sx — directed-graph reachability via patho.
|
||||
|
||||
(define
|
||||
test-edges
|
||||
(list (list :a :b) (list :b :c) (list :c :d) (list :a :c) (list :d :e)))
|
||||
|
||||
(define edgeo (fn (from to) (membero (list from to) test-edges)))
|
||||
|
||||
(define
|
||||
patho
|
||||
(fn
|
||||
(x y path)
|
||||
(conde
|
||||
((edgeo x y) (== path (list x y)))
|
||||
((fresh (z mid-path) (edgeo x z) (patho z y mid-path) (conso x mid-path path))))))
|
||||
|
||||
;; --- direct edges ---
|
||||
|
||||
(mk-test "patho-direct" (run* q (patho :a :b q)) (list (list :a :b)))
|
||||
|
||||
(mk-test "patho-no-direct-edge" (run* q (patho :e :a q)) (list))
|
||||
|
||||
;; --- indirect ---
|
||||
|
||||
(mk-test
|
||||
"patho-multi-hop"
|
||||
(let
|
||||
((paths (run* q (patho :a :d q))))
|
||||
(and
|
||||
(= (len paths) 2)
|
||||
(and
|
||||
(some (fn (p) (= p (list :a :b :c :d))) paths)
|
||||
(some (fn (p) (= p (list :a :c :d))) paths))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"patho-to-leaf"
|
||||
(let
|
||||
((paths (run* q (patho :a :e q))))
|
||||
(and
|
||||
(= (len paths) 2)
|
||||
(and
|
||||
(some (fn (p) (= p (list :a :b :c :d :e))) paths)
|
||||
(some (fn (p) (= p (list :a :c :d :e))) paths))))
|
||||
true)
|
||||
|
||||
;; --- enumeration with multiplicity ---
|
||||
;; Each path contributes one tuple, so reachable nodes can repeat. Here
|
||||
;; targets are: b (1 path), c (2 paths), d (2 paths), e (2 paths) = 7.
|
||||
|
||||
(mk-test
|
||||
"patho-enumerate-from-a-with-multiplicity"
|
||||
(let
|
||||
((targets (run* q (fresh (path) (patho :a q path)))))
|
||||
(and
|
||||
(= (len targets) 7)
|
||||
(and
|
||||
(some (fn (t) (= t :b)) targets)
|
||||
(and
|
||||
(some (fn (t) (= t :c)) targets)
|
||||
(and
|
||||
(some (fn (t) (= t :d)) targets)
|
||||
(some (fn (t) (= t :e)) targets))))))
|
||||
true)
|
||||
|
||||
;; --- unreachable target ---
|
||||
|
||||
(mk-test "patho-unreachable" (run* q (patho :a :z q)) (list))
|
||||
|
||||
(mk-tests-run!)
|
||||
103
lib/minikanren/tests/intarith.sx
Normal file
103
lib/minikanren/tests/intarith.sx
Normal file
@@ -0,0 +1,103 @@
|
||||
;; lib/minikanren/tests/intarith.sx — ground-only integer arithmetic
|
||||
;; goals that escape into host operations via project.
|
||||
|
||||
;; --- pluso-i ---
|
||||
|
||||
(mk-test
|
||||
"pluso-i-forward"
|
||||
(run* q (pluso-i 7 8 q))
|
||||
(list 15))
|
||||
(mk-test
|
||||
"pluso-i-zero"
|
||||
(run* q (pluso-i 0 0 q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"pluso-i-negatives"
|
||||
(run* q (pluso-i -5 3 q))
|
||||
(list -2))
|
||||
(mk-test
|
||||
"pluso-i-non-ground-fails"
|
||||
(run* q (fresh (a) (pluso-i a 3 5)))
|
||||
(list))
|
||||
|
||||
;; --- minuso-i ---
|
||||
|
||||
(mk-test
|
||||
"minuso-i-forward"
|
||||
(run* q (minuso-i 10 4 q))
|
||||
(list 6))
|
||||
(mk-test
|
||||
"minuso-i-zero"
|
||||
(run* q (minuso-i 5 5 q))
|
||||
(list 0))
|
||||
|
||||
;; --- *o-i ---
|
||||
|
||||
(mk-test
|
||||
"times-i-forward"
|
||||
(run* q (*o-i 6 7 q))
|
||||
(list 42))
|
||||
(mk-test
|
||||
"times-i-by-zero"
|
||||
(run* q (*o-i 0 99 q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"times-i-by-one"
|
||||
(run* q (*o-i 1 17 q))
|
||||
(list 17))
|
||||
|
||||
;; --- comparisons ---
|
||||
|
||||
(mk-test
|
||||
"lto-i-true"
|
||||
(run 1 q (lto-i 2 5))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "lto-i-false" (run* q (lto-i 5 2)) (list))
|
||||
(mk-test "lto-i-equal-false" (run* q (lto-i 3 3)) (list))
|
||||
|
||||
(mk-test
|
||||
"lteo-i-equal"
|
||||
(run 1 q (lteo-i 4 4))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"lteo-i-less"
|
||||
(run 1 q (lteo-i 1 4))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "lteo-i-more" (run* q (lteo-i 9 4)) (list))
|
||||
|
||||
(mk-test
|
||||
"neqo-i-different"
|
||||
(run 1 q (neqo-i 3 5))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "neqo-i-same" (run* q (neqo-i 3 3)) (list))
|
||||
|
||||
;; --- composition with relational vars ---
|
||||
|
||||
(mk-test
|
||||
"intarith-with-membero"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(membero
|
||||
x
|
||||
(list 1 2 3 4 5))
|
||||
(lto-i x 3)
|
||||
(== q x)))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test "even-i-pos" (run* q (even-i 4)) (list (make-symbol "_.0")))
|
||||
|
||||
(mk-test "even-i-neg" (run* q (even-i 5)) (list))
|
||||
|
||||
(mk-test "odd-i-pos" (run* q (odd-i 7)) (list (make-symbol "_.0")))
|
||||
|
||||
(mk-test "odd-i-neg" (run* q (odd-i 4)) (list))
|
||||
|
||||
(mk-test
|
||||
"even-i-filter"
|
||||
(run* q (fresh (x) (membero x (list 1 2 3 4 5 6)) (even-i x) (== q x)))
|
||||
(list 2 4 6))
|
||||
|
||||
(mk-tests-run!)
|
||||
|
||||
38
lib/minikanren/tests/iterate-no.sx
Normal file
38
lib/minikanren/tests/iterate-no.sx
Normal file
@@ -0,0 +1,38 @@
|
||||
;; lib/minikanren/tests/iterate-no.sx — iterated relation application.
|
||||
|
||||
(define
|
||||
mk-nat
|
||||
(fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
|
||||
|
||||
(mk-test
|
||||
"iterate-no-zero"
|
||||
(run*
|
||||
q
|
||||
(iterate-no
|
||||
(fn (a b) (== b (list :wrap a)))
|
||||
(mk-nat 0)
|
||||
:seed q))
|
||||
(list :seed))
|
||||
|
||||
(mk-test
|
||||
"iterate-no-three-wraps"
|
||||
(run*
|
||||
q
|
||||
(iterate-no (fn (a b) (== b (list :wrap a))) (mk-nat 3) :x q))
|
||||
(list (list :wrap (list :wrap (list :wrap :x)))))
|
||||
|
||||
(mk-test
|
||||
"iterate-no-succ-three-times"
|
||||
(run*
|
||||
q
|
||||
(iterate-no (fn (a b) (== b (list :s a))) (mk-nat 3) :z q))
|
||||
(list (mk-nat 3)))
|
||||
|
||||
(mk-test
|
||||
"iterate-no-with-list-cons"
|
||||
(run*
|
||||
q
|
||||
(iterate-no (fn (a b) (conso :a a b)) (mk-nat 4) (list) q))
|
||||
(list (list :a :a :a :a)))
|
||||
|
||||
(mk-tests-run!)
|
||||
38
lib/minikanren/tests/lasto.sx
Normal file
38
lib/minikanren/tests/lasto.sx
Normal file
@@ -0,0 +1,38 @@
|
||||
;; lib/minikanren/tests/lasto.sx — last-element + init-without-last.
|
||||
|
||||
(mk-test
|
||||
"lasto-singleton"
|
||||
(run* q (lasto (list 5) q))
|
||||
(list 5))
|
||||
(mk-test
|
||||
"lasto-multi"
|
||||
(run* q (lasto (list 1 2 3 4) q))
|
||||
(list 4))
|
||||
(mk-test "lasto-empty" (run* q (lasto (list) q)) (list))
|
||||
|
||||
(mk-test "lasto-strings" (run* q (lasto (list "a" "b" "c") q)) (list "c"))
|
||||
|
||||
(mk-test
|
||||
"init-o-multi"
|
||||
(run* q (init-o (list 1 2 3 4) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"init-o-singleton"
|
||||
(run* q (init-o (list 7) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test "init-o-empty" (run* q (init-o (list) q)) (list))
|
||||
|
||||
(mk-test
|
||||
"lasto-init-o-roundtrip"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(init last)
|
||||
(lasto (list 1 2 3 4) last)
|
||||
(init-o (list 1 2 3 4) init)
|
||||
(appendo init (list last) q)))
|
||||
(list (list 1 2 3 4)))
|
||||
|
||||
(mk-tests-run!)
|
||||
61
lib/minikanren/tests/latin.sx
Normal file
61
lib/minikanren/tests/latin.sx
Normal file
@@ -0,0 +1,61 @@
|
||||
;; lib/minikanren/tests/latin.sx — 2x2 Latin square via ino + all-distincto.
|
||||
;;
|
||||
;; A 2x2 Latin square has 2 distinct fillings:
|
||||
;; ((1 2) (2 1)) and ((2 1) (1 2)).
|
||||
;; The 3x3 version has 12 fillings but takes minutes under naive search;
|
||||
;; full CLP(FD) (Phase 6 proper) would handle it in milliseconds.
|
||||
|
||||
(define
|
||||
latin-2x2
|
||||
(fn
|
||||
(cells)
|
||||
(let
|
||||
((c11 (nth cells 0))
|
||||
(c12 (nth cells 1))
|
||||
(c21 (nth cells 2))
|
||||
(c22 (nth cells 3))
|
||||
(dom (list 1 2)))
|
||||
(mk-conj
|
||||
(ino c11 dom)
|
||||
(ino c12 dom)
|
||||
(ino c21 dom)
|
||||
(ino c22 dom)
|
||||
(all-distincto (list c11 c12))
|
||||
(all-distincto (list c21 c22))
|
||||
(all-distincto (list c11 c21))
|
||||
(all-distincto (list c12 c22)))))) ;; col 2
|
||||
|
||||
(mk-test
|
||||
"latin-2x2-count"
|
||||
(let
|
||||
((squares (run* q (fresh (a b c d) (== q (list a b c d)) (latin-2x2 (list a b c d))))))
|
||||
(len squares))
|
||||
2)
|
||||
|
||||
(mk-test
|
||||
"latin-2x2-as-set"
|
||||
(let
|
||||
((squares (run* q (fresh (a b c d) (== q (list a b c d)) (latin-2x2 (list a b c d))))))
|
||||
(and
|
||||
(= (len squares) 2)
|
||||
(and
|
||||
(some
|
||||
(fn (s) (= s (list 1 2 2 1)))
|
||||
squares)
|
||||
(some
|
||||
(fn (s) (= s (list 2 1 1 2)))
|
||||
squares))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"latin-2x2-with-clue"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(a b c d)
|
||||
(== a 1)
|
||||
(== q (list a b c d))
|
||||
(latin-2x2 (list a b c d))))
|
||||
(list (list 1 2 2 1)))
|
||||
|
||||
(mk-tests-run!)
|
||||
77
lib/minikanren/tests/laziness.sx
Normal file
77
lib/minikanren/tests/laziness.sx
Normal file
@@ -0,0 +1,77 @@
|
||||
;; lib/minikanren/tests/laziness.sx — verify Zzz wrapping (in conde)
|
||||
;; lets infinitely-recursive relations produce finite prefixes via run-n.
|
||||
|
||||
;; --- a relation that has no base case but conde-protects via Zzz ---
|
||||
|
||||
(define
|
||||
listo-aux
|
||||
(fn
|
||||
(l)
|
||||
(conde ((nullo l)) ((fresh (a d) (conso a d l) (listo-aux d))))))
|
||||
|
||||
(mk-test
|
||||
"infinite-relation-truncates-via-run-n"
|
||||
(run 4 q (listo-aux q))
|
||||
(list
|
||||
(list)
|
||||
(list (make-symbol "_.0"))
|
||||
(list (make-symbol "_.0") (make-symbol "_.1"))
|
||||
(list (make-symbol "_.0") (make-symbol "_.1") (make-symbol "_.2"))))
|
||||
|
||||
;; --- two infinite generators interleaved via mk-disj must both produce
|
||||
;; answers (no starvation) — the fairness test ---
|
||||
|
||||
(define
|
||||
ones-gen
|
||||
(fn
|
||||
(l)
|
||||
(conde
|
||||
((== l (list)))
|
||||
((fresh (d) (conso 1 d l) (ones-gen d))))))
|
||||
|
||||
(define
|
||||
twos-gen
|
||||
(fn
|
||||
(l)
|
||||
(conde
|
||||
((== l (list)))
|
||||
((fresh (d) (conso 2 d l) (twos-gen d))))))
|
||||
|
||||
(mk-test
|
||||
"interleaving-keeps-both-streams-alive"
|
||||
(let
|
||||
((res (run 4 q (mk-disj (ones-gen q) (twos-gen q)))))
|
||||
(and
|
||||
(= (len res) 4)
|
||||
(and
|
||||
(some
|
||||
(fn
|
||||
(x)
|
||||
(and
|
||||
(list? x)
|
||||
(and (not (empty? x)) (= (first x) 1))))
|
||||
res)
|
||||
(some
|
||||
(fn
|
||||
(x)
|
||||
(and
|
||||
(list? x)
|
||||
(and (not (empty? x)) (= (first x) 2))))
|
||||
res))))
|
||||
true)
|
||||
|
||||
;; --- run* terminates on a relation whose conde has finite base case
|
||||
;; reached from any starting point ---
|
||||
|
||||
(mk-test
|
||||
"run-star-terminates-on-bounded-relation"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(l)
|
||||
(== l (list 1 2 3))
|
||||
(listo l)
|
||||
(== q :ok)))
|
||||
(list :ok))
|
||||
|
||||
(mk-tests-run!)
|
||||
28
lib/minikanren/tests/lengtho-i.sx
Normal file
28
lib/minikanren/tests/lengtho-i.sx
Normal file
@@ -0,0 +1,28 @@
|
||||
;; lib/minikanren/tests/lengtho-i.sx — integer-indexed length (fast).
|
||||
|
||||
(mk-test "lengtho-i-empty" (run* q (lengtho-i (list) q)) (list 0))
|
||||
(mk-test
|
||||
"lengtho-i-singleton"
|
||||
(run* q (lengtho-i (list :a) q))
|
||||
(list 1))
|
||||
(mk-test
|
||||
"lengtho-i-three"
|
||||
(run* q (lengtho-i (list 1 2 3) q))
|
||||
(list 3))
|
||||
(mk-test
|
||||
"lengtho-i-five"
|
||||
(run*
|
||||
q
|
||||
(lengtho-i
|
||||
(list 1 2 3 4 5)
|
||||
q))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"lengtho-i-mixed-types"
|
||||
(run*
|
||||
q
|
||||
(lengtho-i (list 1 "two" :three (list 4 5)) q))
|
||||
(list 4))
|
||||
|
||||
(mk-tests-run!)
|
||||
126
lib/minikanren/tests/list-relations.sx
Normal file
126
lib/minikanren/tests/list-relations.sx
Normal file
@@ -0,0 +1,126 @@
|
||||
;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o, samelengtho.
|
||||
|
||||
;; --- rembero (remove first occurrence) ---
|
||||
|
||||
(mk-test
|
||||
"rembero-element-present"
|
||||
(run*
|
||||
q
|
||||
(rembero 2 (list 1 2 3 2) q))
|
||||
(list (list 1 3 2)))
|
||||
|
||||
(mk-test
|
||||
"rembero-element-not-present"
|
||||
(run* q (rembero 99 (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"rembero-empty"
|
||||
(run* q (rembero 1 (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"rembero-only-element"
|
||||
(run* q (rembero 5 (list 5) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"rembero-first-of-many"
|
||||
(run*
|
||||
q
|
||||
(rembero 1 (list 1 2 3 4) q))
|
||||
(list (list 2 3 4)))
|
||||
|
||||
;; --- assoco (alist lookup) ---
|
||||
|
||||
(define
|
||||
test-pairs
|
||||
(list
|
||||
(list "alice" 30)
|
||||
(list "bob" 25)
|
||||
(list "carol" 35)))
|
||||
|
||||
(mk-test
|
||||
"assoco-found"
|
||||
(run* q (assoco "bob" test-pairs q))
|
||||
(list 25))
|
||||
|
||||
(mk-test
|
||||
"assoco-first"
|
||||
(run* q (assoco "alice" test-pairs q))
|
||||
(list 30))
|
||||
|
||||
(mk-test "assoco-missing" (run* q (assoco "dave" test-pairs q)) (list))
|
||||
|
||||
(mk-test
|
||||
"assoco-find-keys-with-value"
|
||||
(run* q (assoco q test-pairs 25))
|
||||
(list "bob"))
|
||||
|
||||
;; --- nth-o (Peano-indexed access) ---
|
||||
|
||||
(mk-test
|
||||
"nth-o-zero"
|
||||
(run* q (nth-o :z (list 10 20 30) q))
|
||||
(list 10))
|
||||
|
||||
(mk-test
|
||||
"nth-o-one"
|
||||
(run* q (nth-o (list :s :z) (list 10 20 30) q))
|
||||
(list 20))
|
||||
|
||||
(mk-test
|
||||
"nth-o-two"
|
||||
(run*
|
||||
q
|
||||
(nth-o (list :s (list :s :z)) (list 10 20 30) q))
|
||||
(list 30))
|
||||
|
||||
(mk-test
|
||||
"nth-o-out-of-range"
|
||||
(run*
|
||||
q
|
||||
(nth-o
|
||||
(list :s (list :s (list :s :z)))
|
||||
(list 10 20 30)
|
||||
q))
|
||||
(list))
|
||||
|
||||
;; --- samelengtho ---
|
||||
|
||||
(mk-test
|
||||
"samelengtho-equal"
|
||||
(run*
|
||||
q
|
||||
(samelengtho (list 1 2 3) (list :a :b :c)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"samelengtho-different-fails"
|
||||
(run* q (samelengtho (list 1 2) (list :a :b :c)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"samelengtho-empty-equal"
|
||||
(run* q (samelengtho (list) (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"samelengtho-builds-vars"
|
||||
(run 1 q (samelengtho (list 1 2 3) q))
|
||||
(list (list (make-symbol "_.0") (make-symbol "_.1") (make-symbol "_.2"))))
|
||||
|
||||
(mk-test
|
||||
"samelengtho-enumerates-pairs"
|
||||
(run
|
||||
3
|
||||
q
|
||||
(fresh (l1 l2) (samelengtho l1 l2) (== q (list l1 l2))))
|
||||
(list
|
||||
(list (list) (list))
|
||||
(list (list (make-symbol "_.0")) (list (make-symbol "_.1")))
|
||||
(list
|
||||
(list (make-symbol "_.0") (make-symbol "_.1"))
|
||||
(list (make-symbol "_.2") (make-symbol "_.3")))))
|
||||
|
||||
(mk-tests-run!)
|
||||
62
lib/minikanren/tests/mapo.sx
Normal file
62
lib/minikanren/tests/mapo.sx
Normal file
@@ -0,0 +1,62 @@
|
||||
;; lib/minikanren/tests/mapo.sx — relational map.
|
||||
|
||||
(mk-test
|
||||
"mapo-identity"
|
||||
(run*
|
||||
q
|
||||
(mapo (fn (a b) (== a b)) (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"mapo-tag-each"
|
||||
(run*
|
||||
q
|
||||
(mapo
|
||||
(fn (a b) (== b (list :tag a)))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list
|
||||
(list
|
||||
(list :tag 1)
|
||||
(list :tag 2)
|
||||
(list :tag 3))))
|
||||
|
||||
(mk-test
|
||||
"mapo-backward"
|
||||
(run*
|
||||
q
|
||||
(mapo (fn (a b) (== a b)) q (list 1 2 3)))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"mapo-empty"
|
||||
(run* q (mapo (fn (a b) (== a b)) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"mapo-duplicate"
|
||||
(run* q (mapo (fn (a b) (== b (list a a))) (list :x :y) q))
|
||||
(list (list (list :x :x) (list :y :y))))
|
||||
|
||||
(mk-test
|
||||
"mapo-different-length-fails"
|
||||
(run*
|
||||
q
|
||||
(mapo
|
||||
(fn (a b) (== a b))
|
||||
(list 1 2)
|
||||
(list 1 2 3)))
|
||||
(list))
|
||||
|
||||
;; mapo + arithmetic via intarith
|
||||
(mk-test
|
||||
"mapo-square-each"
|
||||
(run*
|
||||
q
|
||||
(mapo
|
||||
(fn (a b) (*o-i a a b))
|
||||
(list 1 2 3 4)
|
||||
q))
|
||||
(list (list 1 4 9 16)))
|
||||
|
||||
(mk-tests-run!)
|
||||
138
lib/minikanren/tests/matche.sx
Normal file
138
lib/minikanren/tests/matche.sx
Normal file
@@ -0,0 +1,138 @@
|
||||
;; lib/minikanren/tests/matche.sx — Phase 5 piece D tests for `matche`.
|
||||
|
||||
;; --- literal patterns ---
|
||||
|
||||
(mk-test
|
||||
"matche-literal-number"
|
||||
(run* q (matche q (1 (== q 1))))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"matche-literal-string"
|
||||
(run* q (matche q ("hello" (== q "hello"))))
|
||||
(list "hello"))
|
||||
|
||||
(mk-test
|
||||
"matche-literal-no-clause-matches"
|
||||
(run*
|
||||
q
|
||||
(matche 7 (1 (== q :a)) (2 (== q :b))))
|
||||
(list))
|
||||
|
||||
;; --- variable patterns ---
|
||||
|
||||
(mk-test
|
||||
"matche-symbol-pattern"
|
||||
(run* q (fresh (x) (== x 99) (matche x (a (== q a)))))
|
||||
(list 99))
|
||||
|
||||
(mk-test
|
||||
"matche-wildcard"
|
||||
(run* q (fresh (x) (== x 7) (matche x (_ (== q :any)))))
|
||||
(list :any))
|
||||
|
||||
;; --- list patterns ---
|
||||
|
||||
(mk-test
|
||||
"matche-empty-list"
|
||||
(run* q (matche (list) (() (== q :ok))))
|
||||
(list :ok))
|
||||
|
||||
(mk-test
|
||||
"matche-pair-binds"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 1 2))
|
||||
(matche x ((a b) (== q (list b a))))))
|
||||
(list (list 2 1)))
|
||||
|
||||
(mk-test
|
||||
"matche-triple-binds"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 1 2 3))
|
||||
(matche x ((a b c) (== q (list :sum a b c))))))
|
||||
(list (list :sum 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"matche-mixed-literal-and-var"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 1 99 3))
|
||||
(matche x ((1 m 3) (== q m)))))
|
||||
(list 99))
|
||||
|
||||
;; --- multi-clause dispatch ---
|
||||
|
||||
(mk-test
|
||||
"matche-multi-clause-shape"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 5 6))
|
||||
(matche
|
||||
x
|
||||
(() (== q :empty))
|
||||
((a) (== q (list :one a)))
|
||||
((a b) (== q (list :two a b))))))
|
||||
(list (list :two 5 6)))
|
||||
|
||||
(mk-test
|
||||
"matche-three-shapes-via-fresh"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(matche
|
||||
x
|
||||
(() (== q :empty))
|
||||
((a) (== q (list :one a)))
|
||||
((a b) (== q (list :two a b))))))
|
||||
(list
|
||||
:empty (list :one (make-symbol "_.0"))
|
||||
(list :two (make-symbol "_.0") (make-symbol "_.1"))))
|
||||
|
||||
;; --- nested patterns ---
|
||||
|
||||
(mk-test
|
||||
"matche-nested"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(==
|
||||
x
|
||||
(list (list 1 2) (list 3 4)))
|
||||
(matche x (((a b) (c d)) (== q (list a b c d))))))
|
||||
(list (list 1 2 3 4)))
|
||||
|
||||
;; --- repeated var names create the same fresh var → must unify ---
|
||||
|
||||
(mk-test
|
||||
"matche-repeated-var-implies-equality"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 7 7))
|
||||
(matche x ((a a) (== q a)))))
|
||||
(list 7))
|
||||
|
||||
(mk-test
|
||||
"matche-repeated-var-mismatch-fails"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(== x (list 7 8))
|
||||
(matche x ((a a) (== q a)))))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
49
lib/minikanren/tests/minmax.sx
Normal file
49
lib/minikanren/tests/minmax.sx
Normal file
@@ -0,0 +1,49 @@
|
||||
;; lib/minikanren/tests/minmax.sx — mino + maxo via intarith.
|
||||
|
||||
(mk-test
|
||||
"mino-singleton"
|
||||
(run* q (mino (list 7) q))
|
||||
(list 7))
|
||||
(mk-test
|
||||
"mino-of-3"
|
||||
(run* q (mino (list 5 1 3) q))
|
||||
(list 1))
|
||||
(mk-test
|
||||
"mino-of-5"
|
||||
(run*
|
||||
q
|
||||
(mino (list 5 1 3 2 4) q))
|
||||
(list 1))
|
||||
(mk-test
|
||||
"mino-with-dups"
|
||||
(run* q (mino (list 3 3 3) q))
|
||||
(list 3))
|
||||
(mk-test "mino-empty-fails" (run* q (mino (list) q)) (list))
|
||||
|
||||
(mk-test
|
||||
"maxo-singleton"
|
||||
(run* q (maxo (list 7) q))
|
||||
(list 7))
|
||||
(mk-test
|
||||
"maxo-of-5"
|
||||
(run*
|
||||
q
|
||||
(maxo (list 5 1 3 2 4) q))
|
||||
(list 5))
|
||||
(mk-test
|
||||
"maxo-of-negs"
|
||||
(run* q (maxo (list -5 -1 -3) q))
|
||||
(list -1))
|
||||
|
||||
(mk-test
|
||||
"min-and-max-of-list"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(mn mx)
|
||||
(mino (list 5 1 3 2 4) mn)
|
||||
(maxo (list 5 1 3 2 4) mx)
|
||||
(== q (list mn mx))))
|
||||
(list (list 1 5)))
|
||||
|
||||
(mk-tests-run!)
|
||||
50
lib/minikanren/tests/nafc.sx
Normal file
50
lib/minikanren/tests/nafc.sx
Normal file
@@ -0,0 +1,50 @@
|
||||
;; lib/minikanren/tests/nafc.sx — Phase 5 piece C tests for `nafc`.
|
||||
|
||||
(mk-test
|
||||
"nafc-failed-goal-succeeds"
|
||||
(run* q (nafc (== 1 2)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"nafc-successful-goal-fails"
|
||||
(run* q (nafc (== 1 1)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"nafc-double-negation"
|
||||
(run* q (nafc (nafc (== 1 1))))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"nafc-with-conde-no-clauses-succeed"
|
||||
(run*
|
||||
q
|
||||
(nafc
|
||||
(conde ((== 1 2)) ((== 3 4)))))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"nafc-with-conde-some-clause-succeeds-fails"
|
||||
(run*
|
||||
q
|
||||
(nafc
|
||||
(conde ((== 1 1)) ((== 3 4)))))
|
||||
(list))
|
||||
|
||||
;; --- composing nafc with == as a guard ---
|
||||
|
||||
(mk-test
|
||||
"nafc-as-guard"
|
||||
(run*
|
||||
q
|
||||
(fresh (x) (== x 5) (nafc (== x 99)) (== q x)))
|
||||
(list 5))
|
||||
|
||||
(mk-test
|
||||
"nafc-guard-blocking"
|
||||
(run*
|
||||
q
|
||||
(fresh (x) (== x 5) (nafc (== x 5)) (== q x)))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
29
lib/minikanren/tests/not-membero.sx
Normal file
29
lib/minikanren/tests/not-membero.sx
Normal file
@@ -0,0 +1,29 @@
|
||||
;; lib/minikanren/tests/not-membero.sx — relational "not in list".
|
||||
|
||||
(mk-test
|
||||
"not-membero-absent"
|
||||
(run* q (not-membero 99 (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"not-membero-present"
|
||||
(run* q (not-membero 2 (list 1 2 3)))
|
||||
(list))
|
||||
(mk-test
|
||||
"not-membero-empty"
|
||||
(run* q (not-membero 1 (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"not-membero-as-filter"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(membero
|
||||
x
|
||||
(list 1 2 3 4 5))
|
||||
(not-membero x (list 2 4))
|
||||
(== q x)))
|
||||
(list 1 3 5))
|
||||
|
||||
(mk-tests-run!)
|
||||
31
lib/minikanren/tests/nub-o.sx
Normal file
31
lib/minikanren/tests/nub-o.sx
Normal file
@@ -0,0 +1,31 @@
|
||||
;; lib/minikanren/tests/nub-o.sx — relational dedupe (keep last occurrence).
|
||||
|
||||
(mk-test "nub-o-empty" (run* q (nub-o (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"nub-o-no-duplicates"
|
||||
(run* q (nub-o (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"nub-o-with-duplicates"
|
||||
(run*
|
||||
q
|
||||
(nub-o
|
||||
(list 1 2 1 3 2 4)
|
||||
q))
|
||||
(list (list 1 3 2 4)))
|
||||
|
||||
(mk-test
|
||||
"nub-o-all-same"
|
||||
(let
|
||||
((res (run* q (nub-o (list 1 1 1) q))))
|
||||
(every? (fn (r) (= r (list 1))) res))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"nub-o-keeps-last"
|
||||
(run* q (nub-o (list 1 2 1) q))
|
||||
(list (list 2 1)))
|
||||
|
||||
(mk-tests-run!)
|
||||
41
lib/minikanren/tests/pairlisto.sx
Normal file
41
lib/minikanren/tests/pairlisto.sx
Normal file
@@ -0,0 +1,41 @@
|
||||
;; lib/minikanren/tests/pairlisto.sx — zip two lists into pair list.
|
||||
|
||||
(mk-test
|
||||
"pairlisto-empty"
|
||||
(run* q (pairlisto (list) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"pairlisto-equal-lengths"
|
||||
(run*
|
||||
q
|
||||
(pairlisto (list 1 2 3) (list :a :b :c) q))
|
||||
(list
|
||||
(list (list 1 :a) (list 2 :b) (list 3 :c))))
|
||||
|
||||
(mk-test
|
||||
"pairlisto-recover-l1"
|
||||
(run*
|
||||
q
|
||||
(pairlisto
|
||||
q
|
||||
(list :a :b :c)
|
||||
(list (list 10 :a) (list 20 :b) (list 30 :c))))
|
||||
(list (list 10 20 30)))
|
||||
|
||||
(mk-test
|
||||
"pairlisto-recover-l2"
|
||||
(run*
|
||||
q
|
||||
(pairlisto
|
||||
(list 1 2 3)
|
||||
q
|
||||
(list (list 1 :x) (list 2 :y) (list 3 :z))))
|
||||
(list (list :x :y :z)))
|
||||
|
||||
(mk-test
|
||||
"pairlisto-different-lengths-fails"
|
||||
(run* q (pairlisto (list 1 2) (list :a :b :c) q))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
44
lib/minikanren/tests/palindromeo.sx
Normal file
44
lib/minikanren/tests/palindromeo.sx
Normal file
@@ -0,0 +1,44 @@
|
||||
;; lib/minikanren/tests/palindromeo.sx — palindromic list relation.
|
||||
|
||||
(mk-test
|
||||
"palindromeo-empty"
|
||||
(run* q (palindromeo (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-singleton"
|
||||
(run* q (palindromeo (list :a)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-pair-equal"
|
||||
(run* q (palindromeo (list 1 1)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-pair-unequal-fails"
|
||||
(run* q (palindromeo (list 1 2)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-five-yes"
|
||||
(run*
|
||||
q
|
||||
(palindromeo
|
||||
(list 1 2 3 2 1)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-five-no"
|
||||
(run*
|
||||
q
|
||||
(palindromeo
|
||||
(list 1 2 3 4 5)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"palindromeo-strings"
|
||||
(run* q (palindromeo (list "a" "b" "a")))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-tests-run!)
|
||||
58
lib/minikanren/tests/parity.sx
Normal file
58
lib/minikanren/tests/parity.sx
Normal file
@@ -0,0 +1,58 @@
|
||||
;; lib/minikanren/tests/parity.sx — eveno + oddo Peano predicates.
|
||||
|
||||
(define
|
||||
mk-nat
|
||||
(fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
|
||||
|
||||
(mk-test "eveno-zero" (run* q (eveno :z)) (list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"eveno-2"
|
||||
(run* q (eveno (mk-nat 2)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"eveno-4"
|
||||
(run* q (eveno (mk-nat 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "eveno-1-fails" (run* q (eveno (mk-nat 1))) (list))
|
||||
(mk-test "eveno-3-fails" (run* q (eveno (mk-nat 3))) (list))
|
||||
|
||||
(mk-test
|
||||
"oddo-1"
|
||||
(run* q (oddo (mk-nat 1)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"oddo-3"
|
||||
(run* q (oddo (mk-nat 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "oddo-zero-fails" (run* q (oddo :z)) (list))
|
||||
(mk-test "oddo-2-fails" (run* q (oddo (mk-nat 2))) (list))
|
||||
|
||||
;; Enumerate small evens.
|
||||
(mk-test
|
||||
"eveno-enumerates"
|
||||
(run 4 q (eveno q))
|
||||
(list
|
||||
(mk-nat 0)
|
||||
(mk-nat 2)
|
||||
(mk-nat 4)
|
||||
(mk-nat 6)))
|
||||
|
||||
;; Enumerate small odds.
|
||||
(mk-test
|
||||
"oddo-enumerates"
|
||||
(run 4 q (oddo q))
|
||||
(list
|
||||
(mk-nat 1)
|
||||
(mk-nat 3)
|
||||
(mk-nat 5)
|
||||
(mk-nat 7)))
|
||||
|
||||
;; A number is even XOR odd (no overlap).
|
||||
(mk-test
|
||||
"even-odd-no-overlap"
|
||||
(run*
|
||||
q
|
||||
(mk-conj (eveno (mk-nat 4)) (oddo (mk-nat 4))))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
75
lib/minikanren/tests/partitiono.sx
Normal file
75
lib/minikanren/tests/partitiono.sx
Normal file
@@ -0,0 +1,75 @@
|
||||
;; lib/minikanren/tests/partitiono.sx — partition list by predicate.
|
||||
|
||||
(mk-test
|
||||
"partitiono-empty"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(yes no)
|
||||
(partitiono (fn (x) (== x 1)) (list) yes no)
|
||||
(== q (list yes no))))
|
||||
(list (list (list) (list))))
|
||||
|
||||
(mk-test
|
||||
"partitiono-by-equality"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(yes no)
|
||||
(partitiono
|
||||
(fn (x) (== x 2))
|
||||
(list 1 2 3 2 4)
|
||||
yes
|
||||
no)
|
||||
(== q (list yes no))))
|
||||
(list
|
||||
(list
|
||||
(list 2 2)
|
||||
(list 1 3 4))))
|
||||
|
||||
(mk-test
|
||||
"partitiono-by-numeric-pred"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(yes no)
|
||||
(partitiono
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 7 2 8 3)
|
||||
yes
|
||||
no)
|
||||
(== q (list yes no))))
|
||||
(list
|
||||
(list
|
||||
(list 1 2 3)
|
||||
(list 7 8))))
|
||||
|
||||
(mk-test
|
||||
"partitiono-all-yes"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(yes no)
|
||||
(partitiono
|
||||
(fn (x) (lto-i x 100))
|
||||
(list 1 2 3)
|
||||
yes
|
||||
no)
|
||||
(== q (list yes no))))
|
||||
(list (list (list 1 2 3) (list))))
|
||||
|
||||
(mk-test
|
||||
"partitiono-all-no"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(yes no)
|
||||
(partitiono
|
||||
(fn (x) (lto-i 100 x))
|
||||
(list 1 2 3)
|
||||
yes
|
||||
no)
|
||||
(== q (list yes no))))
|
||||
(list (list (list) (list 1 2 3))))
|
||||
|
||||
(mk-tests-run!)
|
||||
40
lib/minikanren/tests/path-cycle-free.sx
Normal file
40
lib/minikanren/tests/path-cycle-free.sx
Normal file
@@ -0,0 +1,40 @@
|
||||
;; lib/minikanren/tests/path-cycle-free.sx — cycle-free reachability search.
|
||||
;;
|
||||
;; Threads a "visited" accumulator through the recursion, using nafc +
|
||||
;; membero to prevent revisiting nodes. Demonstrates how to make the
|
||||
;; cyclic-graph divergence problem (see tests/cyclic-graph.sx) tractable
|
||||
;; for graphs with cycles, without invoking Phase-7 tabling.
|
||||
|
||||
(define
|
||||
cf-edges
|
||||
(list (list :a :b) (list :b :a) (list :b :c) (list :c :d) (list :d :a))) ; another cycle
|
||||
|
||||
(define cf-edgeo (fn (from to) (membero (list from to) cf-edges)))
|
||||
|
||||
(define
|
||||
patho-no-cycles
|
||||
(fn
|
||||
(x y visited path)
|
||||
(conde
|
||||
((cf-edgeo x y) (nafc (membero y visited)) (== path (list x y)))
|
||||
((fresh (z mid v-prime) (cf-edgeo x z) (nafc (membero z visited)) (conso z visited v-prime) (patho-no-cycles z y v-prime mid) (conso x mid path))))))
|
||||
|
||||
(define cf-patho (fn (x y path) (patho-no-cycles x y (list x) path)))
|
||||
|
||||
(mk-test
|
||||
"cycle-free-finds-finitely"
|
||||
(let
|
||||
((paths (run* q (cf-patho :a :d q))))
|
||||
(and
|
||||
(>= (len paths) 1)
|
||||
(every? (fn (p) (and (= (first p) :a) (= (last p) :d))) paths)))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"cycle-free-direct-edge"
|
||||
(run* q (cf-patho :a :b q))
|
||||
(list (list :a :b)))
|
||||
|
||||
(mk-test "cycle-free-no-self-loop" (run* q (cf-patho :a :a q)) (list))
|
||||
|
||||
(mk-tests-run!)
|
||||
119
lib/minikanren/tests/peano.sx
Normal file
119
lib/minikanren/tests/peano.sx
Normal file
@@ -0,0 +1,119 @@
|
||||
;; lib/minikanren/tests/peano.sx — Peano arithmetic.
|
||||
;;
|
||||
;; Builds Peano numbers via a host-side helper so tests stay readable.
|
||||
;; (mk-nat 3) → (:s (:s (:s :z))).
|
||||
|
||||
(define
|
||||
mk-nat
|
||||
(fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
|
||||
|
||||
;; --- zeroo ---
|
||||
|
||||
(mk-test
|
||||
"zeroo-zero-succeeds"
|
||||
(run* q (zeroo :z))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test
|
||||
"zeroo-non-zero-fails"
|
||||
(run* q (zeroo (mk-nat 1)))
|
||||
(list))
|
||||
|
||||
;; --- pluso forward ---
|
||||
|
||||
(mk-test
|
||||
"pluso-forward-2-3"
|
||||
(run* q (pluso (mk-nat 2) (mk-nat 3) q))
|
||||
(list (mk-nat 5)))
|
||||
|
||||
(mk-test "pluso-forward-zero-zero" (run* q (pluso :z :z q)) (list :z))
|
||||
|
||||
(mk-test
|
||||
"pluso-forward-zero-n"
|
||||
(run* q (pluso :z (mk-nat 4) q))
|
||||
(list (mk-nat 4)))
|
||||
|
||||
(mk-test
|
||||
"pluso-forward-n-zero"
|
||||
(run* q (pluso (mk-nat 4) :z q))
|
||||
(list (mk-nat 4)))
|
||||
|
||||
;; --- pluso backward ---
|
||||
|
||||
(mk-test
|
||||
"pluso-recover-augend"
|
||||
(run* q (pluso q (mk-nat 2) (mk-nat 5)))
|
||||
(list (mk-nat 3)))
|
||||
|
||||
(mk-test
|
||||
"pluso-recover-addend"
|
||||
(run* q (pluso (mk-nat 2) q (mk-nat 5)))
|
||||
(list (mk-nat 3)))
|
||||
|
||||
(mk-test
|
||||
"pluso-enumerate-pairs-summing-to-3"
|
||||
(run*
|
||||
q
|
||||
(fresh (a b) (pluso a b (mk-nat 3)) (== q (list a b))))
|
||||
(list
|
||||
(list :z (mk-nat 3))
|
||||
(list (mk-nat 1) (mk-nat 2))
|
||||
(list (mk-nat 2) (mk-nat 1))
|
||||
(list (mk-nat 3) :z)))
|
||||
|
||||
;; --- minuso ---
|
||||
|
||||
(mk-test
|
||||
"minuso-5-2-3"
|
||||
(run* q (minuso (mk-nat 5) (mk-nat 2) q))
|
||||
(list (mk-nat 3)))
|
||||
|
||||
(mk-test
|
||||
"minuso-n-n-zero"
|
||||
(run* q (minuso (mk-nat 7) (mk-nat 7) q))
|
||||
(list :z))
|
||||
|
||||
;; --- *o ---
|
||||
|
||||
(mk-test
|
||||
"times-2-3"
|
||||
(run* q (*o (mk-nat 2) (mk-nat 3) q))
|
||||
(list (mk-nat 6)))
|
||||
|
||||
(mk-test
|
||||
"times-zero-anything-zero"
|
||||
(run* q (*o :z (mk-nat 99) q))
|
||||
(list :z))
|
||||
|
||||
(mk-test
|
||||
"times-3-4"
|
||||
(run* q (*o (mk-nat 3) (mk-nat 4) q))
|
||||
(list (mk-nat 12)))
|
||||
|
||||
;; --- lteo / lto ---
|
||||
|
||||
(mk-test
|
||||
"lteo-success"
|
||||
(run 1 q (lteo (mk-nat 2) (mk-nat 5)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"lteo-equal-success"
|
||||
(run 1 q (lteo (mk-nat 3) (mk-nat 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"lteo-greater-fails"
|
||||
(run* q (lteo (mk-nat 5) (mk-nat 2)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"lto-strict-success"
|
||||
(run 1 q (lto (mk-nat 2) (mk-nat 5)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"lto-equal-fails"
|
||||
(run* q (lto (mk-nat 3) (mk-nat 3)))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
87
lib/minikanren/tests/predicates.sx
Normal file
87
lib/minikanren/tests/predicates.sx
Normal file
@@ -0,0 +1,87 @@
|
||||
;; lib/minikanren/tests/predicates.sx — everyo, someo.
|
||||
|
||||
;; --- everyo ---
|
||||
|
||||
(mk-test
|
||||
"everyo-empty-trivially-true"
|
||||
(run* q (everyo (fn (x) (== x 1)) (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"everyo-all-match"
|
||||
(run*
|
||||
q
|
||||
(everyo
|
||||
(fn (x) (== x 1))
|
||||
(list 1 1 1)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"everyo-some-mismatch"
|
||||
(run*
|
||||
q
|
||||
(everyo
|
||||
(fn (x) (== x 1))
|
||||
(list 1 2 1)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"everyo-with-intarith"
|
||||
(run*
|
||||
q
|
||||
(everyo
|
||||
(fn (x) (lto-i x 10))
|
||||
(list 1 5 9)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"everyo-with-intarith-fail"
|
||||
(run*
|
||||
q
|
||||
(everyo
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 5 9)))
|
||||
(list))
|
||||
|
||||
;; --- someo ---
|
||||
|
||||
(mk-test
|
||||
"someo-finds-element"
|
||||
(run*
|
||||
q
|
||||
(someo
|
||||
(fn (x) (== x 2))
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"someo-not-found"
|
||||
(run*
|
||||
q
|
||||
(someo
|
||||
(fn (x) (== x 99))
|
||||
(list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"someo-empty-fails"
|
||||
(run* q (someo (fn (x) (== x 1)) (list)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"someo-multiple-matches-yields-multiple"
|
||||
(let
|
||||
((res (run* q (fresh (x) (someo (fn (y) (== y x)) (list 1 2 1)) (== q x)))))
|
||||
(len res))
|
||||
3)
|
||||
|
||||
(mk-test
|
||||
"someo-with-intarith"
|
||||
(run*
|
||||
q
|
||||
(someo
|
||||
(fn (x) (lto-i 100 x))
|
||||
(list 5 50 200)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-tests-run!)
|
||||
76
lib/minikanren/tests/prefix-suffix.sx
Normal file
76
lib/minikanren/tests/prefix-suffix.sx
Normal file
@@ -0,0 +1,76 @@
|
||||
;; lib/minikanren/tests/prefix-suffix.sx — appendo-derived sublist relations.
|
||||
|
||||
(mk-test
|
||||
"prefixo-empty"
|
||||
(run* q (prefixo (list) (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"prefixo-full"
|
||||
(run*
|
||||
q
|
||||
(prefixo
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"prefixo-partial"
|
||||
(run*
|
||||
q
|
||||
(prefixo
|
||||
(list 1 2)
|
||||
(list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"prefixo-mismatch-fails"
|
||||
(run*
|
||||
q
|
||||
(prefixo
|
||||
(list 1 3)
|
||||
(list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"prefixo-enumerates-all"
|
||||
(run* q (prefixo q (list 1 2 3)))
|
||||
(list
|
||||
(list)
|
||||
(list 1)
|
||||
(list 1 2)
|
||||
(list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"suffixo-empty"
|
||||
(run* q (suffixo (list) (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"suffixo-full"
|
||||
(run*
|
||||
q
|
||||
(suffixo
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"suffixo-partial"
|
||||
(run*
|
||||
q
|
||||
(suffixo
|
||||
(list 2 3)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"suffixo-enumerates-all"
|
||||
(run* q (suffixo q (list 1 2 3)))
|
||||
(list
|
||||
(list 1 2 3)
|
||||
(list 2 3)
|
||||
(list 3)
|
||||
(list)))
|
||||
|
||||
(mk-tests-run!)
|
||||
60
lib/minikanren/tests/project.sx
Normal file
60
lib/minikanren/tests/project.sx
Normal file
@@ -0,0 +1,60 @@
|
||||
;; lib/minikanren/tests/project.sx — Phase 5 piece B tests for `project`.
|
||||
|
||||
;; --- project rebinds vars to ground values for SX use ---
|
||||
|
||||
(mk-test
|
||||
"project-square-via-host"
|
||||
(run* q (fresh (n) (== n 5) (project (n) (== q (* n n)))))
|
||||
(list 25))
|
||||
|
||||
(mk-test
|
||||
"project-multi-vars"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(a b)
|
||||
(== a 3)
|
||||
(== b 4)
|
||||
(project (a b) (== q (+ a b)))))
|
||||
(list 7))
|
||||
|
||||
(mk-test
|
||||
"project-with-string-host-op"
|
||||
(run* q (fresh (s) (== s "hello") (project (s) (== q (str s "!")))))
|
||||
(list "hello!"))
|
||||
|
||||
;; --- project nested inside conde ---
|
||||
|
||||
(mk-test
|
||||
"project-inside-conde"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(n)
|
||||
(conde ((== n 3)) ((== n 4)))
|
||||
(project (n) (== q (* n 10)))))
|
||||
(list 30 40))
|
||||
|
||||
;; --- project body can be multiple goals (mk-conj'd) ---
|
||||
|
||||
(mk-test
|
||||
"project-multi-goal-body"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(n)
|
||||
(== n 7)
|
||||
(project (n) (== q (+ n 1)) (== q (+ n 1)))))
|
||||
(list 8))
|
||||
|
||||
(mk-test
|
||||
"project-multi-goal-body-conflict"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(n)
|
||||
(== n 7)
|
||||
(project (n) (== q (+ n 1)) (== q (+ n 2)))))
|
||||
(list))
|
||||
|
||||
(mk-tests-run!)
|
||||
36
lib/minikanren/tests/pythag.sx
Normal file
36
lib/minikanren/tests/pythag.sx
Normal file
@@ -0,0 +1,36 @@
|
||||
;; lib/minikanren/tests/pythag.sx — Pythagorean triple search.
|
||||
;;
|
||||
;; Uses ino + intarith goals to find triples (a, b, c) with
|
||||
;; a, b, c ∈ [1..N], a ≤ b, a² + b² = c². With intarith escapes
|
||||
;; the search runs at host-arithmetic speed.
|
||||
|
||||
(define
|
||||
digits-1-10
|
||||
(list
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10))
|
||||
|
||||
(mk-test
|
||||
"pythag-triples-1-to-10"
|
||||
(let
|
||||
((triples (run* q (fresh (a b c a-sq b-sq sum c-sq) (ino a digits-1-10) (ino b digits-1-10) (ino c digits-1-10) (lteo-i a b) (*o-i a a a-sq) (*o-i b b b-sq) (*o-i c c c-sq) (pluso-i a-sq b-sq sum) (== sum c-sq) (== q (list a b c))))))
|
||||
(and
|
||||
(= (len triples) 2)
|
||||
(and
|
||||
(some
|
||||
(fn (t) (= t (list 3 4 5)))
|
||||
triples)
|
||||
(some
|
||||
(fn (t) (= t (list 6 8 10)))
|
||||
triples))))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
97
lib/minikanren/tests/queens-fd.sx
Normal file
97
lib/minikanren/tests/queens-fd.sx
Normal file
@@ -0,0 +1,97 @@
|
||||
;; lib/minikanren/tests/queens-fd.sx — N-queens via CLP(FD).
|
||||
;;
|
||||
;; Native FD propagation makes N-queens tractable: 4-queens finds both
|
||||
;; solutions instantly; 5-queens finds all 10 in seconds. Compare with
|
||||
;; the naive enumerate-then-filter version in queens.sx, which struggles
|
||||
;; past N=4.
|
||||
|
||||
(define
|
||||
fd-no-diag
|
||||
(fn
|
||||
(ci cj k)
|
||||
(fresh
|
||||
(a b)
|
||||
(fd-plus cj k a)
|
||||
(fd-plus ci k b)
|
||||
(fd-neq ci a)
|
||||
(fd-neq cj b))))
|
||||
|
||||
(define
|
||||
n-queens-4-fd
|
||||
(fn
|
||||
(cs)
|
||||
(let
|
||||
((c1 (nth cs 0))
|
||||
(c2 (nth cs 1))
|
||||
(c3 (nth cs 2))
|
||||
(c4 (nth cs 3)))
|
||||
(mk-conj
|
||||
(fd-in c1 (list 1 2 3 4))
|
||||
(fd-in c2 (list 1 2 3 4))
|
||||
(fd-in c3 (list 1 2 3 4))
|
||||
(fd-in c4 (list 1 2 3 4))
|
||||
(fd-distinct cs)
|
||||
(fd-no-diag c1 c2 1)
|
||||
(fd-no-diag c1 c3 2)
|
||||
(fd-no-diag c1 c4 3)
|
||||
(fd-no-diag c2 c3 1)
|
||||
(fd-no-diag c2 c4 2)
|
||||
(fd-no-diag c3 c4 1)
|
||||
(fd-label cs)))))
|
||||
|
||||
(define
|
||||
n-queens-5-fd
|
||||
(fn
|
||||
(cs)
|
||||
(let
|
||||
((c1 (nth cs 0))
|
||||
(c2 (nth cs 1))
|
||||
(c3 (nth cs 2))
|
||||
(c4 (nth cs 3))
|
||||
(c5 (nth cs 4)))
|
||||
(mk-conj
|
||||
(fd-in
|
||||
c1
|
||||
(list 1 2 3 4 5))
|
||||
(fd-in
|
||||
c2
|
||||
(list 1 2 3 4 5))
|
||||
(fd-in
|
||||
c3
|
||||
(list 1 2 3 4 5))
|
||||
(fd-in
|
||||
c4
|
||||
(list 1 2 3 4 5))
|
||||
(fd-in
|
||||
c5
|
||||
(list 1 2 3 4 5))
|
||||
(fd-distinct cs)
|
||||
(fd-no-diag c1 c2 1)
|
||||
(fd-no-diag c1 c3 2)
|
||||
(fd-no-diag c1 c4 3)
|
||||
(fd-no-diag c1 c5 4)
|
||||
(fd-no-diag c2 c3 1)
|
||||
(fd-no-diag c2 c4 2)
|
||||
(fd-no-diag c2 c5 3)
|
||||
(fd-no-diag c3 c4 1)
|
||||
(fd-no-diag c3 c5 2)
|
||||
(fd-no-diag c4 c5 1)
|
||||
(fd-label cs)))))
|
||||
|
||||
(mk-test
|
||||
"n-queens-4-fd-two-solutions"
|
||||
(run*
|
||||
q
|
||||
(fresh (a b c d) (== q (list a b c d)) (n-queens-4-fd (list a b c d))))
|
||||
(list
|
||||
(list 2 4 1 3)
|
||||
(list 3 1 4 2)))
|
||||
|
||||
(mk-test
|
||||
"n-queens-5-fd-ten-solutions"
|
||||
(let
|
||||
((sols (run* q (fresh (a b c d e) (== q (list a b c d e)) (n-queens-5-fd (list a b c d e))))))
|
||||
(= (len sols) 10))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
45
lib/minikanren/tests/queens.sx
Normal file
45
lib/minikanren/tests/queens.sx
Normal file
@@ -0,0 +1,45 @@
|
||||
;; lib/minikanren/tests/queens.sx — N-queens, the classic miniKanren benchmark.
|
||||
|
||||
;; --- safe-diag (helper) ---
|
||||
|
||||
(mk-test
|
||||
"safe-diag-different-cols-different-distance"
|
||||
(run* q (safe-diag 1 4 2))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"safe-diag-same-distance-fails"
|
||||
(run* q (safe-diag 1 4 3))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"safe-diag-same-distance-other-direction-fails"
|
||||
(run* q (safe-diag 4 1 3))
|
||||
(list))
|
||||
|
||||
;; --- ino-each / range ---
|
||||
|
||||
(mk-test
|
||||
"range-1-to-4"
|
||||
(range-1-to-n 4)
|
||||
(list 1 2 3 4))
|
||||
(mk-test "range-empty" (range-1-to-n 0) (list))
|
||||
|
||||
;; --- 4-queens: two solutions ---
|
||||
|
||||
(mk-test
|
||||
"queens-4"
|
||||
(let
|
||||
((sols (run* q (fresh (a b c d) (== q (list a b c d)) (queens-cols (list a b c d) 4)))))
|
||||
(and
|
||||
(= (len sols) 2)
|
||||
(and
|
||||
(some
|
||||
(fn (s) (= s (list 2 4 1 3)))
|
||||
sols)
|
||||
(some
|
||||
(fn (s) (= s (list 3 1 4 2)))
|
||||
sols))))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
90
lib/minikanren/tests/rdb.sx
Normal file
90
lib/minikanren/tests/rdb.sx
Normal file
@@ -0,0 +1,90 @@
|
||||
;; lib/minikanren/tests/rdb.sx — relational database queries.
|
||||
;;
|
||||
;; Demonstrates how miniKanren can serve as a Datalog-style query engine
|
||||
;; over fact tables. Tables are SX lists of tuples; the relation just
|
||||
;; wraps `membero` over the table.
|
||||
|
||||
(define
|
||||
rdb-employees
|
||||
(list
|
||||
(list "alice" "engineering" 100000)
|
||||
(list "bob" "marketing" 80000)
|
||||
(list "carol" "engineering" 90000)
|
||||
(list "dave" "engineering" 85000)
|
||||
(list "eve" "sales" 75000)))
|
||||
|
||||
(define
|
||||
rdb-projects
|
||||
(list
|
||||
(list "alice" "compiler")
|
||||
(list "carol" "compiler")
|
||||
(list "dave" "runtime")
|
||||
(list "alice" "runtime")
|
||||
(list "eve" "outreach")))
|
||||
|
||||
;; Relation views over the tables.
|
||||
|
||||
(define
|
||||
employees
|
||||
(fn (name dept salary) (membero (list name dept salary) rdb-employees)))
|
||||
|
||||
(define
|
||||
on-project
|
||||
(fn (name project) (membero (list name project) rdb-projects)))
|
||||
|
||||
;; --- queries ---
|
||||
|
||||
(mk-test
|
||||
"rdb-engineering-staff"
|
||||
(let
|
||||
((res (run* q (fresh (n s) (employees n "engineering" s) (== q n)))))
|
||||
(and
|
||||
(= (len res) 3)
|
||||
(and
|
||||
(some (fn (n) (= n "alice")) res)
|
||||
(and
|
||||
(some (fn (n) (= n "carol")) res)
|
||||
(some (fn (n) (= n "dave")) res)))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"rdb-high-salary"
|
||||
(let
|
||||
((res (run* q (fresh (n d s) (employees n d s) (lto-i 85000 s) (== q (list n s))))))
|
||||
(and
|
||||
(= (len res) 2)
|
||||
(and
|
||||
(some (fn (r) (= r (list "alice" 100000))) res)
|
||||
(some (fn (r) (= r (list "carol" 90000))) res))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"rdb-join-employee-project"
|
||||
(let
|
||||
((res (run* q (fresh (n d s) (employees n d s) (on-project n "compiler") (== q n)))))
|
||||
(and
|
||||
(= (len res) 2)
|
||||
(and
|
||||
(some (fn (n) (= n "alice")) res)
|
||||
(some (fn (n) (= n "carol")) res))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"rdb-engineers-on-runtime"
|
||||
(let
|
||||
((res (run* q (fresh (n s) (employees n "engineering" s) (on-project n "runtime") (== q n)))))
|
||||
(and
|
||||
(= (len res) 2)
|
||||
(and
|
||||
(some (fn (n) (= n "alice")) res)
|
||||
(some (fn (n) (= n "dave")) res))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"rdb-people-on-multiple-projects"
|
||||
(let
|
||||
((res (run* q (fresh (n p1 p2) (on-project n p1) (on-project n p2) (nafc (== p1 p2)) (== q n)))))
|
||||
(some (fn (n) (= n "alice")) res))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
291
lib/minikanren/tests/relations.sx
Normal file
291
lib/minikanren/tests/relations.sx
Normal file
@@ -0,0 +1,291 @@
|
||||
;; lib/minikanren/tests/relations.sx — Phase 4 standard relations.
|
||||
;;
|
||||
;; Includes the classic miniKanren canaries: appendo forwards / backwards /
|
||||
;; bidirectionally, membero, listo enumeration.
|
||||
|
||||
;; --- nullo / pairo ---
|
||||
|
||||
(mk-test
|
||||
"nullo-empty-succeeds"
|
||||
(run* q (nullo (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test "nullo-non-empty-fails" (run* q (nullo (list 1))) (list))
|
||||
|
||||
(mk-test
|
||||
"pairo-non-empty-succeeds"
|
||||
(run* q (pairo (list 1 2)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test "pairo-empty-fails" (run* q (pairo (list))) (list))
|
||||
|
||||
;; --- caro / cdro / firsto / resto ---
|
||||
|
||||
(mk-test
|
||||
"caro-extracts-head"
|
||||
(run* q (caro (list 1 2 3) q))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"cdro-extracts-tail"
|
||||
(run* q (cdro (list 1 2 3) q))
|
||||
(list (list 2 3)))
|
||||
|
||||
(mk-test
|
||||
"firsto-alias-of-caro"
|
||||
(run* q (firsto (list 10 20) q))
|
||||
(list 10))
|
||||
|
||||
(mk-test
|
||||
"resto-alias-of-cdro"
|
||||
(run* q (resto (list 10 20) q))
|
||||
(list (list 20)))
|
||||
|
||||
(mk-test
|
||||
"caro-cdro-build"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(h t)
|
||||
(caro (list 1 2 3) h)
|
||||
(cdro (list 1 2 3) t)
|
||||
(== q (list h t))))
|
||||
(list (list 1 (list 2 3))))
|
||||
|
||||
;; --- conso ---
|
||||
|
||||
(mk-test
|
||||
"conso-forward"
|
||||
(run* q (conso 0 (list 1 2 3) q))
|
||||
(list (list 0 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"conso-extract-head"
|
||||
(run*
|
||||
q
|
||||
(conso
|
||||
q
|
||||
(list 2 3)
|
||||
(list 1 2 3)))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"conso-extract-tail"
|
||||
(run* q (conso 1 q (list 1 2 3)))
|
||||
(list (list 2 3)))
|
||||
|
||||
;; --- listo ---
|
||||
|
||||
(mk-test
|
||||
"listo-empty-succeeds"
|
||||
(run* q (listo (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"listo-finite-list-succeeds"
|
||||
(run* q (listo (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"listo-enumerates-shapes"
|
||||
(run 3 q (listo q))
|
||||
(list
|
||||
(list)
|
||||
(list (make-symbol "_.0"))
|
||||
(list (make-symbol "_.0") (make-symbol "_.1"))))
|
||||
|
||||
;; --- appendo: the canary ---
|
||||
|
||||
(mk-test
|
||||
"appendo-forward-simple"
|
||||
(run*
|
||||
q
|
||||
(appendo (list 1 2) (list 3 4) q))
|
||||
(list (list 1 2 3 4)))
|
||||
|
||||
(mk-test
|
||||
"appendo-forward-empty-l"
|
||||
(run* q (appendo (list) (list 3 4) q))
|
||||
(list (list 3 4)))
|
||||
|
||||
(mk-test
|
||||
"appendo-forward-empty-s"
|
||||
(run* q (appendo (list 1 2) (list) q))
|
||||
(list (list 1 2)))
|
||||
|
||||
(mk-test
|
||||
"appendo-recovers-tail"
|
||||
(run*
|
||||
q
|
||||
(appendo
|
||||
(list 1 2)
|
||||
q
|
||||
(list 1 2 3 4)))
|
||||
(list (list 3 4)))
|
||||
|
||||
(mk-test
|
||||
"appendo-recovers-prefix"
|
||||
(run*
|
||||
q
|
||||
(appendo
|
||||
q
|
||||
(list 3 4)
|
||||
(list 1 2 3 4)))
|
||||
(list (list 1 2)))
|
||||
|
||||
(mk-test
|
||||
"appendo-backward-all-splits"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(l s)
|
||||
(appendo l s (list 1 2 3))
|
||||
(== q (list l s))))
|
||||
(list
|
||||
(list (list) (list 1 2 3))
|
||||
(list (list 1) (list 2 3))
|
||||
(list (list 1 2) (list 3))
|
||||
(list (list 1 2 3) (list))))
|
||||
|
||||
(mk-test
|
||||
"appendo-empty-empty-empty"
|
||||
(run* q (appendo (list) (list) q))
|
||||
(list (list)))
|
||||
|
||||
;; --- membero ---
|
||||
|
||||
(mk-test
|
||||
"membero-element-present"
|
||||
(run
|
||||
1
|
||||
q
|
||||
(membero 2 (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"membero-element-absent-empty"
|
||||
(run* q (membero 99 (list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"membero-enumerates"
|
||||
(run* q (membero q (list "a" "b" "c")))
|
||||
(list "a" "b" "c"))
|
||||
|
||||
;; --- reverseo ---
|
||||
|
||||
(mk-test
|
||||
"reverseo-forward"
|
||||
(run* q (reverseo (list 1 2 3) q))
|
||||
(list (list 3 2 1)))
|
||||
|
||||
(mk-test "reverseo-empty" (run* q (reverseo (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"reverseo-singleton"
|
||||
(run* q (reverseo (list 42) q))
|
||||
(list (list 42)))
|
||||
|
||||
(mk-test
|
||||
"reverseo-five"
|
||||
(run*
|
||||
q
|
||||
(reverseo (list 1 2 3 4 5) q))
|
||||
(list (list 5 4 3 2 1)))
|
||||
|
||||
(mk-test
|
||||
"reverseo-backward-one"
|
||||
(run 1 q (reverseo q (list 1 2 3)))
|
||||
(list (list 3 2 1)))
|
||||
|
||||
(mk-test
|
||||
"reverseo-round-trip"
|
||||
(run*
|
||||
q
|
||||
(fresh (mid) (reverseo (list "a" "b" "c") mid) (reverseo mid q)))
|
||||
(list (list "a" "b" "c")))
|
||||
|
||||
;; --- lengtho (Peano-style) ---
|
||||
|
||||
(mk-test "lengtho-empty-is-z" (run* q (lengtho (list) q)) (list :z))
|
||||
|
||||
(mk-test
|
||||
"lengtho-of-3"
|
||||
(run* q (lengtho (list "a" "b" "c") q))
|
||||
(list (list :s (list :s (list :s :z)))))
|
||||
|
||||
(mk-test
|
||||
"lengtho-empty-from-zero"
|
||||
(run 1 q (lengtho q :z))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"lengtho-enumerates-of-length-2"
|
||||
(run 1 q (lengtho q (list :s (list :s :z))))
|
||||
(list (list (make-symbol "_.0") (make-symbol "_.1"))))
|
||||
|
||||
;; --- inserto ---
|
||||
|
||||
(mk-test
|
||||
"inserto-front"
|
||||
(run* q (inserto 0 (list 1 2 3) q))
|
||||
(list
|
||||
(list 0 1 2 3)
|
||||
(list 1 0 2 3)
|
||||
(list 1 2 0 3)
|
||||
(list 1 2 3 0)))
|
||||
|
||||
(mk-test
|
||||
"inserto-empty"
|
||||
(run* q (inserto 0 (list) q))
|
||||
(list (list 0)))
|
||||
|
||||
;; --- permuteo ---
|
||||
|
||||
(mk-test "permuteo-empty" (run* q (permuteo (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"permuteo-singleton"
|
||||
(run* q (permuteo (list 42) q))
|
||||
(list (list 42)))
|
||||
|
||||
(mk-test
|
||||
"permuteo-two"
|
||||
(run* q (permuteo (list 1 2) q))
|
||||
(list (list 1 2) (list 2 1)))
|
||||
|
||||
(mk-test
|
||||
"permuteo-three-as-set"
|
||||
(let
|
||||
((perms (run* q (permuteo (list 1 2 3) q))))
|
||||
(and
|
||||
(= (len perms) 6)
|
||||
(and
|
||||
(some (fn (p) (= p (list 1 2 3))) perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 2 1 3)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 1 3 2)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 2 3 1)))
|
||||
perms)
|
||||
(and
|
||||
(some
|
||||
(fn (p) (= p (list 3 1 2)))
|
||||
perms)
|
||||
(some
|
||||
(fn (p) (= p (list 3 2 1)))
|
||||
perms))))))))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"permuteo-backward-finds-input"
|
||||
(run 1 q (permuteo q (list "a" "b" "c")))
|
||||
(list (list "a" "b" "c")))
|
||||
|
||||
(mk-tests-run!)
|
||||
39
lib/minikanren/tests/removeo-allo.sx
Normal file
39
lib/minikanren/tests/removeo-allo.sx
Normal file
@@ -0,0 +1,39 @@
|
||||
;; lib/minikanren/tests/removeo-allo.sx — remove every occurrence of x.
|
||||
|
||||
(mk-test
|
||||
"removeo-allo-multi"
|
||||
(run*
|
||||
q
|
||||
(removeo-allo
|
||||
2
|
||||
(list 1 2 3 2 4 2)
|
||||
q))
|
||||
(list (list 1 3 4)))
|
||||
|
||||
(mk-test
|
||||
"removeo-allo-single"
|
||||
(run*
|
||||
q
|
||||
(removeo-allo 2 (list 1 2 3) q))
|
||||
(list (list 1 3)))
|
||||
|
||||
(mk-test
|
||||
"removeo-allo-no-match"
|
||||
(run*
|
||||
q
|
||||
(removeo-allo 99 (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"removeo-allo-everything"
|
||||
(run*
|
||||
q
|
||||
(removeo-allo 1 (list 1 1 1) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"removeo-allo-empty"
|
||||
(run* q (removeo-allo 1 (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-tests-run!)
|
||||
69
lib/minikanren/tests/repeato-concato.sx
Normal file
69
lib/minikanren/tests/repeato-concato.sx
Normal file
@@ -0,0 +1,69 @@
|
||||
;; lib/minikanren/tests/repeato-concato.sx — repeat element n times +
|
||||
;; concatenate a list of lists.
|
||||
|
||||
(define
|
||||
mk-nat
|
||||
(fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
|
||||
|
||||
;; --- repeato ---
|
||||
|
||||
(mk-test
|
||||
"repeato-zero"
|
||||
(run* q (repeato :a (mk-nat 0) q))
|
||||
(list (list)))
|
||||
(mk-test
|
||||
"repeato-one"
|
||||
(run* q (repeato :a (mk-nat 1) q))
|
||||
(list (list :a)))
|
||||
(mk-test
|
||||
"repeato-three"
|
||||
(run* q (repeato :a (mk-nat 3) q))
|
||||
(list (list :a :a :a)))
|
||||
|
||||
(mk-test
|
||||
"repeato-numeric"
|
||||
(run* q (repeato 7 (mk-nat 4) q))
|
||||
(list (list 7 7 7 7)))
|
||||
|
||||
(mk-test
|
||||
"repeato-recover-count"
|
||||
(run* q (repeato :x q (list :x :x :x :x)))
|
||||
(list (mk-nat 4)))
|
||||
|
||||
;; --- concato ---
|
||||
|
||||
(mk-test "concato-empty" (run* q (concato (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"concato-single"
|
||||
(run* q (concato (list (list 1 2 3)) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"concato-multi"
|
||||
(run*
|
||||
q
|
||||
(concato
|
||||
(list
|
||||
(list 1 2)
|
||||
(list 3)
|
||||
(list 4 5 6))
|
||||
q))
|
||||
(list
|
||||
(list 1 2 3 4 5 6)))
|
||||
|
||||
(mk-test
|
||||
"concato-all-empty"
|
||||
(run* q (concato (list (list) (list) (list)) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"concato-mixed-empty"
|
||||
(run*
|
||||
q
|
||||
(concato
|
||||
(list (list 1) (list) (list 2 3))
|
||||
q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
46
lib/minikanren/tests/rev-acco.sx
Normal file
46
lib/minikanren/tests/rev-acco.sx
Normal file
@@ -0,0 +1,46 @@
|
||||
;; lib/minikanren/tests/rev-acco.sx — accumulator-style reverse.
|
||||
;;
|
||||
;; Faster than reverseo for forward queries (no quadratic appendos).
|
||||
;; Trade-off: rev-acco is asymmetric (acc=initial-empty for the public
|
||||
;; interface), so it does not cleanly run backwards in run* the way
|
||||
;; reverseo does.
|
||||
|
||||
(mk-test "rev-2o-empty" (run* q (rev-2o (list) q)) (list (list)))
|
||||
|
||||
(mk-test
|
||||
"rev-2o-singleton"
|
||||
(run* q (rev-2o (list 7) q))
|
||||
(list (list 7)))
|
||||
|
||||
(mk-test
|
||||
"rev-2o-three"
|
||||
(run* q (rev-2o (list 1 2 3) q))
|
||||
(list (list 3 2 1)))
|
||||
|
||||
(mk-test
|
||||
"rev-2o-five"
|
||||
(run*
|
||||
q
|
||||
(rev-2o (list 1 2 3 4 5) q))
|
||||
(list (list 5 4 3 2 1)))
|
||||
|
||||
(mk-test
|
||||
"rev-2o-strings"
|
||||
(run* q (rev-2o (list "a" "b" "c") q))
|
||||
(list (list "c" "b" "a")))
|
||||
|
||||
(mk-test
|
||||
"rev-2o-reverseo-agree"
|
||||
(let
|
||||
((via-reverseo (first (run* q (reverseo (list 1 2 3 4 5) q))))
|
||||
(via-rev-2o
|
||||
(first
|
||||
(run*
|
||||
q
|
||||
(rev-2o
|
||||
(list 1 2 3 4 5)
|
||||
q)))))
|
||||
(= via-reverseo via-rev-2o))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
114
lib/minikanren/tests/run.sx
Normal file
114
lib/minikanren/tests/run.sx
Normal file
@@ -0,0 +1,114 @@
|
||||
;; lib/minikanren/tests/run.sx — Phase 3 tests for run* / run / reify.
|
||||
|
||||
;; --- canonical TRS one-liners ---
|
||||
|
||||
(mk-test "run*-eq-one" (run* q (== q 1)) (list 1))
|
||||
(mk-test "run*-eq-string" (run* q (== q "hello")) (list "hello"))
|
||||
(mk-test "run*-eq-symbol" (run* q (== q (quote sym))) (list (quote sym)))
|
||||
(mk-test "run*-fail-empty" (run* q (== 1 2)) (list))
|
||||
|
||||
;; --- run with a count ---
|
||||
|
||||
(mk-test
|
||||
"run-3-of-many"
|
||||
(run
|
||||
3
|
||||
q
|
||||
(conde
|
||||
((== q 1))
|
||||
((== q 2))
|
||||
((== q 3))
|
||||
((== q 4))
|
||||
((== q 5))))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test "run-zero-empty" (run 0 q (== q 1)) (list))
|
||||
|
||||
(mk-test
|
||||
"run-1-takes-one"
|
||||
(run 1 q (conde ((== q "a")) ((== q "b"))))
|
||||
(list "a"))
|
||||
|
||||
;; --- reification: unbound vars get _.N left-to-right ---
|
||||
|
||||
(mk-test
|
||||
"reify-single-unbound"
|
||||
(run* q (fresh (x) (== q x)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"reify-pair-unbound"
|
||||
(run* q (fresh (x y) (== q (list x y))))
|
||||
(list (list (make-symbol "_.0") (make-symbol "_.1"))))
|
||||
|
||||
(mk-test
|
||||
"reify-mixed-bound-unbound"
|
||||
(run* q (fresh (x y) (== q (list 1 x 2 y))))
|
||||
(list
|
||||
(list 1 (make-symbol "_.0") 2 (make-symbol "_.1"))))
|
||||
|
||||
(mk-test
|
||||
"reify-shared-unbound-same-name"
|
||||
(run* q (fresh (x) (== q (list x x))))
|
||||
(list (list (make-symbol "_.0") (make-symbol "_.0"))))
|
||||
|
||||
(mk-test
|
||||
"reify-distinct-unbound-distinct-names"
|
||||
(run* q (fresh (x y) (== q (list x y x y))))
|
||||
(list
|
||||
(list
|
||||
(make-symbol "_.0")
|
||||
(make-symbol "_.1")
|
||||
(make-symbol "_.0")
|
||||
(make-symbol "_.1"))))
|
||||
|
||||
;; --- conde + run* ---
|
||||
|
||||
(mk-test
|
||||
"run*-conde-three"
|
||||
(run*
|
||||
q
|
||||
(conde ((== q 1)) ((== q 2)) ((== q 3))))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"run*-conde-fresh-mix"
|
||||
(run*
|
||||
q
|
||||
(conde ((fresh (x) (== q (list 1 x)))) ((== q "ground"))))
|
||||
(list (list 1 (make-symbol "_.0")) "ground"))
|
||||
|
||||
;; --- run* + conjunction ---
|
||||
|
||||
(mk-test
|
||||
"run*-conj-binds-q"
|
||||
(run* q (fresh (x) (== x 5) (== q (list x x))))
|
||||
(list (list 5 5)))
|
||||
|
||||
;; --- run* + condu ---
|
||||
|
||||
(mk-test
|
||||
"run*-condu-first-wins"
|
||||
(run* q (condu ((== q 1)) ((== q 2))))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"run*-onceo-trim"
|
||||
(run* q (onceo (conde ((== q "a")) ((== q "b")))))
|
||||
(list "a"))
|
||||
|
||||
;; --- multi-goal run ---
|
||||
|
||||
(mk-test
|
||||
"run*-three-goals"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x y z)
|
||||
(== x 1)
|
||||
(== y 2)
|
||||
(== z 3)
|
||||
(== q (list x y z))))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-tests-run!)
|
||||
46
lib/minikanren/tests/selecto.sx
Normal file
46
lib/minikanren/tests/selecto.sx
Normal file
@@ -0,0 +1,46 @@
|
||||
;; lib/minikanren/tests/selecto.sx — choose an element + rest of list.
|
||||
|
||||
(mk-test
|
||||
"selecto-enumerate"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x r)
|
||||
(selecto x r (list 1 2 3))
|
||||
(== q (list x r))))
|
||||
(list
|
||||
(list 1 (list 2 3))
|
||||
(list 2 (list 1 3))
|
||||
(list 3 (list 1 2))))
|
||||
|
||||
(mk-test
|
||||
"selecto-find-rest"
|
||||
(run* q (selecto 2 q (list 1 2 3)))
|
||||
(list (list 1 3)))
|
||||
|
||||
(mk-test
|
||||
"selecto-find-element"
|
||||
(run*
|
||||
q
|
||||
(selecto
|
||||
q
|
||||
(list 1 3)
|
||||
(list 1 2 3)))
|
||||
(list 2))
|
||||
|
||||
(mk-test
|
||||
"selecto-element-not-present-fails"
|
||||
(run* q (selecto 99 q (list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"selecto-empty-list-fails"
|
||||
(run* q (selecto q (list) (list)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"selecto-singleton"
|
||||
(run* q (fresh (x r) (selecto x r (list :only)) (== q (list x r))))
|
||||
(list (list :only (list))))
|
||||
|
||||
(mk-tests-run!)
|
||||
47
lib/minikanren/tests/simplifyo.sx
Normal file
47
lib/minikanren/tests/simplifyo.sx
Normal file
@@ -0,0 +1,47 @@
|
||||
;; lib/minikanren/tests/simplifyo.sx — algebraic expression simplifier
|
||||
;; demo using conda for first-match-wins dispatch.
|
||||
|
||||
(define
|
||||
simplify-step-o
|
||||
(fn
|
||||
(expr result)
|
||||
(conda
|
||||
((fresh (x) (== expr (list :+ 0 x)) (== result x)))
|
||||
((fresh (x) (== expr (list :+ x 0)) (== result x)))
|
||||
((fresh (y) (== expr (list :* 0 y)) (== result 0)))
|
||||
((fresh (x) (== expr (list :* x 0)) (== result 0)))
|
||||
((fresh (x) (== expr (list :* 1 x)) (== result x)))
|
||||
((fresh (x) (== expr (list :* x 1)) (== result x)))
|
||||
((== result expr))))) ;; default: unchanged
|
||||
|
||||
(mk-test
|
||||
"simplify-zero-plus"
|
||||
(run* q (simplify-step-o (list :+ 0 :y) q))
|
||||
(list :y))
|
||||
|
||||
(mk-test
|
||||
"simplify-plus-zero"
|
||||
(run* q (simplify-step-o (list :+ :x 0) q))
|
||||
(list :x))
|
||||
|
||||
(mk-test
|
||||
"simplify-zero-times"
|
||||
(run* q (simplify-step-o (list :* 0 :y) q))
|
||||
(list 0))
|
||||
|
||||
(mk-test
|
||||
"simplify-one-times"
|
||||
(run* q (simplify-step-o (list :* 1 :y) q))
|
||||
(list :y))
|
||||
|
||||
(mk-test
|
||||
"simplify-no-rule-applies"
|
||||
(run* q (simplify-step-o (list :+ :x :y) q))
|
||||
(list (list :+ :x :y)))
|
||||
|
||||
(mk-test
|
||||
"simplify-non-identity-form"
|
||||
(run* q (simplify-step-o (list :+ 5 7) q))
|
||||
(list (list :+ 5 7)))
|
||||
|
||||
(mk-tests-run!)
|
||||
40
lib/minikanren/tests/sortedo.sx
Normal file
40
lib/minikanren/tests/sortedo.sx
Normal file
@@ -0,0 +1,40 @@
|
||||
;; lib/minikanren/tests/sortedo.sx — checks list is non-decreasing.
|
||||
|
||||
(mk-test
|
||||
"sortedo-empty"
|
||||
(run* q (sortedo (list)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"sortedo-singleton"
|
||||
(run* q (sortedo (list 42)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"sortedo-ascending"
|
||||
(run* q (sortedo (list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"sortedo-with-equal-adjacent"
|
||||
(run*
|
||||
q
|
||||
(sortedo (list 1 1 2 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"sortedo-out-of-order-fails"
|
||||
(run* q (sortedo (list 1 3 2)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"sortedo-descending-fails"
|
||||
(run* q (sortedo (list 3 2 1)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"sortedo-pair-equal"
|
||||
(run* q (sortedo (list 5 5)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-tests-run!)
|
||||
60
lib/minikanren/tests/subo.sx
Normal file
60
lib/minikanren/tests/subo.sx
Normal file
@@ -0,0 +1,60 @@
|
||||
;; lib/minikanren/tests/subo.sx — contiguous-sublist relation.
|
||||
|
||||
(mk-test
|
||||
"subo-simple-found"
|
||||
(run*
|
||||
q
|
||||
(subo
|
||||
(list 2 3)
|
||||
(list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subo-not-contiguous-fails"
|
||||
(run*
|
||||
q
|
||||
(subo
|
||||
(list 2 4)
|
||||
(list 1 2 3 4)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"subo-full-list-found"
|
||||
(run*
|
||||
q
|
||||
(subo
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subo-empty-list-found"
|
||||
(let
|
||||
((res (run* q (subo (list) (list 1 2 3)))))
|
||||
(= (len res) 4))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"subo-prefix"
|
||||
(run*
|
||||
q
|
||||
(subo
|
||||
(list 1 2)
|
||||
(list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subo-suffix"
|
||||
(run*
|
||||
q
|
||||
(subo
|
||||
(list 3 4)
|
||||
(list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subo-strings"
|
||||
(run* q (subo (list "b" "c") (list "a" "b" "c" "d")))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-tests-run!)
|
||||
62
lib/minikanren/tests/subseto.sx
Normal file
62
lib/minikanren/tests/subseto.sx
Normal file
@@ -0,0 +1,62 @@
|
||||
;; lib/minikanren/tests/subseto.sx — every element of l1 is in l2.
|
||||
|
||||
(mk-test
|
||||
"subseto-empty"
|
||||
(run* q (subseto (list) (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subseto-singleton-yes"
|
||||
(run*
|
||||
q
|
||||
(subseto (list 2) (list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subseto-singleton-no"
|
||||
(run*
|
||||
q
|
||||
(subseto (list 99) (list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"subseto-multi-yes"
|
||||
(run
|
||||
1
|
||||
q
|
||||
(subseto
|
||||
(list 1 3)
|
||||
(list 1 2 3 4)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-test
|
||||
"subseto-multi-no"
|
||||
(run*
|
||||
q
|
||||
(subseto
|
||||
(list 1 99)
|
||||
(list 1 2 3)))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"subseto-equal-sets"
|
||||
(run
|
||||
1
|
||||
q
|
||||
(subseto
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
;; allow duplicates in l1 — each just needs membership in l2.
|
||||
(mk-test
|
||||
"subseto-duplicates-allowed"
|
||||
(run
|
||||
1
|
||||
q
|
||||
(subseto
|
||||
(list 1 1 2)
|
||||
(list 1 2 3)))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
(mk-tests-run!)
|
||||
44
lib/minikanren/tests/sum-product.sx
Normal file
44
lib/minikanren/tests/sum-product.sx
Normal file
@@ -0,0 +1,44 @@
|
||||
;; lib/minikanren/tests/sum-product.sx — fold list to integer.
|
||||
|
||||
(mk-test "sumo-empty" (run* q (sumo (list) q)) (list 0))
|
||||
(mk-test
|
||||
"sumo-1-to-5"
|
||||
(run*
|
||||
q
|
||||
(sumo (list 1 2 3 4 5) q))
|
||||
(list 15))
|
||||
(mk-test
|
||||
"sumo-zeros"
|
||||
(run* q (sumo (list 0 0 0) q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"sumo-negs"
|
||||
(run* q (sumo (list 5 -3 8) q))
|
||||
(list 10))
|
||||
|
||||
(mk-test "producto-empty" (run* q (producto (list) q)) (list 1))
|
||||
(mk-test
|
||||
"producto-1-to-4"
|
||||
(run* q (producto (list 1 2 3 4) q))
|
||||
(list 24))
|
||||
(mk-test
|
||||
"producto-with-0"
|
||||
(run* q (producto (list 5 0 7) q))
|
||||
(list 0))
|
||||
(mk-test
|
||||
"producto-of-1s"
|
||||
(run* q (producto (list 1 1 1) q))
|
||||
(list 1))
|
||||
|
||||
(mk-test
|
||||
"sum-product-pythagorean-square"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(s sq2)
|
||||
(sumo (list 3 4 5) s)
|
||||
(producto (list 3 3) sq2)
|
||||
(== q (list s sq2))))
|
||||
(list (list 12 9)))
|
||||
|
||||
(mk-tests-run!)
|
||||
32
lib/minikanren/tests/swap-firsto.sx
Normal file
32
lib/minikanren/tests/swap-firsto.sx
Normal file
@@ -0,0 +1,32 @@
|
||||
;; lib/minikanren/tests/swap-firsto.sx — swap first two elements.
|
||||
|
||||
(mk-test
|
||||
"swap-firsto-pair"
|
||||
(run* q (swap-firsto (list 1 2) q))
|
||||
(list (list 2 1)))
|
||||
|
||||
(mk-test
|
||||
"swap-firsto-with-tail"
|
||||
(run* q (swap-firsto (list 1 2 3 4) q))
|
||||
(list (list 2 1 3 4)))
|
||||
|
||||
(mk-test
|
||||
"swap-firsto-singleton-fails"
|
||||
(run* q (swap-firsto (list 1) q))
|
||||
(list))
|
||||
|
||||
(mk-test "swap-firsto-empty-fails" (run* q (swap-firsto (list) q)) (list))
|
||||
|
||||
(mk-test
|
||||
"swap-firsto-self-inverse"
|
||||
(run*
|
||||
q
|
||||
(fresh (mid) (swap-firsto (list :a :b :c :d) mid) (swap-firsto mid q)))
|
||||
(list (list :a :b :c :d)))
|
||||
|
||||
(mk-test
|
||||
"swap-firsto-backward"
|
||||
(run* q (swap-firsto q (list :y :x :z)))
|
||||
(list (list :x :y :z)))
|
||||
|
||||
(mk-tests-run!)
|
||||
55
lib/minikanren/tests/tabling-more.sx
Normal file
55
lib/minikanren/tests/tabling-more.sx
Normal file
@@ -0,0 +1,55 @@
|
||||
;; lib/minikanren/tests/tabling-more.sx — table-1 + table-3.
|
||||
|
||||
;; --- table-1 (predicate caching) ---
|
||||
|
||||
(define
|
||||
tab-in-list
|
||||
(table-1
|
||||
"in-list"
|
||||
(fn
|
||||
(x)
|
||||
(membero
|
||||
x
|
||||
(list 1 2 3 4 5)))))
|
||||
|
||||
(mk-tab-clear!)
|
||||
(mk-test
|
||||
"table-1-hit"
|
||||
(run* q (tab-in-list 3))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "table-1-miss-no" (run* q (tab-in-list 99)) (list))
|
||||
(mk-test
|
||||
"table-1-replay"
|
||||
(run* q (tab-in-list 3))
|
||||
(list (make-symbol "_.0")))
|
||||
|
||||
;; --- table-3 (Ackermann) ---
|
||||
|
||||
(define
|
||||
ack-o
|
||||
(table-3
|
||||
"ack"
|
||||
(fn
|
||||
(m n result)
|
||||
(conde
|
||||
((== m 0) (pluso-i n 1 result))
|
||||
((fresh (m-1) (lto-i 0 m) (== n 0) (minuso-i m 1 m-1) (ack-o m-1 1 result)))
|
||||
((fresh (m-1 n-1 inner) (lto-i 0 m) (lto-i 0 n) (minuso-i m 1 m-1) (minuso-i n 1 n-1) (ack-o m n-1 inner) (ack-o m-1 inner result)))))))
|
||||
|
||||
(mk-tab-clear!)
|
||||
(mk-test
|
||||
"ack-0-0"
|
||||
(run* q (ack-o 0 0 q))
|
||||
(list 1))
|
||||
(mk-tab-clear!)
|
||||
(mk-test
|
||||
"ack-2-3"
|
||||
(run* q (ack-o 2 3 q))
|
||||
(list 9))
|
||||
(mk-tab-clear!)
|
||||
(mk-test
|
||||
"ack-3-3"
|
||||
(run* q (ack-o 3 3 q))
|
||||
(list 61))
|
||||
|
||||
(mk-tests-run!)
|
||||
60
lib/minikanren/tests/tabling.sx
Normal file
60
lib/minikanren/tests/tabling.sx
Normal file
@@ -0,0 +1,60 @@
|
||||
;; lib/minikanren/tests/tabling.sx — Phase 7 piece A: naive memoization.
|
||||
|
||||
;; --- Fibonacci canary: tabled vs naive --
|
||||
|
||||
(define
|
||||
tab-fib-o
|
||||
(table-2
|
||||
"fib"
|
||||
(fn
|
||||
(n result)
|
||||
(conde
|
||||
((== n 0) (== result 0))
|
||||
((== n 1) (== result 1))
|
||||
((fresh (n-1 n-2 r-1 r-2) (lto-i 1 n) (minuso-i n 1 n-1) (minuso-i n 2 n-2) (tab-fib-o n-1 r-1) (tab-fib-o n-2 r-2) (pluso-i r-1 r-2 result)))))))
|
||||
|
||||
(mk-tab-clear!)
|
||||
|
||||
(mk-test "tab-fib-zero" (run* q (tab-fib-o 0 q)) (list 0))
|
||||
(mk-tab-clear!)
|
||||
(mk-test "tab-fib-one" (run* q (tab-fib-o 1 q)) (list 1))
|
||||
(mk-tab-clear!)
|
||||
(mk-test "tab-fib-two" (run* q (tab-fib-o 2 q)) (list 1))
|
||||
(mk-tab-clear!)
|
||||
(mk-test "tab-fib-five" (run* q (tab-fib-o 5 q)) (list 5))
|
||||
(mk-tab-clear!)
|
||||
(mk-test "tab-fib-ten" (run* q (tab-fib-o 10 q)) (list 55))
|
||||
(mk-tab-clear!)
|
||||
(mk-test
|
||||
"tab-fib-twenty"
|
||||
(run* q (tab-fib-o 20 q))
|
||||
(list 6765))
|
||||
|
||||
;; --- ground-term predicate ---
|
||||
|
||||
(mk-test "tab-ground-term-num" (mk-tab-ground-term? 5) true)
|
||||
(mk-test "tab-ground-term-str" (mk-tab-ground-term? "hi") true)
|
||||
(mk-test
|
||||
"tab-ground-term-list"
|
||||
(mk-tab-ground-term? (list 1 2 3))
|
||||
true)
|
||||
(mk-test "tab-ground-term-var" (mk-tab-ground-term? (mk-var "x")) false)
|
||||
(mk-test
|
||||
"tab-ground-term-nested"
|
||||
(mk-tab-ground-term?
|
||||
(list 1 (list 2 (mk-var "y")) 3))
|
||||
false)
|
||||
|
||||
;; --- caching reduces work — count cache hits via repeated query ---
|
||||
|
||||
(mk-test
|
||||
"tab-cache-replay"
|
||||
(begin
|
||||
(mk-tab-clear!)
|
||||
(let
|
||||
((first (run* q (tab-fib-o 10 q)))
|
||||
(second (run* q (tab-fib-o 10 q))))
|
||||
(and (= first (list 55)) (= second (list 55)))))
|
||||
true)
|
||||
|
||||
(mk-tests-run!)
|
||||
92
lib/minikanren/tests/take-drop.sx
Normal file
92
lib/minikanren/tests/take-drop.sx
Normal file
@@ -0,0 +1,92 @@
|
||||
;; lib/minikanren/tests/take-drop.sx — Peano-indexed prefix/suffix.
|
||||
|
||||
(define
|
||||
mk-nat
|
||||
(fn (n) (if (= n 0) :z (list :s (mk-nat (- n 1))))))
|
||||
|
||||
;; --- tako ---
|
||||
|
||||
(mk-test
|
||||
"tako-zero"
|
||||
(run*
|
||||
q
|
||||
(tako (mk-nat 0) (list 1 2 3) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"tako-two"
|
||||
(run*
|
||||
q
|
||||
(tako
|
||||
(mk-nat 2)
|
||||
(list 1 2 3 4 5)
|
||||
q))
|
||||
(list (list 1 2)))
|
||||
|
||||
(mk-test
|
||||
"tako-all"
|
||||
(run*
|
||||
q
|
||||
(tako (mk-nat 3) (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"tako-too-many"
|
||||
(run*
|
||||
q
|
||||
(tako (mk-nat 5) (list 1 2 3) q))
|
||||
(list))
|
||||
|
||||
;; --- dropo ---
|
||||
|
||||
(mk-test
|
||||
"dropo-zero"
|
||||
(run*
|
||||
q
|
||||
(dropo (mk-nat 0) (list 1 2 3) q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"dropo-two"
|
||||
(run*
|
||||
q
|
||||
(dropo
|
||||
(mk-nat 2)
|
||||
(list 1 2 3 4 5)
|
||||
q))
|
||||
(list (list 3 4 5)))
|
||||
|
||||
(mk-test
|
||||
"dropo-all"
|
||||
(run*
|
||||
q
|
||||
(dropo (mk-nat 3) (list 1 2 3) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"dropo-too-many"
|
||||
(run*
|
||||
q
|
||||
(dropo (mk-nat 5) (list 1 2 3) q))
|
||||
(list))
|
||||
|
||||
;; --- take + drop round-trip ---
|
||||
|
||||
(mk-test
|
||||
"tako-dropo-roundtrip"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(p s)
|
||||
(tako
|
||||
(mk-nat 2)
|
||||
(list 1 2 3 4 5)
|
||||
p)
|
||||
(dropo
|
||||
(mk-nat 2)
|
||||
(list 1 2 3 4 5)
|
||||
s)
|
||||
(appendo p s q)))
|
||||
(list (list 1 2 3 4 5)))
|
||||
|
||||
(mk-tests-run!)
|
||||
80
lib/minikanren/tests/take-while-drop-while.sx
Normal file
80
lib/minikanren/tests/take-while-drop-while.sx
Normal file
@@ -0,0 +1,80 @@
|
||||
;; lib/minikanren/tests/take-while-drop-while.sx — prefix/suffix by predicate.
|
||||
|
||||
(mk-test
|
||||
"take-while-o-empty"
|
||||
(run* q (take-while-o (fn (x) (== x 1)) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"take-while-o-while-lt-5"
|
||||
(run*
|
||||
q
|
||||
(take-while-o
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 3 7 2 9)
|
||||
q))
|
||||
(list (list 1 3)))
|
||||
|
||||
(mk-test
|
||||
"take-while-o-all-match"
|
||||
(run*
|
||||
q
|
||||
(take-while-o
|
||||
(fn (x) (lto-i x 100))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list (list 1 2 3)))
|
||||
|
||||
(mk-test
|
||||
"take-while-o-none-match"
|
||||
(run*
|
||||
q
|
||||
(take-while-o
|
||||
(fn (x) (lto-i 100 x))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"drop-while-o-empty"
|
||||
(run* q (drop-while-o (fn (x) (== x 1)) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"drop-while-o-while-lt-5"
|
||||
(run*
|
||||
q
|
||||
(drop-while-o
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 3 7 2 9)
|
||||
q))
|
||||
(list (list 7 2 9)))
|
||||
|
||||
(mk-test
|
||||
"drop-while-o-all-match"
|
||||
(run*
|
||||
q
|
||||
(drop-while-o
|
||||
(fn (x) (lto-i x 100))
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"take-drop-roundtrip"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(p s)
|
||||
(take-while-o
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 3 7 2 9)
|
||||
p)
|
||||
(drop-while-o
|
||||
(fn (x) (lto-i x 5))
|
||||
(list 1 3 7 2 9)
|
||||
s)
|
||||
(appendo p s q)))
|
||||
(list (list 1 3 7 2 9)))
|
||||
|
||||
(mk-tests-run!)
|
||||
52
lib/minikanren/tests/types.sx
Normal file
52
lib/minikanren/tests/types.sx
Normal file
@@ -0,0 +1,52 @@
|
||||
;; lib/minikanren/tests/types.sx — type-predicate goals.
|
||||
|
||||
(mk-test
|
||||
"numbero-on-int"
|
||||
(run* q (numbero 5))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "numbero-on-string" (run* q (numbero "5")) (list))
|
||||
(mk-test "numbero-on-symbol" (run* q (numbero (quote x))) (list))
|
||||
(mk-test "numbero-on-list" (run* q (numbero (list 1))) (list))
|
||||
|
||||
(mk-test
|
||||
"stringo-on-string"
|
||||
(run* q (stringo "hi"))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "stringo-on-int" (run* q (stringo 5)) (list))
|
||||
(mk-test
|
||||
"stringo-on-keyword"
|
||||
(run* q (stringo :k))
|
||||
(list (make-symbol "_.0"))) ;; SX keywords ARE strings
|
||||
|
||||
(mk-test
|
||||
"symbolo-on-symbol"
|
||||
(run* q (symbolo (quote x)))
|
||||
(list (make-symbol "_.0")))
|
||||
(mk-test "symbolo-on-string" (run* q (symbolo "x")) (list))
|
||||
(mk-test "symbolo-on-int" (run* q (symbolo 5)) (list))
|
||||
|
||||
;; --- combine with membero for type-filtered enumeration ---
|
||||
|
||||
(mk-test
|
||||
"membero-numbero-filter"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(membero x (list 1 "a" 2 "b" 3))
|
||||
(numbero x)
|
||||
(== q x)))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"membero-stringo-filter"
|
||||
(run*
|
||||
q
|
||||
(fresh
|
||||
(x)
|
||||
(membero x (list 1 "a" 2 "b" 3))
|
||||
(stringo x)
|
||||
(== q x)))
|
||||
(list "a" "b"))
|
||||
|
||||
(mk-tests-run!)
|
||||
293
lib/minikanren/tests/unify.sx
Normal file
293
lib/minikanren/tests/unify.sx
Normal file
@@ -0,0 +1,293 @@
|
||||
;; lib/minikanren/tests/unify.sx — Phase 1 tests for unify.sx.
|
||||
;;
|
||||
;; Loads into a session that already has lib/guest/match.sx and
|
||||
;; lib/minikanren/unify.sx defined. Tests are top-level forms.
|
||||
;; Call (mk-tests-run!) afterwards to get the totals.
|
||||
;;
|
||||
;; Note: SX dict equality is reference-based, so tests check the *effect*
|
||||
;; of a unification (success/failure flag, or walked bindings) rather than
|
||||
;; the raw substitution dict.
|
||||
|
||||
(define mk-test-pass 0)
|
||||
(define mk-test-fail 0)
|
||||
(define mk-test-fails (list))
|
||||
|
||||
(define
|
||||
mk-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! mk-test-pass (+ mk-test-pass 1))
|
||||
(begin
|
||||
(set! mk-test-fail (+ mk-test-fail 1))
|
||||
(append! mk-test-fails {:name name :expected expected :actual actual})))))
|
||||
|
||||
(define mk-tests-run! (fn () {:total (+ mk-test-pass mk-test-fail) :passed mk-test-pass :failed mk-test-fail :fails mk-test-fails}))
|
||||
|
||||
(define mk-unified? (fn (s) (if (= s nil) false true)))
|
||||
|
||||
;; --- fresh variable construction ---
|
||||
|
||||
(mk-test
|
||||
"make-var-distinct"
|
||||
(let ((a (make-var)) (b (make-var))) (= (var-name a) (var-name b)))
|
||||
false)
|
||||
|
||||
(mk-test "make-var-is-var" (mk-var? (make-var)) true)
|
||||
(mk-test "var?-num" (mk-var? 5) false)
|
||||
(mk-test "var?-list" (mk-var? (list 1 2)) false)
|
||||
(mk-test "var?-string" (mk-var? "hi") false)
|
||||
(mk-test "var?-empty" (mk-var? (list)) false)
|
||||
(mk-test "var?-bool" (mk-var? true) false)
|
||||
|
||||
;; --- empty substitution ---
|
||||
|
||||
(mk-test "empty-s-walk-num" (mk-walk 5 empty-s) 5)
|
||||
(mk-test "empty-s-walk-str" (mk-walk "x" empty-s) "x")
|
||||
(mk-test
|
||||
"empty-s-walk-list"
|
||||
(mk-walk (list 1 2) empty-s)
|
||||
(list 1 2))
|
||||
(mk-test
|
||||
"empty-s-walk-unbound-var"
|
||||
(let ((x (make-var))) (= (mk-walk x empty-s) x))
|
||||
true)
|
||||
|
||||
;; --- walk: top-level chain resolution ---
|
||||
|
||||
(mk-test
|
||||
"walk-direct-binding"
|
||||
(mk-walk (mk-var "x") (extend "x" 7 empty-s))
|
||||
7)
|
||||
|
||||
(mk-test
|
||||
"walk-two-step-chain"
|
||||
(mk-walk
|
||||
(mk-var "x")
|
||||
(extend "x" (mk-var "y") (extend "y" 9 empty-s)))
|
||||
9)
|
||||
|
||||
(mk-test
|
||||
"walk-three-step-chain"
|
||||
(mk-walk
|
||||
(mk-var "a")
|
||||
(extend
|
||||
"a"
|
||||
(mk-var "b")
|
||||
(extend "b" (mk-var "c") (extend "c" 42 empty-s))))
|
||||
42)
|
||||
|
||||
(mk-test
|
||||
"walk-stops-at-list"
|
||||
(mk-walk (list 1 (mk-var "x")) (extend "x" 5 empty-s))
|
||||
(list 1 (mk-var "x")))
|
||||
|
||||
;; --- walk*: deep walk into lists ---
|
||||
|
||||
(mk-test
|
||||
"walk*-flat-list-with-vars"
|
||||
(mk-walk*
|
||||
(list (mk-var "x") 2 (mk-var "y"))
|
||||
(extend "x" 1 (extend "y" 3 empty-s)))
|
||||
(list 1 2 3))
|
||||
|
||||
(mk-test
|
||||
"walk*-nested-list"
|
||||
(mk-walk*
|
||||
(list 1 (mk-var "x") (list 2 (mk-var "y")))
|
||||
(extend "x" 5 (extend "y" 6 empty-s)))
|
||||
(list 1 5 (list 2 6)))
|
||||
|
||||
(mk-test
|
||||
"walk*-unbound-stays-var"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(= (mk-walk* (list 1 x) empty-s) (list 1 x)))
|
||||
true)
|
||||
|
||||
(mk-test "walk*-atom" (mk-walk* 5 empty-s) 5)
|
||||
|
||||
;; --- unify atoms (success / failure semantics, not dict shape) ---
|
||||
|
||||
(mk-test
|
||||
"unify-num-eq-succeeds"
|
||||
(mk-unified? (mk-unify 5 5 empty-s))
|
||||
true)
|
||||
(mk-test "unify-num-neq-fails" (mk-unify 5 6 empty-s) nil)
|
||||
(mk-test
|
||||
"unify-str-eq-succeeds"
|
||||
(mk-unified? (mk-unify "a" "a" empty-s))
|
||||
true)
|
||||
(mk-test "unify-str-neq-fails" (mk-unify "a" "b" empty-s) nil)
|
||||
(mk-test
|
||||
"unify-bool-eq-succeeds"
|
||||
(mk-unified? (mk-unify true true empty-s))
|
||||
true)
|
||||
(mk-test "unify-bool-neq-fails" (mk-unify true false empty-s) nil)
|
||||
(mk-test
|
||||
"unify-nil-eq-succeeds"
|
||||
(mk-unified? (mk-unify nil nil empty-s))
|
||||
true)
|
||||
(mk-test
|
||||
"unify-empty-list-succeeds"
|
||||
(mk-unified? (mk-unify (list) (list) empty-s))
|
||||
true)
|
||||
|
||||
;; --- unify var with anything (walk to verify binding) ---
|
||||
|
||||
(mk-test
|
||||
"unify-var-num-binds"
|
||||
(mk-walk (mk-var "x") (mk-unify (mk-var "x") 5 empty-s))
|
||||
5)
|
||||
|
||||
(mk-test
|
||||
"unify-num-var-binds"
|
||||
(mk-walk (mk-var "x") (mk-unify 5 (mk-var "x") empty-s))
|
||||
5)
|
||||
|
||||
(mk-test
|
||||
"unify-var-list-binds"
|
||||
(mk-walk
|
||||
(mk-var "x")
|
||||
(mk-unify (mk-var "x") (list 1 2) empty-s))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"unify-var-var-same-no-extend"
|
||||
(mk-unified? (mk-unify (mk-var "x") (mk-var "x") empty-s))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"unify-var-var-different-walks-equal"
|
||||
(let
|
||||
((s (mk-unify (mk-var "x") (mk-var "y") empty-s)))
|
||||
(= (mk-walk (mk-var "x") s) (mk-walk (mk-var "y") s)))
|
||||
true)
|
||||
|
||||
;; --- unify lists positionally ---
|
||||
|
||||
(mk-test
|
||||
"unify-list-equal-succeeds"
|
||||
(mk-unified?
|
||||
(mk-unify
|
||||
(list 1 2 3)
|
||||
(list 1 2 3)
|
||||
empty-s))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"unify-list-different-length-fails-1"
|
||||
(mk-unify
|
||||
(list 1 2)
|
||||
(list 1 2 3)
|
||||
empty-s)
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-list-different-length-fails-2"
|
||||
(mk-unify
|
||||
(list 1 2 3)
|
||||
(list 1 2)
|
||||
empty-s)
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-list-mismatch-fails"
|
||||
(mk-unify
|
||||
(list 1 2)
|
||||
(list 1 3)
|
||||
empty-s)
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-list-vs-atom-fails"
|
||||
(mk-unify (list 1 2) 5 empty-s)
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-empty-vs-non-empty-fails"
|
||||
(mk-unify (list) (list 1) empty-s)
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-list-with-vars-walks"
|
||||
(mk-walk*
|
||||
(list (mk-var "x") (mk-var "y"))
|
||||
(mk-unify
|
||||
(list (mk-var "x") (mk-var "y"))
|
||||
(list 1 2)
|
||||
empty-s))
|
||||
(list 1 2))
|
||||
|
||||
(mk-test
|
||||
"unify-nested-lists-with-vars-walks"
|
||||
(mk-walk*
|
||||
(list (mk-var "x") (list (mk-var "y") 3))
|
||||
(mk-unify
|
||||
(list (mk-var "x") (list (mk-var "y") 3))
|
||||
(list 1 (list 2 3))
|
||||
empty-s))
|
||||
(list 1 (list 2 3)))
|
||||
|
||||
;; --- unify chained substitutions ---
|
||||
|
||||
(mk-test
|
||||
"unify-chain-var-var-then-atom"
|
||||
(let
|
||||
((x (mk-var "x")) (y (mk-var "y")))
|
||||
(let
|
||||
((s1 (mk-unify x y empty-s)))
|
||||
(mk-walk x (mk-unify y 7 s1))))
|
||||
7)
|
||||
|
||||
(mk-test
|
||||
"unify-already-bound-consistent"
|
||||
(let
|
||||
((s (extend "x" 5 empty-s)))
|
||||
(mk-unified? (mk-unify (mk-var "x") 5 s)))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"unify-already-bound-conflict-fails"
|
||||
(let
|
||||
((s (extend "x" 5 empty-s)))
|
||||
(mk-unify (mk-var "x") 6 s))
|
||||
nil)
|
||||
|
||||
;; --- occurs check (opt-in) ---
|
||||
|
||||
(mk-test
|
||||
"unify-no-occurs-default-succeeds"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-unified? (mk-unify x (list 1 x) empty-s)))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"unify-occurs-direct-fails"
|
||||
(let ((x (mk-var "x"))) (mk-unify-check x (list 1 x) empty-s))
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-occurs-nested-fails"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-unify-check x (list 1 (list 2 x)) empty-s))
|
||||
nil)
|
||||
|
||||
(mk-test
|
||||
"unify-occurs-non-occurring-succeeds"
|
||||
(let
|
||||
((x (mk-var "x")))
|
||||
(mk-unified? (mk-unify-check x 5 empty-s)))
|
||||
true)
|
||||
|
||||
(mk-test
|
||||
"unify-occurs-via-chain-fails"
|
||||
(let
|
||||
((x (mk-var "x")) (y (mk-var "y")))
|
||||
(let ((s (extend "y" (list x) empty-s))) (mk-unify-check x y s)))
|
||||
nil)
|
||||
|
||||
(mk-tests-run!)
|
||||
52
lib/minikanren/tests/zip-with-o.sx
Normal file
52
lib/minikanren/tests/zip-with-o.sx
Normal file
@@ -0,0 +1,52 @@
|
||||
;; lib/minikanren/tests/zip-with-o.sx — element-wise combine of two lists.
|
||||
|
||||
(mk-test
|
||||
"zip-with-o-empty"
|
||||
(run* q (zip-with-o pluso-i (list) (list) q))
|
||||
(list (list)))
|
||||
|
||||
(mk-test
|
||||
"zip-with-o-pluso-i"
|
||||
(run*
|
||||
q
|
||||
(zip-with-o
|
||||
pluso-i
|
||||
(list 1 2 3)
|
||||
(list 10 20 30)
|
||||
q))
|
||||
(list (list 11 22 33)))
|
||||
|
||||
(mk-test
|
||||
"zip-with-o-times-i"
|
||||
(run*
|
||||
q
|
||||
(zip-with-o
|
||||
*o-i
|
||||
(list 2 3 4)
|
||||
(list 5 6 7)
|
||||
q))
|
||||
(list (list 10 18 28)))
|
||||
|
||||
(mk-test
|
||||
"zip-with-o-different-length-fails"
|
||||
(run*
|
||||
q
|
||||
(zip-with-o
|
||||
pluso-i
|
||||
(list 1 2)
|
||||
(list 1 2 3)
|
||||
q))
|
||||
(list))
|
||||
|
||||
(mk-test
|
||||
"zip-with-o-non-arith-rel"
|
||||
(run*
|
||||
q
|
||||
(zip-with-o
|
||||
(fn (a b r) (== r (list a b)))
|
||||
(list :x :y)
|
||||
(list 1 2)
|
||||
q))
|
||||
(list (list (list :x 1) (list :y 2))))
|
||||
|
||||
(mk-tests-run!)
|
||||
Reference in New Issue
Block a user