12 Commits

Author SHA1 Message Date
a038d41815 mk: phase 5C — nafc, negation as finite failure
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
(nafc g) is a three-line primitive: peek the goal's stream for one
answer; if empty, yield (unit s); else mzero. Carries the standard
miniKanren caveats — open-world unsound, diverges on infinite streams.

7 tests: failed-goal-succeeds, successful-goal-fails, double-negation,
conde-all-fail-makes-nafc-succeed, conde-any-success-makes-nafc-fail,
nafc as a guard accepting and blocking.

201/201 cumulative.
2026-05-07 23:29:08 +00:00
d61b355413 mk: phase 5B — project, escape into host SX
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
(project (vars ...) goal ...) defmacro walks each named var via mk-walk*,
rebinds them in the body's lexical scope, then mk-conjs the body goals on
the same substitution. Hygienic — gensym'd s-param so user vars survive.

Lets you reach into host SX for arithmetic, string ops, anything that
needs a ground value: (project (n) (== q (* n n))), (project (s)
(== q (str s \"!\"))), and so on.

6 new tests, 194/194 cumulative.
2026-05-07 23:27:16 +00:00
43d58e6ca9 mk: peano arithmetic (zeroo, pluso, minuso, *o, lteo, lto)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
Classic miniKanren Peano arithmetic on (:z / (:s n)) naturals. pluso runs
relationally in all directions: 2+3=5 forward, x+2=5 → 3 backward,
enumerates the four pairs summing to 3. *o is iterated pluso. lteo/lto
via existential successor decomposition.

19 new tests, 188/188 cumulative. Phase-tagged in the plan separately
from Phase 6 CLP(FD), which will eventually replace this with native
integers + arc-consistency propagation.
2026-05-07 21:54:16 +00:00
240ed90b20 mk: phase 5A — conda, soft-cut without onceo
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
conda-try mirrors condu-try but on the chosen clause it (mk-bind
(head-goal s) (rest-conj)) — all head answers flow through. condu by
contrast applies rest-conj to (first peek), keeping only one head
answer.

7 new tests covering: first-non-failing-wins, skip-failing-head, all-fail,
no-clauses, the conda-vs-condu divergence (`(1 2)` vs `(1)`), rest-goals
running on every head answer, and the soft-cut no-fallthrough property.

169/169 cumulative.
2026-05-07 21:51:52 +00:00
f4ab7f2534 mk: phase 4B — reverseo + lengtho, 10 new tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
reverseo: standard recursive definition via appendo. Forward works in
run*; backward (input fresh, output ground) works in run 1 but run*
diverges trying to enumerate the unique answer (canonical TRS issue
with naive reverseo).

lengtho: Peano encoding (:z / (:s :z) / (:s (:s :z)) ...) so it works
relationally in both directions without arithmetic-as-relation. Forward
returns the Peano length; backward enumerates lists of a given length.

162/162 cumulative.
2026-05-07 21:49:38 +00:00
cae87c1e2c mk: phase 4A — appendo canary green, both directions
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 23s
Three coupled fixes plus a new relations module land together because
each is required for the next: appendo can't terminate without all
three.

1. unify.sx — added (:cons h t) tagged cons-cell shape because SX has no
   improper pairs. The unifier treats (:cons h t) and the native list
   (h . t) as equivalent. mk-walk* re-flattens cons cells back to flat
   lists for clean reification.

2. stream.sx — switched mature stream cells from plain SX lists to a
   (:s head tail) tagged shape so a mature head can have a thunk tail.
   With the old representation, mk-mplus had to (cons head thunk) which
   SX rejects (cons requires a list cdr).

3. conde.sx — wraps each clause in Zzz (inverse-eta delay) for laziness.
   Zzz uses (gensym "zzz-s-") for the substitution parameter so it does
   not capture user goals that follow the (l s ls) convention. Without
   gensym, every relation that uses `s` as a list parameter silently
   binds it to the substitution dict.

relations.sx is the new module: nullo, pairo, caro, cdro, conso,
firsto, resto, listo, appendo, membero. 25 new tests.

Canary green:
  (run* q (appendo (list 1 2) (list 3 4) q))
    → ((1 2 3 4))
  (run* q (fresh (l s) (appendo l s (list 1 2 3)) (== q (list l s))))
    → ((() (1 2 3)) ((1) (2 3)) ((1 2) (3)) ((1 2 3) ()))
  (run 3 q (listo q))
    → (() (_.0) (_.0 _.1))

152/152 cumulative.
2026-05-07 20:24:42 +00:00
52070e07fc mk: phase 3 — run* / run / reify, 18 new tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
run.sx: reify-name builds canonical "_.N" symbols; reify-s walks a term
left-to-right and assigns each unbound var its index in the discovery
order; reify combines the two with two walk* passes. run-n is the
runtime defmacro: binds the query var, takes ≤ n stream answers, reifies
each. run* and run are sugar around it.

First classic miniKanren tests green:
  (run* q (== q 1))                              → (1)
  (run* q (conde ((== q 1)) ((== q 2))))         → (1 2)
  (run* q (fresh (x y) (== q (list x y))))       → ((_.0 _.1))

128/128 cumulative.
2026-05-07 20:03:42 +00:00
2de6727e83 mk: phase 2D — condu + onceo, phase 2 complete
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
condu.sx: defmacro `condu` folds clauses through a runtime `condu-try`
walker. First clause whose head yields a non-empty stream commits its
single first answer; later clauses are not tried. `onceo` is the simpler
sibling — stream-take 1 over a goal's output.

10 tests cover: onceo trimming success/failure/conde, condu first-clause
wins, condu skips failing heads, condu commits-and-cannot-backtrack to
later clauses if the rest of the chosen clause fails.

110/110 cumulative. Phase 2 complete.
2026-05-07 20:01:10 +00:00
c754a8ee05 mk: phase 2C — conde, the canonical and-or sugar
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
conde.sx is a single defmacro: (conde (g1a g1b ...) (g2a g2b ...) ...) folds
to (mk-disj (mk-conj g1a g1b ...) (mk-conj g2a g2b ...) ...). 9 tests cover
single/multi-clause, mixed success/failure, conjunction inside clauses,
fresh+disj inside a clause, nesting, and all-fail / no-clauses.

100/100 cumulative.
2026-05-07 19:59:17 +00:00
f43ad04f91 mk: phase 2B — fresh, defmacro form + call-fresh
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
(fresh (x y z) g1 g2 ...) expands to a let that calls (make-var) for each
named var, then mk-conjs the goals. call-fresh is the function-shaped
alternative for programmatic goal building.

9 new tests: empty-vars, single var, multi-var multi-goal, fresh under
disj, nested fresh, call-fresh equivalents. 91/91 cumulative.
2026-05-07 19:56:40 +00:00
0ba60d6a25 mk: phase 2A — streams + ==/conj/disj, 34 new tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
lib/minikanren/stream.sx: mzero/unit/mk-mplus/mk-bind/stream-take. Three
stream shapes (empty, mature list, immature thunk). mk-mplus suspends and
swaps on a paused-left for fair interleaving (Reasoned Schemer style).

lib/minikanren/goals.sx: succeed/fail/==/==-check + conj2/disj2 +
variadic mk-conj/mk-disj. ==-check is the opt-in occurs-checked variant.

Forced-rename note: SX has a host primitive `bind` that silently shadows
user-level defines, so all stream/goal operators are mk-prefixed. Recorded
in feedback memory.

82/82 tests cumulative (48 unify + 34 goals).
2026-05-07 19:54:43 +00:00
f13e03e625 mk: phase 1 — unify.sx + 48 tests, kit-driven
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
lib/minikanren/unify.sx wraps lib/guest/match.sx with a miniKanren-flavoured
cfg: native SX lists as cons-pairs, occurs-check off by default. ~22 lines
of local logic over kit's walk-with / unify-with / extend / occurs-with.

48 tests in lib/minikanren/tests/unify.sx exercise: var fresh-distinct,
walk chains, walk* deep into nested lists, atom/var/list unification with
positional matching, failure modes, opt-in occurs check.
2026-05-07 19:45:47 +00:00
24 changed files with 2186 additions and 45 deletions

42
lib/minikanren/conda.sx Normal file
View File

@@ -0,0 +1,42 @@
;; lib/minikanren/conda.sx — Phase 5 piece A: `conda`, the soft-cut.
;;
;; (conda (g0 g ...) (h0 h ...) ...)
;; — first clause whose head g0 produces ANY answer wins; ALL of g0's
;; answers are then conj'd with the rest of that clause; later
;; clauses are NOT tried.
;; — differs from condu only in not wrapping g0 in onceo: condu
;; commits to the SINGLE first answer, conda lets the head's full
;; answer-set flow into the rest of the clause.
;; (Reasoned Schemer chapter 10; Byrd 5.3.)
(define
conda-try
(fn
(clauses s)
(cond
((empty? clauses) mzero)
(:else
(let
((cl (first clauses)))
(let
((head-goal (first cl)) (rest-goals (rest cl)))
(let
((peek (stream-take 1 (head-goal s))))
(if
(empty? peek)
(conda-try (rest clauses) s)
(mk-bind (head-goal s) (mk-conj-list rest-goals))))))))))
(defmacro
conda
(&rest clauses)
(quasiquote
(fn
(s)
(conda-try
(list
(splice-unquote
(map
(fn (cl) (quasiquote (list (splice-unquote cl))))
clauses)))
s))))

39
lib/minikanren/conde.sx Normal file
View File

@@ -0,0 +1,39 @@
;; lib/minikanren/conde.sx — Phase 2 piece C: `conde`, the canonical
;; miniKanren and-or form, with implicit Zzz inverse-eta delay so recursive
;; relations like appendo terminate.
;;
;; (conde (g1a g1b ...) (g2a g2b ...) ...)
;; ≡ (mk-disj (Zzz (mk-conj g1a g1b ...))
;; (Zzz (mk-conj g2a g2b ...)) ...)
;;
;; `Zzz g` wraps a goal expression in (fn (S) (fn () (g S))) so that
;; `g`'s body isn't constructed until the surrounding fn is applied to a
;; substitution AND the returned thunk is forced. This is what gives
;; miniKanren its laziness — recursive goal definitions can be `(conde
;; ... (... (recur ...)))` without infinite descent at construction time.
;;
;; Hygiene: the substitution parameter is gensym'd so that user goal
;; expressions which themselves bind `s` (e.g. `(appendo l s ls)`) keep
;; their lexical `s` and don't accidentally reference the wrapper's
;; substitution. Without gensym, miniKanren relations that follow the
;; common (l s ls) parameter convention are silently miscompiled.
(defmacro
Zzz
(g)
(let
((s-sym (gensym "zzz-s-")))
(quasiquote
(fn ((unquote s-sym)) (fn () ((unquote g) (unquote s-sym)))))))
(defmacro
conde
(&rest clauses)
(quasiquote
(mk-disj
(splice-unquote
(map
(fn
(clause)
(quasiquote (Zzz (mk-conj (splice-unquote clause)))))
clauses)))))

58
lib/minikanren/condu.sx Normal file
View File

@@ -0,0 +1,58 @@
;; lib/minikanren/condu.sx — Phase 2 piece D: `condu` and `onceo`.
;;
;; Both are commitment forms (no backtracking into discarded options):
;;
;; (onceo g) — succeeds at most once: takes the first answer
;; stream-take produces from (g s).
;;
;; (condu (g0 g ...) (h0 h ...) ...)
;; — first clause whose head goal succeeds wins; only
;; the first answer of the head is propagated to the
;; rest of that clause; later clauses are not tried.
;; (Reasoned Schemer chapter 10; Byrd 5.4.)
(define
onceo
(fn
(g)
(fn
(s)
(let
((peek (stream-take 1 (g s))))
(if (empty? peek) mzero (unit (first peek)))))))
;; condu-try — runtime walker over a list of clauses (each clause a list of
;; goals). Forces the head with stream-take 1; if head fails, recurse to
;; the next clause; if head succeeds, commits its single answer through
;; the rest of the clause.
(define
condu-try
(fn
(clauses s)
(cond
((empty? clauses) mzero)
(:else
(let
((cl (first clauses)))
(let
((head-goal (first cl)) (rest-goals (rest cl)))
(let
((peek (stream-take 1 (head-goal s))))
(if
(empty? peek)
(condu-try (rest clauses) s)
((mk-conj-list rest-goals) (first peek))))))))))
(defmacro
condu
(&rest clauses)
(quasiquote
(fn
(s)
(condu-try
(list
(splice-unquote
(map
(fn (cl) (quasiquote (list (splice-unquote cl))))
clauses)))
s))))

23
lib/minikanren/fresh.sx Normal file
View File

@@ -0,0 +1,23 @@
;; lib/minikanren/fresh.sx — Phase 2 piece B: `fresh` for introducing
;; logic variables inside a goal body.
;;
;; (fresh (x y z) goal1 goal2 ...)
;; ≡ (let ((x (make-var)) (y (make-var)) (z (make-var)))
;; (mk-conj goal1 goal2 ...))
;;
;; A macro rather than a function so user-named vars are real lexical
;; bindings — which is also what miniKanren convention expects.
;; The empty-vars form (fresh () goal ...) is just a goal grouping.
(defmacro
fresh
(vars &rest goals)
(quasiquote
(let
(unquote (map (fn (v) (list v (list (quote make-var)))) vars))
(mk-conj (splice-unquote goals)))))
;; call-fresh — functional alternative for code that builds goals
;; programmatically:
;; ((call-fresh (fn (x) (== x 7))) empty-s) → ({:_.N 7})
(define call-fresh (fn (f) (fn (s) ((f (make-var)) s))))

58
lib/minikanren/goals.sx Normal file
View File

@@ -0,0 +1,58 @@
;; lib/minikanren/goals.sx — Phase 2 piece B: core goals.
;;
;; A goal is a function (fn (s) → stream-of-substitutions).
;; Goals built here:
;; succeed — always returns (unit s)
;; fail — always returns mzero
;; == — unifies two terms; succeeds with a singleton, else fails
;; ==-check — opt-in occurs-checked equality
;; conj2 / mk-conj — sequential conjunction of goals
;; disj2 / mk-disj — interleaved disjunction of goals (raw — `conde` adds
;; the implicit-conj-per-clause sugar in a later commit)
(define succeed (fn (s) (unit s)))
(define fail (fn (s) mzero))
(define
==
(fn
(u v)
(fn
(s)
(let ((s2 (mk-unify u v s))) (if (= s2 nil) mzero (unit s2))))))
(define
==-check
(fn
(u v)
(fn
(s)
(let ((s2 (mk-unify-check u v s))) (if (= s2 nil) mzero (unit s2))))))
(define conj2 (fn (g1 g2) (fn (s) (mk-bind (g1 s) g2))))
(define disj2 (fn (g1 g2) (fn (s) (mk-mplus (g1 s) (g2 s)))))
;; Fold goals in a list. (mk-conj-list ()) ≡ succeed; (mk-disj-list ()) ≡ fail.
(define
mk-conj-list
(fn
(gs)
(cond
((empty? gs) succeed)
((empty? (rest gs)) (first gs))
(:else (conj2 (first gs) (mk-conj-list (rest gs)))))))
(define
mk-disj-list
(fn
(gs)
(cond
((empty? gs) fail)
((empty? (rest gs)) (first gs))
(:else (disj2 (first gs) (mk-disj-list (rest gs)))))))
(define mk-conj (fn (&rest gs) (mk-conj-list gs)))
(define mk-disj (fn (&rest gs) (mk-disj-list gs)))

24
lib/minikanren/nafc.sx Normal file
View File

@@ -0,0 +1,24 @@
;; lib/minikanren/nafc.sx — Phase 5 piece C: negation as finite failure.
;;
;; (nafc g)
;; succeeds (yields the input substitution) if g has zero answers
;; against that substitution; fails (mzero) if g has at least one.
;;
;; Caveat: `nafc` is unsound under the open-world assumption. It only
;; makes sense for goals over fully-ground terms, or with the explicit
;; understanding that adding more facts could flip the answer. Use
;; `(project (...) ...)` to ensure the relevant vars are ground first.
;;
;; Caveat 2: stream-take forces g for at least one answer; if g is
;; infinitely-ground (say, a divergent search over an unbound list),
;; nafc itself will diverge. Standard miniKanren limitation.
(define
nafc
(fn
(g)
(fn
(s)
(let
((peek (stream-take 1 (g s))))
(if (empty? peek) (unit s) mzero)))))

35
lib/minikanren/peano.sx Normal file
View File

@@ -0,0 +1,35 @@
;; lib/minikanren/peano.sx — Peano-encoded natural-number relations.
;;
;; Same encoding as `lengtho`: zero is the keyword `:z`; successors are
;; `(:s n)`. So 3 = `(:s (:s (:s :z)))`. `(:z)` and `(:s ...)` are normal
;; SX values that unify positionally — no special primitives needed.
;;
;; Peano arithmetic is the canonical miniKanren way to test addition /
;; multiplication / less-than relationally without an FD constraint store.
;; (CLP(FD) integers come in Phase 6.)
(define zeroo (fn (n) (== n :z)))
(define succ-of (fn (n m) (== m (list :s n))))
(define
pluso
(fn
(a b c)
(conde
((== a :z) (== b c))
((fresh (a-1 c-1) (== a (list :s a-1)) (== c (list :s c-1)) (pluso a-1 b c-1))))))
(define minuso (fn (a b c) (pluso b c a)))
(define lteo (fn (a b) (fresh (k) (pluso a k b))))
(define lto (fn (a b) (fresh (sa) (succ-of a sa) (lteo sa b))))
(define
*o
(fn
(a b c)
(conde
((== a :z) (== c :z))
((fresh (a-1 ab-1) (== a (list :s a-1)) (*o a-1 b ab-1) (pluso b ab-1 c))))))

25
lib/minikanren/project.sx Normal file
View File

@@ -0,0 +1,25 @@
;; lib/minikanren/project.sx — Phase 5 piece B: `project`.
;;
;; (project (x y) g1 g2 ...)
;; — rebinds each named var to (mk-walk* var s) within the body's
;; lexical scope, then runs the conjunction of the body goals on
;; the same substitution. Use to escape into regular SX (arithmetic,
;; string ops, host predicates) when you need a ground value.
;;
;; If any of the projected vars is still unbound at this point, the body
;; sees the raw `(:var NAME)` term — that is intentional and lets you
;; mix project with `(== ground? var)` patterns or with conda guards.
;;
;; Hygiene: substitution parameter is gensym'd so it doesn't capture user
;; vars (`s` is a popular relation parameter name).
(defmacro
project
(vars &rest goals)
(let
((s-sym (gensym "proj-s-")))
(quasiquote
(fn
((unquote s-sym))
((let (unquote (map (fn (v) (list v (list (quote mk-walk*) v s-sym))) vars)) (mk-conj (splice-unquote goals)))
(unquote s-sym))))))

View File

@@ -0,0 +1,67 @@
;; lib/minikanren/relations.sx — Phase 4 standard relations.
;;
;; Programs use native SX lists as data. Relations decompose lists via the
;; tagged cons-cell shape `(:cons h t)` because SX has no improper pairs;
;; the unifier treats `(:cons h t)` and the native list `(h . t)` as
;; equivalent, and `mk-walk*` flattens cons cells back to flat lists for
;; reification.
;; --- pair / list shape relations ---
(define nullo (fn (l) (== l (list))))
(define pairo (fn (p) (fresh (a d) (== p (mk-cons a d)))))
(define caro (fn (p a) (fresh (d) (== p (mk-cons a d)))))
(define cdro (fn (p d) (fresh (a) (== p (mk-cons a d)))))
(define conso (fn (a d p) (== p (mk-cons a d))))
(define firsto caro)
(define resto cdro)
(define
listo
(fn (l) (conde ((nullo l)) ((fresh (a d) (conso a d l) (listo d))))))
;; --- appendo: the canary ---
;;
;; (appendo l s ls) — `ls` is the concatenation of `l` and `s`.
;; Runs forwards (l, s known → ls), backwards (ls known → all (l, s) pairs),
;; and bidirectionally (mix of bound + unbound).
(define
appendo
(fn
(l s ls)
(conde
((nullo l) (== s ls))
((fresh (a d res) (conso a d l) (conso a res ls) (appendo d s res))))))
;; --- membero ---
;; (membero x l) — x appears (at least once) in l.
(define
membero
(fn
(x l)
(conde
((fresh (d) (conso x d l)))
((fresh (a d) (conso a d l) (membero x d))))))
(define
reverseo
(fn
(l r)
(conde
((nullo l) (nullo r))
((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r))))))
(define
lengtho
(fn
(l n)
(conde
((nullo l) (== n :z))
((fresh (a d n-1) (conso a d l) (== n (list :s n-1)) (lengtho d n-1))))))

56
lib/minikanren/run.sx Normal file
View File

@@ -0,0 +1,56 @@
;; lib/minikanren/run.sx — Phase 3: drive a goal + reify the query var.
;;
;; reify-name N — make the canonical "_.N" reified symbol.
;; reify-s term rs — walk term in rs, add a mapping from each fresh
;; unbound var to its _.N name (left-to-right order).
;; reify q s — walk* q in s, build reify-s, walk* again to
;; substitute reified names in.
;; run-n n q-name g... — defmacro: bind q-name to a fresh var, conj goals,
;; take ≤ n answers from the stream, reify each
;; through q-name. n = -1 takes all (used by run*).
;; run* — defmacro: (run* q g...) ≡ (run-n -1 q g...)
;; run — defmacro: (run n q g...) ≡ (run-n n q g...)
;; The two-segment form is the standard TRS API.
(define reify-name (fn (n) (make-symbol (str "_." n))))
(define
reify-s
(fn
(term rs)
(let
((w (mk-walk term rs)))
(cond
((is-var? w) (extend (var-name w) (reify-name (len rs)) rs))
((mk-list-pair? w) (reduce (fn (acc a) (reify-s a acc)) rs w))
(:else rs)))))
(define
reify
(fn
(term s)
(let
((w (mk-walk* term s)))
(let ((rs (reify-s w (empty-subst)))) (mk-walk* w rs)))))
(defmacro
run-n
(n q-name &rest goals)
(quasiquote
(let
(((unquote q-name) (make-var)))
(map
(fn (s) (reify (unquote q-name) s))
(stream-take
(unquote n)
((mk-conj (splice-unquote goals)) empty-s))))))
(defmacro
run*
(q-name &rest goals)
(quasiquote (run-n -1 (unquote q-name) (splice-unquote goals))))
(defmacro
run
(n q-name &rest goals)
(quasiquote (run-n (unquote n) (unquote q-name) (splice-unquote goals))))

66
lib/minikanren/stream.sx Normal file
View File

@@ -0,0 +1,66 @@
;; lib/minikanren/stream.sx — Phase 2 piece A: lazy streams of substitutions.
;;
;; SX has no improper pairs (cons requires a list cdr), so we use a
;; tagged stream-cell shape for mature stream elements:
;;
;; stream ::= mzero empty (the SX empty list)
;; | (:s HEAD TAIL) mature cell, TAIL is a stream
;; | thunk (fn () ...) → stream when forced
;;
;; HEAD is a substitution dict. TAIL is again a stream (possibly a thunk),
;; which is what gives us laziness — mk-mplus can return a mature head with
;; a thunk in the tail, deferring the rest of the search.
(define mzero (list))
(define s-cons (fn (h t) (list :s h t)))
(define
s-cons?
(fn (s) (and (list? s) (not (empty? s)) (= (first s) :s))))
(define s-car (fn (s) (nth s 1)))
(define s-cdr (fn (s) (nth s 2)))
(define unit (fn (s) (s-cons s mzero)))
(define stream-pause? (fn (s) (and (not (list? s)) (callable? s))))
;; mk-mplus — interleave two streams. If s1 is paused we suspend and
;; swap (Reasoned Schemer "interleave"); otherwise mature-cons head with
;; mk-mplus of the rest.
(define
mk-mplus
(fn
(s1 s2)
(cond
((empty? s1) s2)
((stream-pause? s1) (fn () (mk-mplus s2 (s1))))
(:else (s-cons (s-car s1) (mk-mplus (s-cdr s1) s2))))))
;; mk-bind — apply goal g to every substitution in stream s, mk-mplus-ing.
(define
mk-bind
(fn
(s g)
(cond
((empty? s) mzero)
((stream-pause? s) (fn () (mk-bind (s) g)))
(:else (mk-mplus (g (s-car s)) (mk-bind (s-cdr s) g))))))
;; stream-take — force up to n results out of a (possibly lazy) stream
;; into a flat SX list of substitutions. n = -1 means take all.
(define
stream-take
(fn
(n s)
(cond
((= n 0) (list))
((empty? s) (list))
((stream-pause? s) (stream-take n (s)))
(:else
(cons
(s-car s)
(stream-take
(if (= n -1) -1 (- n 1))
(s-cdr s)))))))

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

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

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

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

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

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

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

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

View File

@@ -0,0 +1,227 @@
;; 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"))))
(mk-tests-run!)

114
lib/minikanren/tests/run.sx Normal file
View 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!)

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

82
lib/minikanren/unify.sx Normal file
View File

@@ -0,0 +1,82 @@
;; lib/minikanren/unify.sx — Phase 1 + cons-cell extension.
;;
;; miniKanren-on-SX, built on lib/guest/match.sx. The kit ships the heavy
;; lifting (walk-with, unify-with, occurs-with, extend, empty-subst,
;; mk-var/is-var?/var-name); this file supplies a miniKanren-shaped cfg
;; and a thin public API.
;;
;; Term shapes:
;; logic var : (:var NAME) — kit's mk-var
;; cons cell : (:cons HEAD TAIL) — for relational programming
;; (built by mk-cons; lets relations decompose lists by
;; head/tail without proper improper pairs in the host)
;; native list : SX list (a b c) — also unifies pair-style:
;; args = (head, tail) so (1 2 3) ≡ (:cons 1 (:cons 2 (:cons 3 ())))
;; atom : number / string / symbol / boolean / nil / ()
;;
;; Substitution: SX dict mapping VAR-NAME → term. Empty = (empty-subst).
(define mk-cons (fn (h t) (list :cons h t)))
(define
mk-cons-cell?
(fn (t) (and (list? t) (not (empty? t)) (= (first t) :cons))))
(define mk-cons-head (fn (t) (nth t 1)))
(define mk-cons-tail (fn (t) (nth t 2)))
(define
mk-list-pair?
(fn (t) (and (list? t) (not (empty? t)) (not (is-var? t)))))
(define mk-list-pair-head (fn (t) :pair))
(define
mk-list-pair-args
(fn
(t)
(cond
((mk-cons-cell? t) (list (mk-cons-head t) (mk-cons-tail t)))
(:else (list (first t) (rest t))))))
(define mk-cfg {:ctor-head mk-list-pair-head :var? is-var? :ctor? mk-list-pair? :occurs-check? false :var-name var-name :ctor-args mk-list-pair-args})
(define mk-cfg-occurs {:ctor-head mk-list-pair-head :var? is-var? :ctor? mk-list-pair? :occurs-check? true :var-name var-name :ctor-args mk-list-pair-args})
(define empty-s (empty-subst))
(define mk-fresh-counter 0)
(define
make-var
(fn
()
(begin
(set! mk-fresh-counter (+ mk-fresh-counter 1))
(mk-var (str "_." mk-fresh-counter)))))
(define mk-var? is-var?)
(define mk-walk (fn (t s) (walk-with mk-cfg t s)))
(define
mk-walk*
(fn
(t s)
(let
((w (mk-walk t s)))
(cond
((mk-cons-cell? w)
(let
((h (mk-walk* (mk-cons-head w) s))
(tl (mk-walk* (mk-cons-tail w) s)))
(cond
((empty? tl) (list h))
((mk-cons-cell? tl) tl)
((list? tl) (cons h tl))
(:else (mk-cons h tl)))))
((mk-list-pair? w) (map (fn (a) (mk-walk* a s)) w))
(:else w)))))
(define mk-unify (fn (u v s) (unify-with mk-cfg u v s)))
(define mk-unify-check (fn (u v s) (unify-with mk-cfg-occurs u v s)))

View File

@@ -50,63 +50,87 @@ Key semantic mappings:
## Roadmap
### Phase 1 — variables + unification
- [ ] `make-var` → fresh logic variable (unique mutable box)
- [ ] `var?` `v` → bool — is this a logic variable?
- [ ] `walk` `term` `subst` → follow substitution chain to ground term or unbound var
- [ ] `walk*` `term` `subst` → deep walk (recurse into lists/dicts)
- [ ] `unify` `u` `v` `subst` → extended substitution or `#f` (failure)
- [x] `make-var` → fresh logic variable (unique mutable box)
- [x] `var?` `v` → bool — is this a logic variable?
- [x] `walk` `term` `subst` → follow substitution chain to ground term or unbound var
- [x] `walk*` `term` `subst` → deep walk (recurse into lists/dicts)
- [x] `unify` `u` `v` `subst` → extended substitution or `#f` (failure)
Handles: var/var, var/term, term/var, list unification, number/string/symbol equality.
No occurs check by default; `unify-check` with occurs check as opt-in.
- [ ] Empty substitution `empty-s` = `(list)` (empty assoc list)
- [ ] Tests in `lib/minikanren/tests/unify.sx`: ground terms, vars, lists, failure, occurs
- [x] Empty substitution `empty-s` (dict-based via kit's `empty-subst` — assoc list was a sketch; kit ships dict, kept it)
- [x] Tests in `lib/minikanren/tests/unify.sx`: ground terms, vars, lists, failure, occurs
### Phase 2 — streams + goals
- [ ] Stream type: `mzero` (empty stream = `nil`), `unit s` (singleton = `(list s)`),
`mplus` (interleave two streams), `bind` (apply goal to stream)
- [ ] Lazy streams via `delay`/`force` — mature pairs for depth-first, immature for lazy
- [ ] `==` goal: `(fn (s) (let ((s2 (unify u v s))) (if s2 (unit s2) mzero)))`
- [ ] `succeed` / `fail` — trivial goals
- [ ] `fresh` `(fn (f) (fn (s) ((f (make-var)) s)))` — introduces one var; `fresh*` for many
- [ ] `conde` — interleaving disjunction of goal lists
- [ ] `condu` — committed choice (soft-cut): only explores first successful clause
- [ ] `onceo` — succeeds at most once
- [ ] Tests: basic goal composition, backtracking, interleaving
- [x] Stream type: `mzero` (empty), `unit s` (singleton), `mk-mplus` (interleave),
`mk-bind` (apply goal to stream). Names mk-prefixed because SX has a host
`bind` primitive that silently shadows user defines.
- [x] Lazy streams via thunks: a paused stream is a zero-arg fn; mk-mplus suspends
and swaps when its left operand is paused, giving fair interleaving.
- [x] `==` goal: `(fn (s) (let ((s2 (mk-unify u v s))) (if s2 (unit s2) mzero)))`
- [x] `==-check` — opt-in occurs-checked equality goal
- [x] `succeed` / `fail` — trivial goals
- [x] `conj2` / `mk-conj` (variadic) — sequential conjunction
- [x] `disj2` / `mk-disj` (variadic) — interleaved disjunction (raw — `conde`
adds the implicit-conj-per-clause sugar later)
- [x] `fresh` — introduces logic variables inside a goal body. Implemented as a
defmacro: `(fresh (x y) g1 g2 ...)``(let ((x (make-var)) (y (make-var)))
(mk-conj g1 g2 ...))`. Also `call-fresh` for programmatic goal building.
- [x] `conde` — sugar over disj+conj, one row per clause; defmacro that
wraps each clause body in `mk-conj` and folds via `mk-disj`. Notes:
with eager streams ordering is left-clause-first DFS; true interleaving
requires paused thunks (Phase 4 recursive relations).
- [x] `condu` — committed choice. defmacro folding clauses into a runtime
`condu-try` walker; first clause whose head goal yields a non-empty
stream commits its first answer, rest-goals run on that single subst.
- [x] `onceo``(stream-take 1 (g s))`; trims a goal's stream to ≤1 answer.
- [x] Tests: basic goal composition, backtracking, interleaving (110 cumulative)
### Phase 3 — run + reification
- [ ] `run*` `goal` → list of all answers (reified)
- [ ] `run n` `goal` → list of first n answers
- [ ] `reify` `term` `subst` → replace unbound vars with `_0`, `_1`, ... names
- [ ] `reify-s` builds reification substitution for naming unbound vars consistently
- [ ] `fresh` with multiple variables: `(fresh (x y z) goal)` sugar
- [ ] Query variable conventions: `q` as canonical query variable
- [ ] Tests: classic miniKanren programs — `(run* q (== q 1))``(1)`,
- [x] `run*` `goal` → list of all answers (reified). defmacro: bind q-name as
fresh var, conj goals, take all from stream, reify each.
- [x] `run n` `goal` → list of first n answers (defmacro; n = -1 means all)
- [x] `reify` `term` `subst` → walk* + build reification subst + walk* again
- [x] `reify-s` → maps each unbound var (in left-to-right walk order) to a
`_.N` symbol via `(make-symbol (str "_." n))`
- [x] `fresh` with multiple variables — already shipped Phase 2B.
- [x] Query variable conventions: `q` as canonical query variable (matches TRS)
- [x] Tests: classic miniKanren programs — `(run* q (== q 1))``(1)`,
`(run* q (conde ((== q 1)) ((== q 2))))``(1 2)`,
Peano arithmetic, `appendo` preview
`(run* q (fresh (x y) (== q (list x y))))``((_.0 _.1))`. Peano +
`appendo` deferred to Phase 4.
### Phase 4 — standard relations
- [ ] `appendo` `l` `s` `ls` — list append, runs forwards and backwards
- [ ] `membero` `x` `l` — x is a member of l
- [ ] `listo` `l` — l is a proper list
- [ ] `nullo` `l` — l is empty
- [ ] `pairo` `p` — p is a pair (cons cell)
- [ ] `caro` `p` `a` — car of pair
- [ ] `cdro` `p` `d` — cdr of pair
- [ ] `conso` `a` `d` `p` — cons
- [ ] `firsto` / `resto` — aliases for caro/cdro
- [ ] `reverseo` `l` `r` — reverse of list
- [ ] `flatteno` `l` `f` — flatten nested lists
- [ ] `permuteo` `l` `p`permutation of list
- [ ] `lengtho` `l` `n`length as a relation (Peano or integer)
- [ ] Tests: run each relation forwards and backwards; generate from partial inputs
- [x] `appendo` `l` `s` `ls` — list append, runs forwards AND backwards.
Canary green: `(run* q (appendo (1 2) (3 4) q))``((1 2 3 4))`;
`(run* q (fresh (l s) (appendo l s (1 2 3)) (== q (list l s))))`
all four splits.
- [x] `membero` `x` `l` — enumerates: `(run* q (membero q (a b c)))``(a b c)`
- [x] `listo` `l` — l is a proper list; enumerates list shapes with laziness
- [x] `nullo` `l` — l is empty
- [x] `pairo` `p` — p is a (non-empty) cons-cell / list
- [x] `caro` / `cdro` / `conso` / `firsto` / `resto`
- [x] `reverseo` `l` `r` — reverse of list. Forward is fast; backward is `run 1`-clean,
`run*` diverges due to interleaved unbounded list search (canonical TRS issue).
- [ ] `flatteno` `l` `f`flatten nested lists (deferred — needs atom predicate)
- [ ] `permuteo` `l` `p`permutation of list (deferred to Phase 5 with `matche`)
- [x] `lengtho` `l` `n` — length as a relation, Peano-encoded:
`:z` / `(:s :z)` / `(:s (:s :z))` ... matches TRS. Forward is direct;
backward enumerates lists of a given length.
- [x] Tests: run each relation forwards and backwards (so far 25 in
`tests/relations.sx`; reverseo/flatteno/permuteo/lengtho deferred)
### Phase 5 — `project` + `matche` + negation
- [ ] `project` `(x ...) body`access reified values of logic vars inside a goal;
escapes to ground values for arithmetic or string ops
- [x] `project` `(x ...) body`defmacro: rebinds named vars to `(mk-walk* var s)`
in the body's lexical scope, then runs `(mk-conj body...)` on the same
substitution. Hygienic via gensym'd `s`-param. (`Phase 5 piece B`)
- [ ] `matche` — pattern matching over logic terms (extension from core.logic)
`(matche l ((head . tail) goal) (() goal))`
- [ ] `conda` — soft-cut disjunction (like Prolog `->`)
- [ ] `condu` — committed choice (already in phase 2; refine semantics here)
- [ ] `nafc` — negation as finite failure with constraint
- [x] `conda` — soft-cut: first non-failing head wins; ALL of head's answers
flow through rest-goals; later clauses not tried (`Phase 5 piece A`)
- [x] `condu` — committed choice (Phase 2)
- [x] `nafc` — negation as finite failure: `(nafc g)` yields the input subst
iff g has zero answers. Standard caveats apply (open-world unsoundness;
diverges if g is infinite). `Phase 5 piece C`.
- [ ] Tests: Zebra puzzle, N-queens, Sudoku via `project`, family relations via `matche`
### Phase 6 — arithmetic constraints CLP(FD)
@@ -135,4 +159,72 @@ _(none yet)_
_Newest first._
_(awaiting phase 1)_
- **2026-05-07** — **Phase 5 piece C — nafc**: `lib/minikanren/nafc.sx`. Three-line
primitive: stream-take 1; if empty, `(unit s)`, else `mzero`. 7 tests including
double-negation and use as a guard. 201/201 cumulative.
- **2026-05-07** — **Phase 5 piece B — project**: `lib/minikanren/project.sx`
defmacro that walks each named var, rebinds them, and runs the body's mk-conj.
Demonstrated escape into host arithmetic / string ops (`(* n n)`, `(str s "!")`).
Hygienic gensym'd s-param. 6 new tests, 194/194 cumulative.
- **2026-05-07** — **Peano arithmetic** (`lib/minikanren/peano.sx`): zeroo, pluso,
minuso, lteo, lto, *o on Peano-encoded naturals (`:z` / `(:s n)`). pluso runs
forward, backward, and enumerates: `(run* q (fresh (a b) (pluso a b 3)
(== q (list a b))))` → all 4 pairs summing to 3. *o uses repeated pluso —
works for small inputs, slower for larger. 19 new tests, 188/188 cumulative.
- **2026-05-07** — **Phase 5 piece A — conda**: soft-cut. Mirrors `condu` minus
the `onceo` on the head: all head answers are conjuncted through the rest of
the chosen clause. 7 new tests including the conda-vs-condu divergence test.
169/169 cumulative.
- **2026-05-07** — **Phase 4 piece B — reverseo + lengtho**: reverseo runs forward
cleanly and `run 1`-cleanly backward; lengtho uses Peano-encoded lengths so it
works as a true relation in both directions (tests use the encoding directly).
10 new tests, 162/162 cumulative.
- **2026-05-07** — **Phase 4 piece A — appendo canary green**: cons-cell support
in `unify.sx` + `(:s head tail)` lazy stream refactor in `stream.sx` + hygienic
`Zzz` (gensym'd subst-name) wrapping each `conde` clause + `lib/minikanren/
relations.sx` with `nullo` / `pairo` / `caro` / `cdro` / `conso` / `firsto` /
`resto` / `listo` / `appendo` / `membero`. 25 new tests in `tests/relations.sx`,
152/152 cumulative.
- **Three deep fixes shipped together**, all required to make `appendo`
terminate in both directions:
1. SX has no improper pairs, so a stream cell of mature subst + thunk
tail can't use `cons` — moved to a `(:s head tail)` tagged shape.
2. `(Zzz g)` wrapped its inner fn in a parameter named `s`, capturing
the user goal's own `s` binding (the `(appendo l s ls)` convention).
Replaced with `(gensym "zzz-s-")` for hygiene.
3. SX cons cells `(:cons h t)` for relational decomposition (so
`(conso a d l)` can split a list by head/tail without proper
improper pairs); `mk-walk*` re-flattens cons cells back to native
lists for clean reification output.
- **2026-05-07** — **Phase 3 done** (run + reification): `lib/minikanren/run.sx` (~28 lines).
`reify`/`reify-s`/`reify-name` for canonical `_.N` rendering of unbound vars in
left-to-right occurrence order; `run*` / `run` / `run-n` defmacros. 18 new tests
in `tests/run.sx`, including the **first classic miniKanren tests green**:
`(run* q (== q 1))``(1)`; `(run* q (fresh (x y) (== q (list x y))))`
`((_.0 _.1))`. 128/128 cumulative.
- **2026-05-07** — **Phase 2 piece D + done** (`condu` / `onceo`): `lib/minikanren/condu.sx`.
Both are commitment forms: `onceo` is `(stream-take 1 ...)`; `condu` walks clauses
and commits the first one whose head produces an answer. 10 tests in `tests/condu.sx`,
110/110 cumulative. Phase 2 complete — ready for Phase 3 (run + reification).
- **2026-05-07** — **Phase 2 piece C** (`conde`): `lib/minikanren/conde.sx` — single
defmacro folding clauses through `mk-disj` with internal `mk-conj`. 9 tests in
`tests/conde.sx`, 100/100 cumulative. Confirmed eager DFS ordering for ==-only
streams; true interleaving is a Phase 4 concern (paused thunks under recursion).
- **2026-05-07** — **Phase 2 piece B** (`fresh`): `lib/minikanren/fresh.sx` (~10 lines).
defmacro form for nice user-facing syntax + `call-fresh` for programmatic use.
9 new tests in `tests/fresh.sx`, 91/91 cumulative.
- **2026-05-07** — **Phase 2 piece A** (streams + ==/conj/disj): `lib/minikanren/stream.sx`
(mzero/unit/mk-mplus/mk-bind/stream-take, ~25 lines of code) + `lib/minikanren/goals.sx`
(succeed/fail/==/==-check/conj2/disj2/mk-conj/mk-disj, ~30 lines). Found and noted
a host-primitive name clash: `bind` is built in and silently shadows user defines —
must use `mk-bind`/`mk-mplus` etc. throughout. 34 tests in `tests/goals.sx`,
82/82 cumulative all green. fresh/conde/condu/onceo still pending.
- **2026-05-07** — **Phase 1 done**: `lib/minikanren/unify.sx` (53 lines, ~22 lines of actual code) +
`lib/minikanren/tests/unify.sx` (48 tests, all green). Kit consumption: `walk-with`,
`unify-with`, `occurs-with`, `extend`, `empty-subst`, `mk-var`, `is-var?`, `var-name`
all supplied by `lib/guest/match.sx`. Local additions: a miniKanren-flavoured cfg
(treats native SX lists as cons-pairs via `:ctor-head = :pair`, occurs-check off),
`make-var` fresh-counter, deep `mk-walk*` (kit's `walk*` only recurses into `:ctor`
form, not native lists), and `mk-unify` / `mk-unify-check` thin wrappers. The kit
earns its keep ~3× over by line count — confirms lib-guest match kit is reusable
for logic-language hosts as designed.