From f13e03e6251a7ae22d955ecf527271a8fa0f6ea6 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:45:47 +0000 Subject: [PATCH 01/84] =?UTF-8?q?mk:=20phase=201=20=E2=80=94=20unify.sx=20?= =?UTF-8?q?+=2048=20tests,=20kit-driven?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/tests/unify.sx | 293 ++++++++++++++++++++++++++++++++++ lib/minikanren/unify.sx | 52 ++++++ plans/minikanren-on-sx.md | 24 ++- 3 files changed, 361 insertions(+), 8 deletions(-) create mode 100644 lib/minikanren/tests/unify.sx create mode 100644 lib/minikanren/unify.sx diff --git a/lib/minikanren/tests/unify.sx b/lib/minikanren/tests/unify.sx new file mode 100644 index 00000000..3bec755b --- /dev/null +++ b/lib/minikanren/tests/unify.sx @@ -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!) diff --git a/lib/minikanren/unify.sx b/lib/minikanren/unify.sx new file mode 100644 index 00000000..f043dc48 --- /dev/null +++ b/lib/minikanren/unify.sx @@ -0,0 +1,52 @@ +;; lib/minikanren/unify.sx — Phase 1: variables + unification. +;; +;; 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 shape (designed for natural SX use): +;; logic var : (:var NAME) — kit's mk-var +;; pair : any non-empty SX list — head + tail unified positionally +;; atom : number / string / symbol / boolean / nil / () +;; Substitution: SX dict mapping VAR-NAME → term. Empty = (empty-subst). + +(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) 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-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))) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 734a8a2c..1e5890a6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -50,15 +50,15 @@ 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)`), @@ -135,4 +135,12 @@ _(none yet)_ _Newest first._ -_(awaiting phase 1)_ +- **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. From 0ba60d6a25f4cd4f03dceb29e54d42221fc18bdb Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:54:43 +0000 Subject: [PATCH 02/84] =?UTF-8?q?mk:=20phase=202A=20=E2=80=94=20streams=20?= =?UTF-8?q?+=20=3D=3D/conj/disj,=2034=20new=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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). --- lib/minikanren/goals.sx | 58 +++++++++ lib/minikanren/stream.sx | 58 +++++++++ lib/minikanren/tests/goals.sx | 216 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 28 +++-- 4 files changed, 352 insertions(+), 8 deletions(-) create mode 100644 lib/minikanren/goals.sx create mode 100644 lib/minikanren/stream.sx create mode 100644 lib/minikanren/tests/goals.sx diff --git a/lib/minikanren/goals.sx b/lib/minikanren/goals.sx new file mode 100644 index 00000000..6f6cc227 --- /dev/null +++ b/lib/minikanren/goals.sx @@ -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))) diff --git a/lib/minikanren/stream.sx b/lib/minikanren/stream.sx new file mode 100644 index 00000000..11da7b2a --- /dev/null +++ b/lib/minikanren/stream.sx @@ -0,0 +1,58 @@ +;; lib/minikanren/stream.sx — Phase 2 piece A: lazy streams of substitutions. +;; +;; Three stream shapes per The Reasoned Schemer (chapter 9): +;; mzero — empty stream (the SX empty list) +;; mature — '(s . rest) (a proper SX list of substitutions) +;; immature — a thunk (an SX lambda taking zero args, returns a stream) +;; +;; Immature thunks are how miniKanren keeps search lazy and supports +;; interleaved disjunction without diverging on left-recursive relations. +;; SX has plain function closures, so a thunk is just (fn () body). +;; +;; Names are mk-prefixed: SX has a host primitive `bind` that would shadow +;; a user-level definition. + +(define mzero (list)) + +(define unit (fn (s) (list s))) + +(define stream-pause? (fn (s) (and (not (list? s)) (callable? s)))) + +;; mk-mplus — interleave two streams. If the first is mature/empty we use it +;; directly; if it is paused, we suspend and swap so the other stream gets +;; explored fairly (Reasoned Schemer "interleave"). +(define + mk-mplus + (fn + (s1 s2) + (cond + ((empty? s1) s2) + ((stream-pause? s1) (fn () (mk-mplus s2 (s1)))) + (:else (cons (first s1) (mk-mplus (rest s1) s2)))))) + +;; mk-bind — apply goal g to every substitution in stream s, mk-mplus-ing results. +(define + mk-bind + (fn + (s g) + (cond + ((empty? s) mzero) + ((stream-pause? s) (fn () (mk-bind (s) g))) + (:else (mk-mplus (g (first s)) (mk-bind (rest s) g)))))) + +;; stream-take — force up to n results out of a (possibly lazy) stream. +;; n = -1 to take all (used by run*). +(define + stream-take + (fn + (n s) + (cond + ((= n 0) (list)) + ((empty? s) (list)) + ((stream-pause? s) (stream-take n (s))) + (:else + (cons + (first s) + (stream-take + (if (= n -1) -1 (- n 1)) + (rest s))))))) diff --git a/lib/minikanren/tests/goals.sx b/lib/minikanren/tests/goals.sx new file mode 100644 index 00000000..f08a9c5c --- /dev/null +++ b/lib/minikanren/tests/goals.sx @@ -0,0 +1,216 @@ +;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx. +;; +;; Loaded after: lib/guest/match.sx, lib/minikanren/unify.sx, +;; lib/minikanren/stream.sx, lib/minikanren/goals.sx. +;; Reuses the mk-test* counters from tests/unify.sx — load that first to +;; accumulate, or call mk-tests-run! after this file alone for fresh totals. + +;; --- stream-take base cases --- + +(mk-test + "stream-take-zero-from-mature" + (stream-take 0 (list 1 2 3)) + (list)) + +(mk-test "stream-take-from-empty" (stream-take 5 mzero) (list)) + +(mk-test + "stream-take-mature-list" + (stream-take 5 (list 1 2 3)) + (list 1 2 3)) + +(mk-test + "stream-take-fewer-than-available" + (stream-take 2 (list 10 20 30)) + (list 10 20)) + +(mk-test + "stream-take-all-with-neg-1" + (stream-take -1 (list 1 2 3 4)) + (list 1 2 3 4)) + +;; --- stream-take forces immature thunks --- + +(mk-test + "stream-take-forces-thunk" + (stream-take 3 (fn () (list "a" "b" "c"))) + (list "a" "b" "c")) + +(mk-test + "stream-take-forces-nested-thunks" + (stream-take + 3 + (fn () (fn () (list 1 2 3)))) + (list 1 2 3)) + +;; --- mk-mplus interleaves --- + +(mk-test + "mplus-empty-left" + (mk-mplus mzero (list 1 2)) + (list 1 2)) +(mk-test + "mplus-empty-right" + (mk-mplus (list 1 2) mzero) + (list 1 2)) + +(mk-test + "mplus-mature-mature" + (mk-mplus (list 1 2) (list 3 4)) + (list 1 2 3 4)) + +(mk-test + "mplus-with-paused-left-swaps" + (stream-take 4 (mk-mplus (fn () (list "a" "b")) (list "c" "d"))) + (list "c" "d" "a" "b")) + +;; --- mk-bind --- + +(mk-test "bind-empty-stream" (mk-bind mzero (fn (s) (unit s))) (list)) + +(mk-test + "bind-singleton-identity" + (mk-bind (list 5) (fn (x) (list x))) + (list 5)) + +(mk-test + "bind-flat-multi" + (mk-bind + (list 1 2) + (fn (x) (list x (* x 10)))) + (list 1 10 2 20)) + +(mk-test + "bind-fail-prunes-some" + (mk-bind + (list 1 2 3) + (fn (x) (if (= x 2) (list) (list x)))) + (list 1 3)) + +;; --- core goals: succeed / fail --- + +(mk-test "succeed-yields-singleton" (succeed empty-s) (list empty-s)) + +(mk-test "fail-yields-mzero" (fail empty-s) (list)) + +;; --- == --- + +(mk-test + "eq-ground-success" + (mk-unified? (first ((== 1 1) empty-s))) + true) + +(mk-test "eq-ground-failure" ((== 1 2) empty-s) (list)) + +(mk-test + "eq-binds-var" + (let + ((x (mk-var "x"))) + (mk-walk x (first ((== x 7) empty-s)))) + 7) + +(mk-test + "eq-list-success" + (let + ((x (mk-var "x"))) + (mk-walk x (first ((== x (list 1 2)) empty-s)))) + (list 1 2)) + +(mk-test + "eq-list-mismatch-fails" + ((== (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 ((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"))) + ((conj2 (== x 1) (== x 2)) empty-s)) + (list)) + +(mk-test "conj-empty-is-succeed" ((mk-conj) empty-s) (list empty-s)) + +(mk-test + "conj-single-is-goal" + (let + ((x (mk-var "x"))) + (mk-walk x (first ((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 ((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" ((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 (distributivity check) --- + +(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 (occurs-checked equality goal) --- + +(mk-test + "eq-check-no-occurs-fails" + (let ((x (mk-var "x"))) ((==-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 ((==-check x 5) empty-s)))) + 5) + +(mk-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 1e5890a6..0e2243c6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -61,14 +61,20 @@ Key semantic mappings: - [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 +- [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) +- [ ] `fresh` — introduces logic variables inside a goal body +- [ ] `conde` — sugar over disj+conj, one row per clause +- [ ] `condu` — committed choice (soft-cut) - [ ] `onceo` — succeeds at most once - [ ] Tests: basic goal composition, backtracking, interleaving @@ -135,6 +141,12 @@ _(none yet)_ _Newest first._ +- **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` From f43ad04f91272ce094fc95a88c50c0313dafce04 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:56:40 +0000 Subject: [PATCH 03/84] =?UTF-8?q?mk:=20phase=202B=20=E2=80=94=20fresh,=20d?= =?UTF-8?q?efmacro=20form=20+=20call-fresh?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (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. --- lib/minikanren/fresh.sx | 23 ++++++++ lib/minikanren/tests/fresh.sx | 101 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 7 ++- 3 files changed, 130 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/fresh.sx create mode 100644 lib/minikanren/tests/fresh.sx diff --git a/lib/minikanren/fresh.sx b/lib/minikanren/fresh.sx new file mode 100644 index 00000000..e10abb5c --- /dev/null +++ b/lib/minikanren/fresh.sx @@ -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)))) diff --git a/lib/minikanren/tests/fresh.sx b/lib/minikanren/tests/fresh.sx new file mode 100644 index 00000000..e4df2bda --- /dev/null +++ b/lib/minikanren/tests/fresh.sx @@ -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" + ((fresh () (== 1 1)) empty-s) + (list empty-s)) + +(mk-test + "fresh-empty-vars-no-goals-is-succeed" + ((fresh ()) empty-s) + (list empty-s)) + +;; --- single var --- + +(mk-test + "fresh-one-var-bound" + (let + ((s (first ((fresh (x) (== x 7)) empty-s)))) + (let ((vs (vals s))) (first vs))) + 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 (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 (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 (g empty-s)))) + (list 1 2)) + +;; --- call-fresh (functional alternative) --- + +(mk-test + "call-fresh-binds-and-walks" + (let + ((s (first ((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 (g empty-s))))) + (list 5 5)) + +(mk-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 0e2243c6..9236d449 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -72,7 +72,9 @@ Key semantic mappings: - [x] `conj2` / `mk-conj` (variadic) — sequential conjunction - [x] `disj2` / `mk-disj` (variadic) — interleaved disjunction (raw — `conde` adds the implicit-conj-per-clause sugar later) -- [ ] `fresh` — introduces logic variables inside a goal body +- [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. - [ ] `conde` — sugar over disj+conj, one row per clause - [ ] `condu` — committed choice (soft-cut) - [ ] `onceo` — succeeds at most once @@ -141,6 +143,9 @@ _(none yet)_ _Newest first._ +- **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 From c754a8ee059baaa2b8b7541ad329b6a0d5474543 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:59:17 +0000 Subject: [PATCH 04/84] =?UTF-8?q?mk:=20phase=202C=20=E2=80=94=20conde,=20t?= =?UTF-8?q?he=20canonical=20and-or=20sugar?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/conde.sx | 20 ++++++++ lib/minikanren/tests/conde.sx | 93 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 9 +++- 3 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/conde.sx create mode 100644 lib/minikanren/tests/conde.sx diff --git a/lib/minikanren/conde.sx b/lib/minikanren/conde.sx new file mode 100644 index 00000000..ffcb9a28 --- /dev/null +++ b/lib/minikanren/conde.sx @@ -0,0 +1,20 @@ +;; lib/minikanren/conde.sx — Phase 2 piece C: `conde`, the canonical +;; miniKanren and-or form. +;; +;; (conde (g1a g1b ...) (g2a g2b ...) ...) +;; ≡ (mk-disj (mk-conj g1a g1b ...) +;; (mk-conj g2a g2b ...) ...) +;; +;; Each clause is a list of goals, conj'd internally; clauses are disj'd +;; among one another (interleaved via mk-mplus, so left-recursive +;; relations don't starve the right-hand clauses). + +(defmacro + conde + (&rest clauses) + (quasiquote + (mk-disj + (splice-unquote + (map + (fn (clause) (quasiquote (mk-conj (splice-unquote clause)))) + clauses))))) diff --git a/lib/minikanren/tests/conde.sx b/lib/minikanren/tests/conde.sx new file mode 100644 index 00000000..ec761064 --- /dev/null +++ b/lib/minikanren/tests/conde.sx @@ -0,0 +1,93 @@ +;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`. +;; +;; Note on ordering: mk-mplus only interleaves when the left stream is a +;; paused thunk. Eager streams from == compose via mature DFS order +;; (left-clause results first, then right-clause). True interleaving is +;; tested in Phase 4 via recursive relations. + +;; --- single-clause conde ≡ conj of clause body --- + +(mk-test + "conde-one-clause" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 5 ((conde ((== q 7))) empty-s)))) + (map (fn (s) (mk-walk q s)) res))) + (list 7)) + +(mk-test + "conde-one-clause-multi-goals" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 5 ((conde ((fresh (x) (== x 5) (== q (list x x))))) empty-s)))) + (map (fn (s) (mk-walk* q s)) res))) + (list (list 5 5))) + +;; --- multi-clause: produces one row per clause (eager DFS order) --- + +(mk-test + "conde-three-clauses" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 10 ((conde ((== q 1)) ((== q 2)) ((== q 3))) empty-s)))) + (map (fn (s) (mk-walk q s)) res))) + (list 1 2 3)) + +(mk-test + "conde-mixed-success-failure" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 10 ((conde ((== q "a")) ((== 1 2)) ((== q "b"))) empty-s)))) + (map (fn (s) (mk-walk q s)) res))) + (list "a" "b")) + +;; --- conde with conjuncts inside clauses --- + +(mk-test + "conde-clause-conj" + (let + ((q (mk-var "q")) (r (mk-var "r"))) + (let + ((res (stream-take 10 ((conde ((== q 1) (== r 10)) ((== q 2) (== r 20))) empty-s)))) + (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res))) + (list (list 1 10) (list 2 20))) + +;; --- conde + fresh: multiple solutions per clause --- + +(mk-test + "conde-with-fresh-and-disj" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 10 ((conde ((fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))) ((== q 100))) empty-s)))) + (map (fn (s) (mk-walk q s)) res))) + (list 1 2 100)) + +;; --- nested conde --- + +(mk-test + "conde-nested" + (let + ((q (mk-var "q"))) + (let + ((res (stream-take 10 ((conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))) empty-s)))) + (map (fn (s) (mk-walk q s)) res))) + (list 1 2 3)) + +;; --- conde all clauses fail → empty stream --- + +(mk-test + "conde-all-fail" + ((conde ((== 1 2)) ((== 3 4))) + empty-s) + (list)) + +;; --- empty conde: no clauses ⇒ fail --- + +(mk-test "conde-no-clauses" ((conde) empty-s) (list)) + +(mk-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 9236d449..4d4d0de7 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -75,7 +75,10 @@ Key semantic mappings: - [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. -- [ ] `conde` — sugar over disj+conj, one row per clause +- [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). - [ ] `condu` — committed choice (soft-cut) - [ ] `onceo` — succeeds at most once - [ ] Tests: basic goal composition, backtracking, interleaving @@ -143,6 +146,10 @@ _(none yet)_ _Newest first._ +- **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. From 2de6727e8367b8bad33a8bb4980f6f4f72eea087 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 20:01:10 +0000 Subject: [PATCH 05/84] =?UTF-8?q?mk:=20phase=202D=20=E2=80=94=20condu=20+?= =?UTF-8?q?=20onceo,=20phase=202=20complete?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/condu.sx | 52 +++++++++++++++++++++ lib/minikanren/tests/condu.sx | 86 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 12 +++-- 3 files changed, 147 insertions(+), 3 deletions(-) create mode 100644 lib/minikanren/condu.sx create mode 100644 lib/minikanren/tests/condu.sx diff --git a/lib/minikanren/condu.sx b/lib/minikanren/condu.sx new file mode 100644 index 00000000..6cd223f1 --- /dev/null +++ b/lib/minikanren/condu.sx @@ -0,0 +1,52 @@ +;; 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.) +;; +;; `conda` (the variant that propagates ALL answers of the head) lives in +;; Phase 5 with `project` and `matche`. + +(define onceo (fn (g) (fn (s) (stream-take 1 (g s))))) + +;; 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, falls to 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)))) diff --git a/lib/minikanren/tests/condu.sx b/lib/minikanren/tests/condu.sx new file mode 100644 index 00000000..f19deb07 --- /dev/null +++ b/lib/minikanren/tests/condu.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 4d4d0de7..344bcb77 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -79,9 +79,11 @@ Key semantic mappings: 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). -- [ ] `condu` — committed choice (soft-cut) -- [ ] `onceo` — succeeds at most once -- [ ] Tests: basic goal composition, backtracking, interleaving +- [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) @@ -146,6 +148,10 @@ _(none yet)_ _Newest first._ +- **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 From 52070e07fc00cde97c8ca87e840eda15d8907df7 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 20:03:42 +0000 Subject: [PATCH 06/84] =?UTF-8?q?mk:=20phase=203=20=E2=80=94=20run*=20/=20?= =?UTF-8?q?run=20/=20reify,=2018=20new=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/run.sx | 56 ++++++++++++++++++ lib/minikanren/tests/run.sx | 114 ++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 25 +++++--- 3 files changed, 187 insertions(+), 8 deletions(-) create mode 100644 lib/minikanren/run.sx create mode 100644 lib/minikanren/tests/run.sx diff --git a/lib/minikanren/run.sx b/lib/minikanren/run.sx new file mode 100644 index 00000000..811eebc5 --- /dev/null +++ b/lib/minikanren/run.sx @@ -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)))) diff --git a/lib/minikanren/tests/run.sx b/lib/minikanren/tests/run.sx new file mode 100644 index 00000000..c25a49e4 --- /dev/null +++ b/lib/minikanren/tests/run.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 344bcb77..f833e2bf 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -86,15 +86,18 @@ Key semantic mappings: - [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 @@ -148,6 +151,12 @@ _(none yet)_ _Newest first._ +- **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`, From cae87c1e2cd8d18afec5cf110c99067aa74cb46c Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 20:24:42 +0000 Subject: [PATCH 07/84] =?UTF-8?q?mk:=20phase=204A=20=E2=80=94=20appendo=20?= =?UTF-8?q?canary=20green,=20both=20directions?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/conde.sx | 33 ++++-- lib/minikanren/condu.sx | 20 ++-- lib/minikanren/relations.sx | 51 +++++++++ lib/minikanren/stream.sx | 48 ++++---- lib/minikanren/tests/conde.sx | 98 ++++++++--------- lib/minikanren/tests/fresh.sx | 18 +-- lib/minikanren/tests/goals.sx | 152 +++++++++++++++++--------- lib/minikanren/tests/relations.sx | 175 ++++++++++++++++++++++++++++++ lib/minikanren/unify.sx | 42 ++++++- plans/minikanren-on-sx.md | 38 +++++-- 10 files changed, 511 insertions(+), 164 deletions(-) create mode 100644 lib/minikanren/relations.sx create mode 100644 lib/minikanren/tests/relations.sx diff --git a/lib/minikanren/conde.sx b/lib/minikanren/conde.sx index ffcb9a28..b09eb0b4 100644 --- a/lib/minikanren/conde.sx +++ b/lib/minikanren/conde.sx @@ -1,13 +1,30 @@ ;; lib/minikanren/conde.sx — Phase 2 piece C: `conde`, the canonical -;; miniKanren and-or form. +;; miniKanren and-or form, with implicit Zzz inverse-eta delay so recursive +;; relations like appendo terminate. ;; ;; (conde (g1a g1b ...) (g2a g2b ...) ...) -;; ≡ (mk-disj (mk-conj g1a g1b ...) -;; (mk-conj g2a g2b ...) ...) +;; ≡ (mk-disj (Zzz (mk-conj g1a g1b ...)) +;; (Zzz (mk-conj g2a g2b ...)) ...) ;; -;; Each clause is a list of goals, conj'd internally; clauses are disj'd -;; among one another (interleaved via mk-mplus, so left-recursive -;; relations don't starve the right-hand clauses). +;; `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 @@ -16,5 +33,7 @@ (mk-disj (splice-unquote (map - (fn (clause) (quasiquote (mk-conj (splice-unquote clause)))) + (fn + (clause) + (quasiquote (Zzz (mk-conj (splice-unquote clause))))) clauses))))) diff --git a/lib/minikanren/condu.sx b/lib/minikanren/condu.sx index 6cd223f1..3c24b1d9 100644 --- a/lib/minikanren/condu.sx +++ b/lib/minikanren/condu.sx @@ -10,15 +10,21 @@ ;; 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.) -;; -;; `conda` (the variant that propagates ALL answers of the head) lives in -;; Phase 5 with `project` and `matche`. -(define onceo (fn (g) (fn (s) (stream-take 1 (g s))))) +(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, falls to next clause; -;; if head succeeds, commits its single answer through the rest of the clause. +;; 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 diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx new file mode 100644 index 00000000..b9f38732 --- /dev/null +++ b/lib/minikanren/relations.sx @@ -0,0 +1,51 @@ +;; 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)))))) diff --git a/lib/minikanren/stream.sx b/lib/minikanren/stream.sx index 11da7b2a..04173707 100644 --- a/lib/minikanren/stream.sx +++ b/lib/minikanren/stream.sx @@ -1,26 +1,34 @@ ;; lib/minikanren/stream.sx — Phase 2 piece A: lazy streams of substitutions. ;; -;; Three stream shapes per The Reasoned Schemer (chapter 9): -;; mzero — empty stream (the SX empty list) -;; mature — '(s . rest) (a proper SX list of substitutions) -;; immature — a thunk (an SX lambda taking zero args, returns a stream) +;; SX has no improper pairs (cons requires a list cdr), so we use a +;; tagged stream-cell shape for mature stream elements: ;; -;; Immature thunks are how miniKanren keeps search lazy and supports -;; interleaved disjunction without diverging on left-recursive relations. -;; SX has plain function closures, so a thunk is just (fn () body). +;; stream ::= mzero empty (the SX empty list) +;; | (:s HEAD TAIL) mature cell, TAIL is a stream +;; | thunk (fn () ...) → stream when forced ;; -;; Names are mk-prefixed: SX has a host primitive `bind` that would shadow -;; a user-level definition. +;; 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 unit (fn (s) (list s))) +(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 the first is mature/empty we use it -;; directly; if it is paused, we suspend and swap so the other stream gets -;; explored fairly (Reasoned Schemer "interleave"). +;; 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 @@ -28,9 +36,9 @@ (cond ((empty? s1) s2) ((stream-pause? s1) (fn () (mk-mplus s2 (s1)))) - (:else (cons (first s1) (mk-mplus (rest s1) s2)))))) + (: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 results. +;; mk-bind — apply goal g to every substitution in stream s, mk-mplus-ing. (define mk-bind (fn @@ -38,10 +46,10 @@ (cond ((empty? s) mzero) ((stream-pause? s) (fn () (mk-bind (s) g))) - (:else (mk-mplus (g (first s)) (mk-bind (rest 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. -;; n = -1 to take all (used by run*). +;; 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 @@ -52,7 +60,7 @@ ((stream-pause? s) (stream-take n (s))) (:else (cons - (first s) + (s-car s) (stream-take (if (= n -1) -1 (- n 1)) - (rest s))))))) + (s-cdr s))))))) diff --git a/lib/minikanren/tests/conde.sx b/lib/minikanren/tests/conde.sx index ec761064..681f372b 100644 --- a/lib/minikanren/tests/conde.sx +++ b/lib/minikanren/tests/conde.sx @@ -1,93 +1,89 @@ ;; lib/minikanren/tests/conde.sx — Phase 2 piece C tests for `conde`. ;; -;; Note on ordering: mk-mplus only interleaves when the left stream is a -;; paused thunk. Eager streams from == compose via mature DFS order -;; (left-clause results first, then right-clause). True interleaving is -;; tested in Phase 4 via recursive relations. +;; 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"))) - (let - ((res (stream-take 5 ((conde ((== q 7))) empty-s)))) - (map (fn (s) (mk-walk q s)) res))) + (let ((q (mk-var "q"))) (run* q (conde ((== q 7))))) (list 7)) (mk-test "conde-one-clause-multi-goals" (let ((q (mk-var "q"))) - (let - ((res (stream-take 5 ((conde ((fresh (x) (== x 5) (== q (list x x))))) empty-s)))) - (map (fn (s) (mk-walk* q s)) res))) + (run* q (conde ((fresh (x) (== x 5) (== q (list x x))))))) (list (list 5 5))) -;; --- multi-clause: produces one row per clause (eager DFS order) --- +;; --- multi-clause: produces one row per clause (interleaved) --- (mk-test - "conde-three-clauses" + "conde-three-clauses-as-set" (let - ((q (mk-var "q"))) - (let - ((res (stream-take 10 ((conde ((== q 1)) ((== q 2)) ((== q 3))) empty-s)))) - (map (fn (s) (mk-walk q s)) res))) - (list 1 2 3)) + ((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" + "conde-mixed-success-failure-as-set" (let - ((q (mk-var "q"))) - (let - ((res (stream-take 10 ((conde ((== q "a")) ((== 1 2)) ((== q "b"))) empty-s)))) - (map (fn (s) (mk-walk q s)) res))) - (list "a" "b")) + ((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" + "conde-clause-conj-as-set" (let - ((q (mk-var "q")) (r (mk-var "r"))) - (let - ((res (stream-take 10 ((conde ((== q 1) (== r 10)) ((== q 2) (== r 20))) empty-s)))) - (map (fn (s) (list (mk-walk q s) (mk-walk r s))) res))) - (list (list 1 10) (list 2 20))) - -;; --- conde + fresh: multiple solutions per clause --- - -(mk-test - "conde-with-fresh-and-disj" - (let - ((q (mk-var "q"))) - (let - ((res (stream-take 10 ((conde ((fresh (x) (mk-disj (== x 1) (== x 2)) (== q x))) ((== q 100))) empty-s)))) - (map (fn (s) (mk-walk q s)) res))) - (list 1 2 100)) + ((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" + "conde-nested-yields-three" (let - ((q (mk-var "q"))) - (let - ((res (stream-take 10 ((conde ((conde ((== q 1)) ((== q 2)))) ((== q 3))) empty-s)))) - (map (fn (s) (mk-walk q s)) res))) - (list 1 2 3)) + ((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" - ((conde ((== 1 2)) ((== 3 4))) - empty-s) + (run* + q + (conde ((== 1 2)) ((== 3 4)))) (list)) ;; --- empty conde: no clauses ⇒ fail --- -(mk-test "conde-no-clauses" ((conde) empty-s) (list)) +(mk-test "conde-no-clauses" (run* q (conde)) (list)) (mk-tests-run!) diff --git a/lib/minikanren/tests/fresh.sx b/lib/minikanren/tests/fresh.sx index e4df2bda..fd912c55 100644 --- a/lib/minikanren/tests/fresh.sx +++ b/lib/minikanren/tests/fresh.sx @@ -4,12 +4,12 @@ (mk-test "fresh-empty-vars-equiv-conj" - ((fresh () (== 1 1)) empty-s) + (stream-take 5 ((fresh () (== 1 1)) empty-s)) (list empty-s)) (mk-test "fresh-empty-vars-no-goals-is-succeed" - ((fresh ()) empty-s) + (stream-take 5 ((fresh ()) empty-s)) (list empty-s)) ;; --- single var --- @@ -17,8 +17,8 @@ (mk-test "fresh-one-var-bound" (let - ((s (first ((fresh (x) (== x 7)) empty-s)))) - (let ((vs (vals s))) (first vs))) + ((s (first (stream-take 5 ((fresh (x) (== x 7)) empty-s))))) + (first (vals s))) 7) ;; --- multiple vars + multiple goals --- @@ -33,7 +33,7 @@ (== x 10) (== y 20) (== q (list x y))))) - (mk-walk* q (first (g empty-s)))) + (mk-walk* q (first (stream-take 5 (g empty-s))))) (list 10 20)) (mk-test @@ -47,7 +47,7 @@ (== b 2) (== c 3) (== q (list a b c))))) - (mk-walk* q (first (g empty-s)))) + (mk-walk* q (first (stream-take 5 (g empty-s))))) (list 1 2 3)) ;; --- fresh interacts with disj --- @@ -77,7 +77,7 @@ (== x 1) (== y 2) (== q (list x y)))))) - (mk-walk* q (first (g empty-s)))) + (mk-walk* q (first (stream-take 5 (g empty-s))))) (list 1 2)) ;; --- call-fresh (functional alternative) --- @@ -85,7 +85,7 @@ (mk-test "call-fresh-binds-and-walks" (let - ((s (first ((call-fresh (fn (x) (== x 99))) empty-s)))) + ((s (first (stream-take 5 ((call-fresh (fn (x) (== x 99))) empty-s))))) (first (vals s))) 99) @@ -95,7 +95,7 @@ ((q (mk-var "q"))) (let ((g (call-fresh (fn (x) (mk-conj (== x 5) (== q (list x x))))))) - (mk-walk* q (first (g empty-s))))) + (mk-walk* q (first (stream-take 5 (g empty-s)))))) (list 5 5)) (mk-tests-run!) diff --git a/lib/minikanren/tests/goals.sx b/lib/minikanren/tests/goals.sx index f08a9c5c..150b0650 100644 --- a/lib/minikanren/tests/goals.sx +++ b/lib/minikanren/tests/goals.sx @@ -1,124 +1,153 @@ ;; lib/minikanren/tests/goals.sx — Phase 2 tests for stream.sx + goals.sx. ;; -;; Loaded after: lib/guest/match.sx, lib/minikanren/unify.sx, -;; lib/minikanren/stream.sx, lib/minikanren/goals.sx. -;; Reuses the mk-test* counters from tests/unify.sx — load that first to -;; accumulate, or call mk-tests-run! after this file alone for fresh totals. +;; 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 --- +;; --- stream-take base cases (input streams use s-cons / mzero) --- (mk-test "stream-take-zero-from-mature" - (stream-take 0 (list 1 2 3)) + (stream-take 0 (s-cons (empty-subst) mzero)) (list)) -(mk-test "stream-take-from-empty" (stream-take 5 mzero) (list)) +(mk-test "stream-take-from-mzero" (stream-take 5 mzero) (list)) (mk-test - "stream-take-mature-list" - (stream-take 5 (list 1 2 3)) - (list 1 2 3)) + "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 2 (list 10 20 30)) - (list 10 20)) + (stream-take 1 (s-cons :a (s-cons :b mzero))) + (list :a)) (mk-test "stream-take-all-with-neg-1" - (stream-take -1 (list 1 2 3 4)) - (list 1 2 3 4)) + (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 3 (fn () (list "a" "b" "c"))) - (list "a" "b" "c")) + (stream-take 5 (fn () (s-cons :x mzero))) + (list :x)) (mk-test "stream-take-forces-nested-thunks" - (stream-take - 3 - (fn () (fn () (list 1 2 3)))) - (list 1 2 3)) + (stream-take 5 (fn () (fn () (s-cons :y mzero)))) + (list :y)) ;; --- mk-mplus interleaves --- (mk-test "mplus-empty-left" - (mk-mplus mzero (list 1 2)) - (list 1 2)) + (stream-take 5 (mk-mplus mzero (s-cons :r mzero))) + (list :r)) + (mk-test "mplus-empty-right" - (mk-mplus (list 1 2) mzero) - (list 1 2)) + (stream-take 5 (mk-mplus (s-cons :l mzero) mzero)) + (list :l)) (mk-test "mplus-mature-mature" - (mk-mplus (list 1 2) (list 3 4)) - (list 1 2 3 4)) + (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 4 (mk-mplus (fn () (list "a" "b")) (list "c" "d"))) - (list "c" "d" "a" "b")) + (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" (mk-bind mzero (fn (s) (unit s))) (list)) +(mk-test + "bind-empty-stream" + (stream-take 5 (mk-bind mzero (fn (s) (unit s)))) + (list)) (mk-test "bind-singleton-identity" - (mk-bind (list 5) (fn (x) (list x))) + (stream-take + 5 + (mk-bind (s-cons 5 mzero) (fn (x) (unit x)))) (list 5)) (mk-test "bind-flat-multi" - (mk-bind - (list 1 2) - (fn (x) (list x (* x 10)))) + (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" - (mk-bind - (list 1 2 3) - (fn (x) (if (= x 2) (list) (list x)))) + (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" (succeed empty-s) (list empty-s)) +(mk-test + "succeed-yields-singleton" + (stream-take 5 (succeed empty-s)) + (list empty-s)) -(mk-test "fail-yields-mzero" (fail empty-s) (list)) +(mk-test "fail-yields-mzero" (stream-take 5 (fail empty-s)) (list)) ;; --- == --- (mk-test "eq-ground-success" - (mk-unified? (first ((== 1 1) empty-s))) - true) + (stream-take 5 ((== 1 1) empty-s)) + (list empty-s)) -(mk-test "eq-ground-failure" ((== 1 2) empty-s) (list)) +(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 ((== x 7) empty-s)))) + (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 ((== x (list 1 2)) empty-s)))) + (mk-walk + x + (first + (stream-take + 5 + ((== x (list 1 2)) empty-s))))) (list 1 2)) (mk-test "eq-list-mismatch-fails" - ((== (list 1 2) (list 1 3)) empty-s) + (stream-take + 5 + ((== (list 1 2) (list 1 3)) empty-s)) (list)) ;; --- conj2 / mk-conj --- @@ -128,7 +157,7 @@ (let ((x (mk-var "x")) (y (mk-var "y"))) (let - ((s (first ((conj2 (== x 1) (== y 2)) empty-s)))) + ((s (first (stream-take 5 ((conj2 (== x 1) (== y 2)) empty-s))))) (list (mk-walk x s) (mk-walk y s)))) (list 1 2)) @@ -136,16 +165,24 @@ "conj2-conflict-empty" (let ((x (mk-var "x"))) - ((conj2 (== x 1) (== x 2)) empty-s)) + (stream-take + 5 + ((conj2 (== x 1) (== x 2)) empty-s))) (list)) -(mk-test "conj-empty-is-succeed" ((mk-conj) empty-s) (list empty-s)) +(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 ((mk-conj (== x 99)) empty-s)))) + (mk-walk + x + (first + (stream-take 5 ((mk-conj (== x 99)) empty-s))))) 99) (mk-test @@ -153,7 +190,7 @@ (let ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z"))) (let - ((s (first ((mk-conj (== x 1) (== y 2) (== z 3)) empty-s)))) + ((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)) @@ -177,7 +214,10 @@ (map (fn (s) (mk-walk q s)) res))) (list 5)) -(mk-test "disj-empty-is-fail" ((mk-disj) empty-s) (list)) +(mk-test + "disj-empty-is-fail" + (stream-take 5 ((mk-disj) empty-s)) + (list)) (mk-test "disj-three-clauses" @@ -188,7 +228,7 @@ (map (fn (s) (mk-walk q s)) res))) (list "a" "b" "c")) -;; --- conj/disj nesting (distributivity check) --- +;; --- conj/disj nesting --- (mk-test "disj-of-conj" @@ -199,18 +239,22 @@ (map (fn (s) (list (mk-walk x s) (mk-walk y s))) res))) (list (list 1 2) (list 3 4))) -;; --- ==-check (occurs-checked equality goal) --- +;; --- ==-check --- (mk-test "eq-check-no-occurs-fails" - (let ((x (mk-var "x"))) ((==-check x (list 1 x)) empty-s)) + (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 ((==-check x 5) empty-s)))) + (mk-walk + x + (first (stream-take 5 ((==-check x 5) empty-s))))) 5) (mk-tests-run!) diff --git a/lib/minikanren/tests/relations.sx b/lib/minikanren/tests/relations.sx new file mode 100644 index 00000000..ae3475c9 --- /dev/null +++ b/lib/minikanren/tests/relations.sx @@ -0,0 +1,175 @@ +;; 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")) + +(mk-tests-run!) diff --git a/lib/minikanren/unify.sx b/lib/minikanren/unify.sx index f043dc48..89f00ab4 100644 --- a/lib/minikanren/unify.sx +++ b/lib/minikanren/unify.sx @@ -1,22 +1,43 @@ -;; lib/minikanren/unify.sx — Phase 1: variables + unification. +;; 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 shape (designed for natural SX use): -;; logic var : (:var NAME) — kit's mk-var -;; pair : any non-empty SX list — head + tail unified positionally -;; atom : number / string / symbol / boolean / nil / () +;; 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) t)) + +(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}) @@ -45,6 +66,15 @@ (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))))) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index f833e2bf..ff9b67e0 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -100,20 +100,21 @@ Key semantic mappings: `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 +- [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` - [ ] `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] 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; @@ -151,6 +152,23 @@ _(none yet)_ _Newest first._ +- **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 From f4ab7f2534336445b8bf07f089c9f09e16dea4c3 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 21:49:38 +0000 Subject: [PATCH 08/84] =?UTF-8?q?mk:=20phase=204B=20=E2=80=94=20reverseo?= =?UTF-8?q?=20+=20lengtho,=2010=20new=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/relations.sx | 16 ++++++++++ lib/minikanren/tests/relations.sx | 52 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 15 ++++++--- 3 files changed, 79 insertions(+), 4 deletions(-) diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index b9f38732..10f5a289 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -49,3 +49,19 @@ (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)))))) diff --git a/lib/minikanren/tests/relations.sx b/lib/minikanren/tests/relations.sx index ae3475c9..40cc5fc8 100644 --- a/lib/minikanren/tests/relations.sx +++ b/lib/minikanren/tests/relations.sx @@ -172,4 +172,56 @@ (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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index ff9b67e0..f60651fc 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -109,10 +109,13 @@ Key semantic mappings: - [x] `nullo` `l` — l is empty - [x] `pairo` `p` — p is a (non-empty) cons-cell / list - [x] `caro` / `cdro` / `conso` / `firsto` / `resto` -- [ ] `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) +- [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) @@ -152,6 +155,10 @@ _(none yet)_ _Newest first._ +- **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/ From 240ed90b20d00d903e37f396fb8ea4ff950fca7f Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 21:51:52 +0000 Subject: [PATCH 09/84] =?UTF-8?q?mk:=20phase=205A=20=E2=80=94=20conda,=20s?= =?UTF-8?q?oft-cut=20without=20onceo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/conda.sx | 42 ++++++++++++++++++++ lib/minikanren/tests/conda.sx | 75 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 9 ++++- 3 files changed, 124 insertions(+), 2 deletions(-) create mode 100644 lib/minikanren/conda.sx create mode 100644 lib/minikanren/tests/conda.sx diff --git a/lib/minikanren/conda.sx b/lib/minikanren/conda.sx new file mode 100644 index 00000000..6806c10a --- /dev/null +++ b/lib/minikanren/conda.sx @@ -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)))) diff --git a/lib/minikanren/tests/conda.sx b/lib/minikanren/tests/conda.sx new file mode 100644 index 00000000..0f6ed1e6 --- /dev/null +++ b/lib/minikanren/tests/conda.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index f60651fc..aa332a34 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -124,8 +124,9 @@ Key semantic mappings: escapes to ground values for arithmetic or string ops - [ ] `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) +- [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) - [ ] `nafc` — negation as finite failure with constraint - [ ] Tests: Zebra puzzle, N-queens, Sudoku via `project`, family relations via `matche` @@ -155,6 +156,10 @@ _(none yet)_ _Newest first._ +- **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). From 43d58e6ca9ddce4813f18cdb84b60f9c4783d5b2 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 21:54:16 +0000 Subject: [PATCH 10/84] mk: peano arithmetic (zeroo, pluso, minuso, *o, lteo, lto) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/peano.sx | 35 ++++++++++ lib/minikanren/tests/peano.sx | 119 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 ++ 3 files changed, 159 insertions(+) create mode 100644 lib/minikanren/peano.sx create mode 100644 lib/minikanren/tests/peano.sx diff --git a/lib/minikanren/peano.sx b/lib/minikanren/peano.sx new file mode 100644 index 00000000..9865cf72 --- /dev/null +++ b/lib/minikanren/peano.sx @@ -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)))))) diff --git a/lib/minikanren/tests/peano.sx b/lib/minikanren/tests/peano.sx new file mode 100644 index 00000000..682a3dd4 --- /dev/null +++ b/lib/minikanren/tests/peano.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index aa332a34..81c80da9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -156,6 +156,11 @@ _(none yet)_ _Newest first._ +- **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. From d61b355413c6f9a0c4d7a1544d7082626bb7b72e Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 23:27:16 +0000 Subject: [PATCH 11/84] =?UTF-8?q?mk:=20phase=205B=20=E2=80=94=20project,?= =?UTF-8?q?=20escape=20into=20host=20SX?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (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. --- lib/minikanren/project.sx | 25 ++++++++++++++ lib/minikanren/tests/project.sx | 60 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 9 +++-- 3 files changed, 92 insertions(+), 2 deletions(-) create mode 100644 lib/minikanren/project.sx create mode 100644 lib/minikanren/tests/project.sx diff --git a/lib/minikanren/project.sx b/lib/minikanren/project.sx new file mode 100644 index 00000000..476b18f7 --- /dev/null +++ b/lib/minikanren/project.sx @@ -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)))))) diff --git a/lib/minikanren/tests/project.sx b/lib/minikanren/tests/project.sx new file mode 100644 index 00000000..b58c71ab --- /dev/null +++ b/lib/minikanren/tests/project.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 81c80da9..e3de93d6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -120,8 +120,9 @@ Key semantic mappings: `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))` - [x] `conda` — soft-cut: first non-failing head wins; ALL of head's answers @@ -156,6 +157,10 @@ _(none yet)_ _Newest first._ +- **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) From a038d418150e56009559450e47aa47fbf7cbabeb Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 23:29:08 +0000 Subject: [PATCH 12/84] =?UTF-8?q?mk:=20phase=205C=20=E2=80=94=20nafc,=20ne?= =?UTF-8?q?gation=20as=20finite=20failure?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (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. --- lib/minikanren/nafc.sx | 24 +++++++++++++++++ lib/minikanren/tests/nafc.sx | 50 ++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 7 ++++- 3 files changed, 80 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/nafc.sx create mode 100644 lib/minikanren/tests/nafc.sx diff --git a/lib/minikanren/nafc.sx b/lib/minikanren/nafc.sx new file mode 100644 index 00000000..181c84ac --- /dev/null +++ b/lib/minikanren/nafc.sx @@ -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))))) diff --git a/lib/minikanren/tests/nafc.sx b/lib/minikanren/tests/nafc.sx new file mode 100644 index 00000000..cec8eaa6 --- /dev/null +++ b/lib/minikanren/tests/nafc.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index e3de93d6..80984e36 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -128,7 +128,9 @@ Key semantic mappings: - [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) -- [ ] `nafc` — negation as finite failure with constraint +- [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) @@ -157,6 +159,9 @@ _(none yet)_ _Newest first._ +- **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 "!")`). From b8a0c504bcdaf6cc85ecab3d877f795daa3106e9 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 07:22:41 +0000 Subject: [PATCH 13/84] =?UTF-8?q?mk:=20phase=204C=20=E2=80=94=20permuteo?= =?UTF-8?q?=20(with=20inserto=20helper)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit inserto a l p: p is l with a inserted at some position. Recursive: head of l first, then push past head and recurse. permuteo l p: classical recursive permutation. Empty -> empty; otherwise take a head off l, recursively permute the tail, insert head at any position in the recursive result. 7 new tests including all-6-perms-of-3 as a set check (independent of generation order). 208/208 cumulative. --- lib/minikanren/relations.sx | 16 ++++++++ lib/minikanren/tests/relations.sx | 64 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 7 +++- 3 files changed, 86 insertions(+), 1 deletion(-) diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 10f5a289..4d78f1e1 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -65,3 +65,19 @@ (conde ((nullo l) (== n :z)) ((fresh (a d n-1) (conso a d l) (== n (list :s n-1)) (lengtho d n-1)))))) + +(define + inserto + (fn + (a l p) + (conde + ((conso a l p)) + ((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt)))))) + +(define + permuteo + (fn + (l p) + (conde + ((nullo l) (nullo p)) + ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p)))))) diff --git a/lib/minikanren/tests/relations.sx b/lib/minikanren/tests/relations.sx index 40cc5fc8..ffbdfcf6 100644 --- a/lib/minikanren/tests/relations.sx +++ b/lib/minikanren/tests/relations.sx @@ -224,4 +224,68 @@ (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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 80984e36..0bddf5a0 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -112,7 +112,9 @@ Key semantic mappings: - [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] `permuteo` `l` `p` — permutation of list. Built on `inserto` (insert at any + position) and recursive permutation of tail. All 6 perms of (1 2 3) generated + forward; backward `run 1 q (permuteo q (a b c))` finds the input. - [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. @@ -159,6 +161,9 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Phase 4 piece C — permuteo + inserto**: standard recursive + insert-at-any-position + permute-tail. 7 new tests, including all-6-perms-of-3 + as a set check. 208/208 cumulative. - **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. From fd73f3c51b6701d26394256fadb2aa04ae6fb5e1 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 07:41:51 +0000 Subject: [PATCH 14/84] =?UTF-8?q?mk:=20phase=205D=20=E2=80=94=20matche=20p?= =?UTF-8?q?attern=20matching,=20phase=205=20complete?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Pattern grammar: _, symbol, atom (number/string/keyword/bool), (), and (p1 ... pn) list patterns (recursive). Symbols become fresh vars in a fresh form, atoms become literals to unify against, lists recurse position-wise. Repeated names produce the same fresh var (so they unify by ==). Macro is built with explicit cons/list rather than a quasiquote because the quasiquote expander does not recurse into nested lambda bodies — the natural `\`(matche-clause (quote ,target) cl)` spelling left literal `(unquote target)` forms in the output. 14 tests, 222/222 cumulative. Phase 5 done (project, conda, condu, onceo, nafc, matche all green). --- lib/minikanren/matche.sx | 74 ++++++++++++++++++ lib/minikanren/tests/matche.sx | 138 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 16 +++- 3 files changed, 226 insertions(+), 2 deletions(-) create mode 100644 lib/minikanren/matche.sx create mode 100644 lib/minikanren/tests/matche.sx diff --git a/lib/minikanren/matche.sx b/lib/minikanren/matche.sx new file mode 100644 index 00000000..9d671c85 --- /dev/null +++ b/lib/minikanren/matche.sx @@ -0,0 +1,74 @@ +;; lib/minikanren/matche.sx — Phase 5 piece D: pattern matching over terms. +;; +;; (matche TARGET +;; (PATTERN1 g1 g2 ...) +;; (PATTERN2 g1 ...) +;; ...) +;; +;; Each clause unifies TARGET with PATTERN, introducing a fresh variable +;; for every plain symbol in the pattern, and runs its goal body. The +;; pattern grammar: +;; +;; _ wildcard — fresh anonymous var +;; x plain symbol — fresh var, bind by name +;; ATOM literal (number, string, keyword, boolean) — must equal +;; () empty list — must equal +;; (p1 p2 ... pn) list pattern — recurse on each element +;; +;; The macro expands to a `conde` whose clauses are +;; `((fresh (vars...) (== target pat-expr) body...))`. +;; +;; Fixed-length list patterns only — no rest patterns. To match "head + rest", +;; use `(fresh (a d) (conso a d target) body)` directly. +;; +;; Note: the macro builds the expansion via `cons` / `list` rather than a +;; quasiquote — the quasiquote expander does not recurse into lambda +;; bodies, which broke the natural `\`(matche-clause (quote ,target) cl)` +;; spelling. + +(define matche-symbol-var? (fn (s) (symbol? s))) + +(define + matche-collect-vars + (fn (pat) (matche-collect-vars-acc pat (list)))) + +(define + matche-collect-vars-acc + (fn + (pat acc) + (cond + ((matche-symbol-var? pat) + (if (some (fn (s) (= s pat)) acc) acc (append acc (list pat)))) + ((and (list? pat) (not (empty? pat))) + (reduce (fn (a p) (matche-collect-vars-acc p a)) acc pat)) + (:else acc)))) + +(define + matche-pattern->expr + (fn + (pat) + (cond + ((matche-symbol-var? pat) pat) + ((and (list? pat) (empty? pat)) (list (quote list))) + ((list? pat) (cons (quote list) (map matche-pattern->expr pat))) + (:else (list (quote quote) pat))))) + +(define + matche-clause + (fn + (target cl) + (let + ((pat (first cl)) (body (rest cl))) + (let + ((vars (matche-collect-vars pat))) + (let + ((pat-expr (matche-pattern->expr pat))) + (list + (cons + (quote fresh) + (cons vars (cons (list (quote ==) target pat-expr) body))))))))) + +(defmacro + matche + (target &rest clauses) + (cons (quote conde) (map (fn (cl) (matche-clause target cl)) clauses))) diff --git a/lib/minikanren/tests/matche.sx b/lib/minikanren/tests/matche.sx new file mode 100644 index 00000000..8309cfbf --- /dev/null +++ b/lib/minikanren/tests/matche.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 0bddf5a0..e5f70fdb 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -125,8 +125,13 @@ Key semantic mappings: - [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))` +- [x] `matche` — pattern matching over logic terms. Pattern grammar: `_` / + symbol / atom / `()` / `(p1 p2 ... pn)`. Each clause becomes + `(fresh (vars-in-pat) (== target pat-expr) body...)`. Repeated symbol + names in a pattern produce the same fresh var, so they unify (== check). + Built without quasiquote (the expander does not recurse into lambda + bodies). Fixed-length list patterns only — head/tail destructuring uses + `(fresh (a d) (conso a d target) body)` directly. - [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) @@ -161,6 +166,13 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Phase 5 piece D — matche, Phase 5 done**: pattern matching + macro (`lib/minikanren/matche.sx`) — symbols become fresh vars, atoms become + literals, lists recurse positionally, repeated names unify. 14 new tests + (literals, vars, wildcards, list patterns, multi-clause dispatch, nested + patterns, repeated-var-implies-eq). Built via `cons`/`list` rather than + quasiquote because SX's quasiquote does not recurse into lambda bodies — a + worth-knowing gotcha. 222/222 cumulative. - **2026-05-08** — **Phase 4 piece C — permuteo + inserto**: standard recursive insert-at-any-position + permute-tail. 7 new tests, including all-6-perms-of-3 as a set check. 208/208 cumulative. From bc9261e90af730e343d1067cc326b848964c2614 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 07:50:03 +0000 Subject: [PATCH 15/84] mk: matche keyword pattern fix + classic puzzles MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit matche-pattern->expr now treats keyword patterns as literals that emit themselves bare, rather than wrapping in (quote ...). SX keywords self-evaluate to their string name; quoting them flips them to a keyword type that does not unify with the bare-keyword usage at the target site. This was visible only as a test failure on the diffo clauses below — tightened the pattern rules. tests/classics.sx exercises three end-to-end miniKanren programs: - 3-friend / 3-pet permutation puzzle - grandparent inference over a fact list (membero + fresh) - symbolic differentiation dispatched by matche on :x / (:+ a b) / (:* a b) 228/228 cumulative. --- lib/minikanren/matche.sx | 32 ++++++------ lib/minikanren/tests/classics.sx | 87 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 7 +++ 3 files changed, 111 insertions(+), 15 deletions(-) create mode 100644 lib/minikanren/tests/classics.sx diff --git a/lib/minikanren/matche.sx b/lib/minikanren/matche.sx index 9d671c85..5b9ecab6 100644 --- a/lib/minikanren/matche.sx +++ b/lib/minikanren/matche.sx @@ -5,33 +5,30 @@ ;; (PATTERN2 g1 ...) ;; ...) ;; -;; Each clause unifies TARGET with PATTERN, introducing a fresh variable -;; for every plain symbol in the pattern, and runs its goal body. The -;; pattern grammar: -;; +;; Pattern grammar: ;; _ wildcard — fresh anonymous var ;; x plain symbol — fresh var, bind by name -;; ATOM literal (number, string, keyword, boolean) — must equal +;; ATOM literal (number, string, boolean) — must equal +;; :keyword keyword literal — emitted bare (keywords self-evaluate +;; to their string name in SX, so quoting them changes +;; their type from string to keyword) ;; () empty list — must equal ;; (p1 p2 ... pn) list pattern — recurse on each element ;; ;; The macro expands to a `conde` whose clauses are -;; `((fresh (vars...) (== target pat-expr) body...))`. +;; `((fresh (vars-in-pat) (== target pat-expr) body...))`. ;; -;; Fixed-length list patterns only — no rest patterns. To match "head + rest", -;; use `(fresh (a d) (conso a d target) body)` directly. +;; Repeated symbol names within a pattern produce the same fresh var, so +;; they unify by `==`. Fixed-length list patterns only — head/tail +;; destructuring uses `(fresh (a d) (conso a d target) body)` directly. ;; ;; Note: the macro builds the expansion via `cons` / `list` rather than a -;; quasiquote — the quasiquote expander does not recurse into lambda -;; bodies, which broke the natural `\`(matche-clause (quote ,target) cl)` -;; spelling. +;; quasiquote — quasiquote does not recurse into nested lambda bodies in +;; SX, so `\`(matche-clause (quote ,target) cl)` left literal +;; `(unquote target)` in the output. (define matche-symbol-var? (fn (s) (symbol? s))) -(define - matche-collect-vars - (fn (pat) (matche-collect-vars-acc pat (list)))) - (define matche-collect-vars-acc (fn @@ -43,6 +40,10 @@ (reduce (fn (a p) (matche-collect-vars-acc p a)) acc pat)) (:else acc)))) +(define + matche-collect-vars + (fn (pat) (matche-collect-vars-acc pat (list)))) + (define matche-pattern->expr (fn @@ -51,6 +52,7 @@ ((matche-symbol-var? pat) pat) ((and (list? pat) (empty? pat)) (list (quote list))) ((list? pat) (cons (quote list) (map matche-pattern->expr pat))) + ((keyword? pat) pat) (:else (list (quote quote) pat))))) (define diff --git a/lib/minikanren/tests/classics.sx b/lib/minikanren/tests/classics.sx new file mode 100644 index 00000000..0a0b5435 --- /dev/null +++ b/lib/minikanren/tests/classics.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index e5f70fdb..c5761dfd 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -166,6 +166,13 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Classic puzzles + matche keyword fix**: matche now emits + keywords bare in the pattern->expr conversion so they self-evaluate to their + string name and unify with the same-keyword target value (instead of becoming + a quoted-keyword type). New `tests/classics.sx`: pet permutation puzzle, + parent/grandparent inference over a fact list, symbolic differentiation + driven by matche dispatch on `:x` / `(:+ a b)` / `(:* a b)` patterns. + 6 new tests, 228/228 cumulative. - **2026-05-08** — **Phase 5 piece D — matche, Phase 5 done**: pattern matching macro (`lib/minikanren/matche.sx`) — symbols become fresh vars, atoms become literals, lists recurse positionally, repeated names unify. 14 new tests From 3d2a5b181489657b5ba0175cb1ced8107e27d676 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 07:56:58 +0000 Subject: [PATCH 16/84] =?UTF-8?q?mk:=20phase=206A=20=E2=80=94=20minimal=20?= =?UTF-8?q?FD=20(ino=20+=20all-distincto)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ino is membero with the constraint-store-friendly argument order (`(ino x dom)` reads as "x in dom"). all-distincto checks pairwise distinctness via nafc + membero on the recursive tail. These two are enough to express the enumerate-then-filter style of finite-domain solving: (fresh (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))) enumerates all 6 distinct triples from {1, 2, 3}. Full CLP(FD) with arc-consistency, fd-plus, etc. remains pending under Phase 6 proper. 9 new tests, 237/237 cumulative. --- lib/minikanren/fd.sx | 25 +++++++++++++ lib/minikanren/tests/fd.sx | 75 ++++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 12 +++++- 3 files changed, 111 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/fd.sx create mode 100644 lib/minikanren/tests/fd.sx diff --git a/lib/minikanren/fd.sx b/lib/minikanren/fd.sx new file mode 100644 index 00000000..fb0c06ab --- /dev/null +++ b/lib/minikanren/fd.sx @@ -0,0 +1,25 @@ +;; lib/minikanren/fd.sx — Phase 6 piece A: minimal finite-domain helpers. +;; +;; A full CLP(FD) engine (arc consistency, native integer domains, fd-plus +;; etc.) is Phase 6 proper. For now we expose two small relations layered +;; on the existing list machinery — they're sufficient for permutation +;; puzzles, the N-queens-style core of constraint solving: +;; +;; (ino x dom) — x is a member of dom (alias for membero with the +;; constraint-store-friendly argument order). +;; (all-distincto l) — all elements of l are pairwise distinct. +;; +;; all-distincto uses nafc + membero on the tail — it requires the head +;; element of each recursive step to be ground enough for membero to be +;; finitary, so order matters: prefer (in x dom) goals BEFORE +;; (all-distincto (list x ...)) so values get committed first. + +(define ino (fn (x dom) (membero x dom))) + +(define + all-distincto + (fn + (l) + (conde + ((nullo l)) + ((fresh (a d) (conso a d l) (nafc (membero a d)) (all-distincto d)))))) diff --git a/lib/minikanren/tests/fd.sx b/lib/minikanren/tests/fd.sx new file mode 100644 index 00000000..4954d777 --- /dev/null +++ b/lib/minikanren/tests/fd.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index c5761dfd..09af1701 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -142,7 +142,10 @@ Key semantic mappings: ### Phase 6 — arithmetic constraints CLP(FD) - [ ] Finite domain variables: `fd-var` with domain `[lo..hi]` -- [ ] `in` `x` `domain` — constrain x to domain +- [x] `ino` `x` `domain` — alias for `(membero x domain)` with the + constraint-store-friendly argument order. Sufficient for the + enumerate-then-filter style of finite-domain solving. +- [x] `all-distincto` `l` — pairwise-distinct elements via `nafc + membero`. - [ ] `fd-eq` `x` `y` — x = y (constraint propagation) - [ ] `fd-neq` `x` `y` — x ≠ y - [ ] `fd-lt` `fd-lte` `fd-gt` `fd-gte` — ordering constraints @@ -166,6 +169,13 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Phase 6 piece A — minimal FD (ino + all-distincto)**: + `lib/minikanren/fd.sx`. `ino` is `membero` with the FD-style argument + order; `all-distincto` is `nafc + membero` walking the list. Together + they cover the enumerate-then-filter style of finite-domain solving — + `(fresh (a b c) (ino a D) (ino b D) (ino c D) (all-distincto (list a b c)))` + enumerates all distinct triples from D. Full FD with arc-consistency, + fd-plus etc. is still pending. 9 new tests, 237/237 cumulative. - **2026-05-08** — **Classic puzzles + matche keyword fix**: matche now emits keywords bare in the pattern->expr conversion so they self-evaluate to their string name and unify with the same-keyword target value (instead of becoming From 33693fc9578eb1c6c8096c5bbc3a6e36fba2d2de Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 10:41:02 +0000 Subject: [PATCH 17/84] mk: 4-queens classic benchmark green queens.sx encodes a queen in row i at column ci. ino-each constrains each ci to {1..n}; all-distincto handles the row/column distinct property; safe-diag uses project to escape into host arithmetic for the |c_i - c_j| != |i - j| diagonal guard. all-cells-safe iterates pairs at goal-construction time so the constraint set is materialised once, then driven by the search. (run* q (fresh (a b c d) (== q (list a b c d)) (queens-cols (list a b c d) 4))) -> ((2 4 1 3) (3 1 4 2)) Both valid 4-queens placements found. 6 new tests including the two-solution invariant; 243/243 cumulative. --- lib/minikanren/queens.sx | 67 ++++++++++++++++++++++++++++++++++ lib/minikanren/tests/queens.sx | 45 +++++++++++++++++++++++ plans/minikanren-on-sx.md | 8 ++++ 3 files changed, 120 insertions(+) create mode 100644 lib/minikanren/queens.sx create mode 100644 lib/minikanren/tests/queens.sx diff --git a/lib/minikanren/queens.sx b/lib/minikanren/queens.sx new file mode 100644 index 00000000..27daa3fc --- /dev/null +++ b/lib/minikanren/queens.sx @@ -0,0 +1,67 @@ +;; lib/minikanren/queens.sx — N-queens via ino + all-distincto + project. +;; +;; Encoding: q = (c1 c2 ... cn) where ci is the column of the queen in +;; row i. Each ci ∈ {1..n}; all distinct (no two queens share a column); +;; no two queens on the same diagonal (|ci - cj| ≠ |i - j| for i ≠ j). +;; +;; The diagonal check uses `project` to escape into host arithmetic +;; once both column values are ground. + +(define + safe-diag + (fn + (a b dist) + (project (a b) (if (= (abs (- a b)) dist) fail succeed)))) + +(define + safe-cell-vs-rest + (fn + (c c-row others next-row) + (cond + ((empty? others) succeed) + (:else + (mk-conj + (safe-diag c (first others) (- next-row c-row)) + (safe-cell-vs-rest c c-row (rest others) (+ next-row 1))))))) + +(define + all-cells-safe + (fn + (cols start-row) + (cond + ((empty? cols) succeed) + (:else + (mk-conj + (safe-cell-vs-rest + (first cols) + start-row + (rest cols) + (+ start-row 1)) + (all-cells-safe (rest cols) (+ start-row 1))))))) + +(define + range-1-to-n + (fn + (n) + (cond + ((= n 0) (list)) + (:else (append (range-1-to-n (- n 1)) (list n)))))) + +(define + ino-each + (fn + (cols dom) + (cond + ((empty? cols) succeed) + (:else (mk-conj (ino (first cols) dom) (ino-each (rest cols) dom)))))) + +(define + queens-cols + (fn + (cols n) + (let + ((dom (range-1-to-n n))) + (mk-conj + (ino-each cols dom) + (all-distincto cols) + (all-cells-safe cols 1))))) diff --git a/lib/minikanren/tests/queens.sx b/lib/minikanren/tests/queens.sx new file mode 100644 index 00000000..2f85bdd8 --- /dev/null +++ b/lib/minikanren/tests/queens.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 09af1701..35b5193d 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -169,6 +169,14 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **N-queens (classic miniKanren benchmark green)**: + `lib/minikanren/queens.sx`. Encoding cols(i) = column of queen in row i; + `ino-each` + `all-distincto` cover row/column constraints; `safe-diag` + uses `project` to escape into host arithmetic for the `|c_i - c_j| ≠ + |i - j|` diagonal check; `all-cells-safe` walks pairs at construction + time. `(run* q (fresh (a b c d) (== q (list a b c d)) (queens-cols + (list a b c d) 4)))` returns the two valid 4-queens placements + `(2 4 1 3)` and `(3 1 4 2)`. 6 new tests, 243/243 cumulative. - **2026-05-08** — **Phase 6 piece A — minimal FD (ino + all-distincto)**: `lib/minikanren/fd.sx`. `ino` is `membero` with the FD-style argument order; `all-distincto` is `nafc + membero` walking the list. Together From 2ae848dfe78d39890ce0b1d8eca283e2bfbc950e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 10:43:45 +0000 Subject: [PATCH 18/84] =?UTF-8?q?mk:=20laziness=20tests=20=E2=80=94=20Zzz-?= =?UTF-8?q?conde=20+=20interleaving=20fairness?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Verifies that the Zzz-wraps-each-conde-clause + mk-mplus-suspend-on- paused-left machinery produces fair interleaving and gives finite prefixes from infinitely-recursive relations: - listo-aux has no base case under run* but run 4 q ... produces exactly the four shortest list shapes, in order. - mk-disj of two infinite generators (ones-gen, twos-gen) with run 4 q ... must include both 1-prefixed and 2-prefixed answers (no starvation). - run* terminates on a goal that has a finite answer set. 3 tests, 246/246 cumulative. --- lib/minikanren/tests/laziness.sx | 77 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 6 +++ 2 files changed, 83 insertions(+) create mode 100644 lib/minikanren/tests/laziness.sx diff --git a/lib/minikanren/tests/laziness.sx b/lib/minikanren/tests/laziness.sx new file mode 100644 index 00000000..d3440ac4 --- /dev/null +++ b/lib/minikanren/tests/laziness.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 35b5193d..4151863d 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -169,6 +169,12 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Laziness tests**: explicitly verifies the + Zzz-on-conde-clauses + mk-mplus-swap-on-paused machinery: an + infinitely-recursive relation truncated via `run 4 q (listo-aux q)` + produces exactly `(() (_.0) (_.0 _.1) (_.0 _.1 _.2))`; mixing two + infinite generators via `mk-disj` keeps both alive (no starvation); + `run*` terminates on a bounded query. 3 new tests, 246/246 cumulative. - **2026-05-08** — **N-queens (classic miniKanren benchmark green)**: `lib/minikanren/queens.sx`. Encoding cols(i) = column of queen in row i; `ino-each` + `all-distincto` cover row/column constraints; `safe-diag` From bf9fe8b365808e2ddceefe629904ce0282739984 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 10:46:13 +0000 Subject: [PATCH 19/84] =?UTF-8?q?mk:=20flatteno=20=E2=80=94=20nested=20lis?= =?UTF-8?q?t=20flattener?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three conde clauses: nullo tree -> nullo flat; pairo tree -> recurse on car & cdr, appendo their flattenings; otherwise tree must be a ground non-list atom (nafc nullo + nafc pairo) and flat = (list tree). Works on ground inputs of arbitrary nesting: (run* q (flatteno (list 1 (list 2 3) (list (list 4) 5)) q)) -> ((1 2 3 4 5)) 7 tests, 253/253 cumulative. Phase 4 list relations now complete. --- lib/minikanren/relations.sx | 15 ++++++++++++ lib/minikanren/tests/flatteno.sx | 42 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 11 ++++++++- 3 files changed, 67 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/flatteno.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 4d78f1e1..768dff92 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -81,3 +81,18 @@ (conde ((nullo l) (nullo p)) ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p)))))) + +(define + flatteno + (fn + (tree flat) + (conde + ((nullo tree) (nullo flat)) + ((pairo tree) + (fresh + (h t hf tf) + (conso h t tree) + (flatteno h hf) + (flatteno t tf) + (appendo hf tf flat))) + ((nafc (nullo tree)) (nafc (pairo tree)) (== flat (list tree)))))) diff --git a/lib/minikanren/tests/flatteno.sx b/lib/minikanren/tests/flatteno.sx new file mode 100644 index 00000000..4a01780a --- /dev/null +++ b/lib/minikanren/tests/flatteno.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 4151863d..1b71ac0f 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -111,7 +111,11 @@ Key semantic mappings: - [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) +- [x] `flatteno` `l` `f` — flatten nested lists. Three conde clauses: + empty → empty; pair → recurse on car & cdr + appendo; otherwise atom → + `(== flat (list tree))`. Atom-ness is asserted via `nafc (nullo tree) + + nafc (pairo tree)` — both succeed only when tree is a ground non-list. + Works on ground inputs. - [x] `permuteo` `l` `p` — permutation of list. Built on `inserto` (insert at any position) and recursive permutation of tail. All 6 perms of (1 2 3) generated forward; backward `run 1 q (permuteo q (a b c))` finds the input. @@ -169,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **flatteno**: nested-list flattener via conde + appendo. + Atom-ness is detected via `nafc (nullo ...) + nafc (pairo ...)` so the + third clause only fires when the input is a ground non-list. Works for + `()` / atoms / flat lists / arbitrarily-nested lists. 7 new tests, + 253/253 cumulative. Phase 4 list relations all complete. - **2026-05-08** — **Laziness tests**: explicitly verifies the Zzz-on-conde-clauses + mk-mplus-swap-on-paused machinery: an infinitely-recursive relation truncated via `run 4 q (listo-aux q)` From 428ca79f617828075a65e91cebba7d8bd5bf79d7 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 10:50:28 +0000 Subject: [PATCH 20/84] =?UTF-8?q?mk:=20rembero=20/=20assoco=20/=20nth-o=20?= =?UTF-8?q?=E2=80=94=20more=20list=20relations?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit rembero (remove-first) uses nafc to gate the skip-element clause so the result is well-defined on ground lists. assoco is alist lookup — runs forward (key -> value) and backward (find keys with a given value). nth-o uses Peano-encoded indices into a list, mirroring lengtho. 13 new tests, 266/266 cumulative. --- lib/minikanren/relations.sx | 28 ++++++++ lib/minikanren/tests/list-relations.sx | 89 ++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 ++ 3 files changed, 122 insertions(+) create mode 100644 lib/minikanren/tests/list-relations.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 768dff92..1fcddd6d 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -96,3 +96,31 @@ (flatteno t tf) (appendo hf tf flat))) ((nafc (nullo tree)) (nafc (pairo tree)) (== flat (list tree)))))) + + +(define + rembero + (fn + (x l out) + (conde + ((nullo l) (nullo out)) + ((fresh (a d) (conso a d l) (== a x) (== out d))) + ((fresh (a d res) (conso a d l) (nafc (== a x)) (conso a res out) (rembero x d res)))))) + +(define + assoco + (fn + (key pairs val) + (fresh + (rest) + (conde + ((conso (list key val) rest pairs)) + ((fresh (other) (conso other rest pairs) (assoco key rest val))))))) + +(define + nth-o + (fn + (n l elem) + (conde + ((== n :z) (fresh (d) (conso elem d l))) + ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (nth-o n-1 d elem)))))) diff --git a/lib/minikanren/tests/list-relations.sx b/lib/minikanren/tests/list-relations.sx new file mode 100644 index 00000000..9c36ff8e --- /dev/null +++ b/lib/minikanren/tests/list-relations.sx @@ -0,0 +1,89 @@ +;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o. + +;; --- 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)) + +(mk-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 1b71ac0f..117f88b7 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **rembero / assoco / nth-o**: more standard list relations. + rembero removes the first occurrence (uses `nafc (== a x)` to gate the + skip clause, so it's well-defined on ground lists). assoco is alist + lookup — works forward (key → value) and backward (value → key). nth-o + uses Peano indices into a list. 13 new tests, 266/266 cumulative. - **2026-05-08** — **flatteno**: nested-list flattener via conde + appendo. Atom-ness is detected via `nafc (nullo ...) + nafc (pairo ...)` so the third clause only fires when the input is a ground non-list. Works for From b89b0def931ae5558368c24079fbcded9facfb23 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:00:12 +0000 Subject: [PATCH 21/84] =?UTF-8?q?mk:=202x2=20Latin=20square=20=E2=80=94=20?= =?UTF-8?q?small=20classic=20FD=20constraint=20demo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Defines latin-2x2 over 4 cells and 4 all-distincto constraints. Enumerates exactly 2 squares ((1 2)(2 1)) and ((2 1)(1 2)); a corner clue narrows to one. 3 new tests, 269/269 cumulative. 3x3 (12 squares, the natural showcase) is too slow under naive enumerate- then-filter — that is the motivating test for Phase 6 arc-consistency. --- lib/minikanren/tests/latin.sx | 61 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 6 ++++ 2 files changed, 67 insertions(+) create mode 100644 lib/minikanren/tests/latin.sx diff --git a/lib/minikanren/tests/latin.sx b/lib/minikanren/tests/latin.sx new file mode 100644 index 00000000..8a0afabd --- /dev/null +++ b/lib/minikanren/tests/latin.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 117f88b7..82f2c568 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,12 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **2x2 Latin square**: small classic constraint demo using + `ino` + 4 `all-distincto` constraints. Enumerates exactly 2 squares + (`((1 2)(2 1))` and `((2 1)(1 2))`); a clue (top-left = 1) narrows to one. + 3 new tests, 269/269 cumulative. Note: 3x3 (12 squares) is the natural + showcase but too slow under naive enumerate-then-filter — needs Phase 6 + arc-consistency. - **2026-05-08** — **rembero / assoco / nth-o**: more standard list relations. rembero removes the first occurrence (uses `nafc (== a x)` to gate the skip clause, so it's well-defined on ground lists). assoco is alist From 9795532f7db56718fd2fc8c0218d1edb9e7b9808 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:02:09 +0000 Subject: [PATCH 22/84] =?UTF-8?q?mk:=20intarith.sx=20=E2=80=94=20ground-on?= =?UTF-8?q?ly=20integer=20arithmetic=20via=20project?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit pluso-i / minuso-i / *o-i / lto-i / lteo-i / neqo-i wrap host arithmetic in project. They run at native speed but require their inputs to walk to ground numbers — they are NOT relational the way Peano pluso is. Use them when puzzle size makes Peano impractical (which is most cases beyond toy examples). Composes with relational goals — for instance, (fresh (x) (membero x (1 2 3 4 5)) (lto-i x 3) (== q x)) filters the domain by < 3 and returns (1 2). 18 new tests, 287/287 cumulative. --- lib/minikanren/intarith.sx | 56 ++++++++++++++++++++ lib/minikanren/tests/intarith.sx | 89 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 7 +++ 3 files changed, 152 insertions(+) create mode 100644 lib/minikanren/intarith.sx create mode 100644 lib/minikanren/tests/intarith.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx new file mode 100644 index 00000000..7f16a36b --- /dev/null +++ b/lib/minikanren/intarith.sx @@ -0,0 +1,56 @@ +;; lib/minikanren/intarith.sx — fast integer arithmetic via project. +;; +;; These are ground-only escapes into host arithmetic. They run at native +;; speed (host ints) but require their arguments to walk to actual numbers +;; — they are not relational the way `pluso` (Peano) is. Use them when +;; the puzzle size makes Peano impractical. +;; +;; Naming: `-i` suffix marks "integer-only" goals. + +(define + pluso-i + (fn + (a b c) + (project + (a b) + (if (and (number? a) (number? b)) (== c (+ a b)) fail)))) + +(define + minuso-i + (fn + (a b c) + (project + (a b) + (if (and (number? a) (number? b)) (== c (- a b)) fail)))) + +(define + *o-i + (fn + (a b c) + (project + (a b) + (if (and (number? a) (number? b)) (== c (* a b)) fail)))) + +(define + lto-i + (fn + (a b) + (project + (a b) + (if (and (number? a) (and (number? b) (< a b))) succeed fail)))) + +(define + lteo-i + (fn + (a b) + (project + (a b) + (if (and (number? a) (and (number? b) (<= a b))) succeed fail)))) + +(define + neqo-i + (fn + (a b) + (project + (a b) + (if (and (number? a) (and (number? b) (not (= a b)))) succeed fail)))) diff --git a/lib/minikanren/tests/intarith.sx b/lib/minikanren/tests/intarith.sx new file mode 100644 index 00000000..d81db4c1 --- /dev/null +++ b/lib/minikanren/tests/intarith.sx @@ -0,0 +1,89 @@ +;; 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-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 82f2c568..8e58641c 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,13 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **intarith.sx — fast ground-only integer arithmetic**: + pluso-i / minuso-i / *o-i / lto-i / lteo-i / neqo-i wrap host arithmetic + via `project`. They are not relational like Peano `pluso` (require args + to walk to numbers), but run at native host speed — a viable escape + hatch when puzzle size makes Peano impractical. Composes with relational + goals: `(membero x dom) (lto-i x 3)` filters dom by `< 3`. 18 new tests, + 287/287 cumulative. - **2026-05-08** — **2x2 Latin square**: small classic constraint demo using `ino` + 4 `all-distincto` constraints. Enumerates exactly 2 squares (`((1 2)(2 1))` and `((2 1)(1 2))`); a clue (top-left = 1) narrows to one. From 186171fec3d87424b0709ce00fadbbf4f6137161 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:07:33 +0000 Subject: [PATCH 23/84] =?UTF-8?q?mk:=20pythagorean=20triples=20search=20?= =?UTF-8?q?=E2=80=94=20intarith=20showcase?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Finds all (a, b, c) with a, b, c in [1..10], a <= b, a^2 + b^2 = c^2. Result: ((3 4 5) (6 8 10)) — the two smallest Pythagorean triples within the domain. Demonstrates the enumerate-then-filter pattern: (ino a dom) (ino b dom) (ino c dom) — generate (lteo-i a b) — symmetry break (*o-i a a a-sq) (*o-i b b b-sq) (*o-i c c c-sq) — squares (pluso-i a-sq b-sq sum) (== sum c-sq) — Pythagorean equation 288/288 cumulative. --- lib/minikanren/tests/pythag.sx | 36 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 +++++ 2 files changed, 41 insertions(+) create mode 100644 lib/minikanren/tests/pythag.sx diff --git a/lib/minikanren/tests/pythag.sx b/lib/minikanren/tests/pythag.sx new file mode 100644 index 00000000..c8015ea6 --- /dev/null +++ b/lib/minikanren/tests/pythag.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 8e58641c..50510316 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Pythagorean triples (intarith showcase)**: search for + (a, b, c) ∈ [1..10]³, a ≤ b, a² + b² = c² via `ino + lteo-i + *o-i + + pluso-i + ==`. Finds exactly `(3 4 5)` and `(6 8 10)`. Demonstrates the + enumerate-then-filter pattern with intarith escape into host arithmetic. + 1 new test, 288/288 cumulative. - **2026-05-08** — **intarith.sx — fast ground-only integer arithmetic**: pluso-i / minuso-i / *o-i / lto-i / lteo-i / neqo-i wrap host arithmetic via `project`. They are not relational like Peano `pluso` (require args From cfb43a3cdfd0193e8807f17971527ef326ccfebf Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:09:48 +0000 Subject: [PATCH 24/84] =?UTF-8?q?mk:=20samelengtho=20=E2=80=94=20equal-len?= =?UTF-8?q?gth=20relation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Recurses positionally, dropping a head from each list each step. Both arguments can be unbound, giving the natural enumeration: (run 3 q (fresh (l1 l2) (samelengtho l1 l2) (== q (list l1 l2)))) -> (((), ()) empty/empty ((_.0), (_.1)) pair of 1-element lists ((_.0 _.1), (_.2 _.3))) pair of 2-element lists 5 new tests, 293/293 cumulative. --- lib/minikanren/relations.sx | 8 ++++++ lib/minikanren/tests/list-relations.sx | 39 +++++++++++++++++++++++++- plans/minikanren-on-sx.md | 5 ++++ 3 files changed, 51 insertions(+), 1 deletion(-) diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 1fcddd6d..200c3128 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -124,3 +124,11 @@ (conde ((== n :z) (fresh (d) (conso elem d l))) ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (nth-o n-1 d elem)))))) + +(define + samelengtho + (fn + (l1 l2) + (conde + ((nullo l1) (nullo l2)) + ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime)))))) diff --git a/lib/minikanren/tests/list-relations.sx b/lib/minikanren/tests/list-relations.sx index 9c36ff8e..0a9582d3 100644 --- a/lib/minikanren/tests/list-relations.sx +++ b/lib/minikanren/tests/list-relations.sx @@ -1,4 +1,4 @@ -;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o. +;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o, samelengtho. ;; --- rembero (remove first occurrence) --- @@ -86,4 +86,41 @@ 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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 50510316..c1d668a2 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **samelengtho**: classic miniKanren relation that + succeeds when two lists have equal length. Symmetric — works to enumerate + both lists fresh: `(run 3 q (fresh (l1 l2) (samelengtho l1 l2) (== q + (list l1 l2))))` produces empty/empty, then 1-elem pairs, then 2-elem. + 5 new tests, 293/293 cumulative. - **2026-05-08** — **Pythagorean triples (intarith showcase)**: search for (a, b, c) ∈ [1..10]³, a ≤ b, a² + b² = c² via `ino + lteo-i + *o-i + pluso-i + ==`. Finds exactly `(3 4 5)` and `(6 8 10)`. Demonstrates the From f00054309d9d27ed5cb5e63f829f1b7884db57f5 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:11:26 +0000 Subject: [PATCH 25/84] =?UTF-8?q?mk:=20mapo=20(relational=20map)=20?= =?UTF-8?q?=E2=80=94=20300/300=20milestone?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (mapo rel l1 l2) takes a 2-argument relation rel and asserts l2 is l1 with each element rel-related to its counterpart. Recursive on both lists in lockstep. Works forward (fixed l1, find l2), backward (fixed l2, find l1), or constraining mid-pipeline. Composes with intarith for arithmetic transforms: (mapo (fn (a b) (*o-i a a b)) (list 1 2 3 4) q) -> ((1 4 9 16)) 7 new tests, 300/300 cumulative. --- lib/minikanren/relations.sx | 8 +++++ lib/minikanren/tests/mapo.sx | 62 ++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 4 +++ 3 files changed, 74 insertions(+) create mode 100644 lib/minikanren/tests/mapo.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 200c3128..6c7d6cf0 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -132,3 +132,11 @@ (conde ((nullo l1) (nullo l2)) ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime)))))) + +(define + mapo + (fn + (rel l1 l2) + (conde + ((nullo l1) (nullo l2)) + ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime)))))) diff --git a/lib/minikanren/tests/mapo.sx b/lib/minikanren/tests/mapo.sx new file mode 100644 index 00000000..3afbdd04 --- /dev/null +++ b/lib/minikanren/tests/mapo.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index c1d668a2..2fd26a99 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,10 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **mapo (relational map) — 300 test milestone**: `(mapo + rel l1 l2)` succeeds when l2 is l1 with each element rel-related. Works + forward and backward; composes with intarith — `(mapo (fn (a b) (*o-i + a a b)) (1 2 3 4) q)` → `((1 4 9 16))`. 7 new tests, **300/300** cumulative. - **2026-05-08** — **samelengtho**: classic miniKanren relation that succeeds when two lists have equal length. Symmetric — works to enumerate both lists fresh: `(run 3 q (fresh (l1 l2) (samelengtho l1 l2) (== q From e7dca2675cdbba6895377403126e19414afbc3ed Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:13:22 +0000 Subject: [PATCH 26/84] =?UTF-8?q?mk:=20everyo=20/=20someo=20=E2=80=94=20pr?= =?UTF-8?q?edicate-style=20relations?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (everyo rel l): every element of l satisfies the unary relation rel. (someo rel l): some element does. Both compose with intarith and other predicate-shaped goals: (everyo (fn (x) (lto-i x 10)) (list 1 5 9)) -> succeeds (someo (fn (x) (lto-i 100 x)) (list 5 50 200)) -> succeeds 10 new tests, 310/310 cumulative. --- lib/minikanren/relations.sx | 16 ++++++ lib/minikanren/tests/predicates.sx | 87 ++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 ++ 3 files changed, 108 insertions(+) create mode 100644 lib/minikanren/tests/predicates.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 6c7d6cf0..84d4e76b 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -140,3 +140,19 @@ (conde ((nullo l1) (nullo l2)) ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime)))))) + +(define + everyo + (fn + (rel l) + (conde + ((nullo l)) + ((fresh (a d) (conso a d l) (rel a) (everyo rel d)))))) + +(define + someo + (fn + (rel l) + (conde + ((fresh (a d) (conso a d l) (rel a))) + ((fresh (a d) (conso a d l) (someo rel d)))))) diff --git a/lib/minikanren/tests/predicates.sx b/lib/minikanren/tests/predicates.sx new file mode 100644 index 00000000..7242b278 --- /dev/null +++ b/lib/minikanren/tests/predicates.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 2fd26a99..cd7c3b79 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **everyo / someo (predicate-style relations)**: + `(everyo rel l)` — every element of l satisfies rel; `(someo rel l)` — + some element does. Both compose with intarith for numeric tests: + `(everyo (fn (x) (lto-i x 10)) (list 1 5 9))` succeeds. 10 new tests, + 310/310 cumulative. - **2026-05-08** — **mapo (relational map) — 300 test milestone**: `(mapo rel l1 l2)` succeeds when l2 is l1 with each element rel-related. Works forward and backward; composes with intarith — `(mapo (fn (a b) (*o-i From b4c125389149bda436109478e491a25327daa3ab Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:15:24 +0000 Subject: [PATCH 27/84] =?UTF-8?q?mk:=20graph=20reachability=20via=20patho?= =?UTF-8?q?=20=E2=80=94=20classic=20miniKanren?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Defines a small graph as a fact list, edgeo for fact lookup, and patho that recursively constructs paths. Direct-edge clause yields (x y); otherwise traverse one edge to z, recurse for z->y, prepend x. Enumerates all paths between two nodes, including alternates through shortcut edges: (run* q (patho :a :d q)) -> ((:a :b :c :d) (:a :c :d)) ; both routes 6 new tests, 316/316 cumulative. --- lib/minikanren/tests/graph.sx | 70 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 +++ 2 files changed, 75 insertions(+) create mode 100644 lib/minikanren/tests/graph.sx diff --git a/lib/minikanren/tests/graph.sx b/lib/minikanren/tests/graph.sx new file mode 100644 index 00000000..a1b3e989 --- /dev/null +++ b/lib/minikanren/tests/graph.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index cd7c3b79..dbce01e9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Graph reachability via patho**: classic miniKanren + graph search. `edgeo` looks up edges in a fact list via `membero`; `patho` + recursively builds paths via direct-edge OR (one edge + recurse + cons). + Enumerates all paths between two nodes, including alternates through + shortcuts. 6 new tests, 316/316 cumulative. - **2026-05-08** — **everyo / someo (predicate-style relations)**: `(everyo rel l)` — every element of l satisfies rel; `(someo rel l)` — some element does. Both compose with intarith for numeric tests: From 2d51a8c4eaa3b9856d04493407066fd3a6d8de6b Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:17:27 +0000 Subject: [PATCH 28/84] mk: numbero / stringo / symbolo type predicates Ground-only type tests via project. Each succeeds iff its argument walks to the corresponding host value type. Composes with membero for type-filtered enumeration: (fresh (x) (membero x (list 1 "a" 2 "b" 3)) (numbero x) (== q x)) -> (1 2 3) 12 new tests, 328/328 cumulative. Caveat: SX keywords are strings, so (stringo :k) succeeds. --- lib/minikanren/intarith.sx | 6 ++++ lib/minikanren/tests/types.sx | 52 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 ++++ 3 files changed, 63 insertions(+) create mode 100644 lib/minikanren/tests/types.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 7f16a36b..1ca9aee2 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -54,3 +54,9 @@ (project (a b) (if (and (number? a) (and (number? b) (not (= a b)))) succeed fail)))) + +(define numbero (fn (x) (project (x) (if (number? x) succeed fail)))) + +(define stringo (fn (x) (project (x) (if (string? x) succeed fail)))) + +(define symbolo (fn (x) (project (x) (if (symbol? x) succeed fail)))) diff --git a/lib/minikanren/tests/types.sx b/lib/minikanren/tests/types.sx new file mode 100644 index 00000000..5eb50e6f --- /dev/null +++ b/lib/minikanren/tests/types.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index dbce01e9..d40a86c9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **numbero / stringo / symbolo (type predicates)**: ground-only + type tests via project. Compose with `membero` for type-filtered enumeration: + `(fresh (x) (membero x (1 "a" 2 "b" 3)) (numbero x) (== q x))` → `(1 2 3)`. + Note: SX keywords are strings, so `(stringo :k)` succeeds. 12 new tests, + 328/328 cumulative. - **2026-05-08** — **Graph reachability via patho**: classic miniKanren graph search. `edgeo` looks up edges in a fact list via `membero`; `patho` recursively builds paths via direct-edge OR (one edge + recurse + cons). From 16fe22669a24fd7bc5c2a756d808fb92c9222c01 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:19:29 +0000 Subject: [PATCH 29/84] =?UTF-8?q?mk:=20cyclic-graph=20behaviour=20test=20?= =?UTF-8?q?=E2=80=94=20motivates=20Phase=207=20tabling?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Demonstrates the naive-patho behaviour on a 2-cycle (a <-> b, plus b -> c). Without Phase-7 tabling, the search produces ever-longer paths: (a b), (a b a b), (a b a b a b), ... `run 5` truncates to a finite prefix; `run*` diverges. Documenting this as a regression-style test gives Phase 7 a concrete starting point. 3 new tests, 331/331 cumulative. --- lib/minikanren/tests/cyclic-graph.sx | 48 ++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 +++ 2 files changed, 53 insertions(+) create mode 100644 lib/minikanren/tests/cyclic-graph.sx diff --git a/lib/minikanren/tests/cyclic-graph.sx b/lib/minikanren/tests/cyclic-graph.sx new file mode 100644 index 00000000..f40675d2 --- /dev/null +++ b/lib/minikanren/tests/cyclic-graph.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index d40a86c9..ca39f8c5 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Cyclic graph behaviour test (motivates Phase 7 tabling)**: + Demonstrates that naive patho on a 2-cycle generates ever-longer paths. + `run 5` truncates to a finite prefix; `run*` would diverge. This is + exactly the test case Phase 7 (tabled / SLG resolution) is designed + to fix. 3 new tests, 331/331 cumulative. - **2026-05-08** — **numbero / stringo / symbolo (type predicates)**: ground-only type tests via project. Compose with `membero` for type-filtered enumeration: `(fresh (x) (membero x (1 "a" 2 "b" 3)) (numbero x) (== q x))` → `(1 2 3)`. From 48835f2d4f27450950559b5a973108c631a20a64 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:22:12 +0000 Subject: [PATCH 30/84] =?UTF-8?q?mk:=20relational=20database=20queries=20?= =?UTF-8?q?=E2=80=94=20Datalog-style=20demo?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit tests/rdb.sx shows the library as a small Datalog engine over fact tables. Each table is an SX list of tuples, wrapped by a relation that does (membero (list ...) table). Queries compose selection, projection, and joins entirely in run* / fresh / conde / membero / intarith / nafc. Five queries: dept filter, salary > threshold, employee-project join, intersection (engineers on a specific project), anyone on multiple distinct projects. 5 new tests, 336/336 cumulative. --- lib/minikanren/tests/rdb.sx | 90 +++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 6 +++ 2 files changed, 96 insertions(+) create mode 100644 lib/minikanren/tests/rdb.sx diff --git a/lib/minikanren/tests/rdb.sx b/lib/minikanren/tests/rdb.sx new file mode 100644 index 00000000..96514058 --- /dev/null +++ b/lib/minikanren/tests/rdb.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index ca39f8c5..fd39efa1 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,12 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Datalog-style relational database queries**: tests/rdb.sx + shows miniKanren as a query engine over fact tables. Defines two tables + (employees + project assignments), wraps each with a relation that does + membero over the table, then expresses queries: dept filter, salary > + threshold (intarith), join engineers ↔ runtime project, find anyone on + multiple distinct projects (nafc + ==). 5 new tests, 336/336 cumulative. - **2026-05-08** — **Cyclic graph behaviour test (motivates Phase 7 tabling)**: Demonstrates that naive patho on a 2-cycle generates ever-longer paths. `run 5` truncates to a finite prefix; `run*` would diverge. This is From 99066430fd07d366e0958b3b9b1ca8e6ab7999e6 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:25:12 +0000 Subject: [PATCH 31/84] =?UTF-8?q?mk:=20lasto=20+=20init-o=20=E2=80=94=20la?= =?UTF-8?q?st=20and=20not-last=20list=20relations?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit lasto: x is the final element of l. Direct base case (l = (x)) plus recurse-on-cdr. init-o: init is l without its last element. Base case for singleton: (== init ()). Otherwise recurse, threading the head through to the init result via conso. Together with appendo, the round-trip init append (list last) = l holds, which is exercised by an end-to-end test. 8 new tests, 344/344 cumulative. --- lib/minikanren/relations.sx | 16 +++++++++++++++ lib/minikanren/tests/lasto.sx | 38 +++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 4 ++++ 3 files changed, 58 insertions(+) create mode 100644 lib/minikanren/tests/lasto.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 84d4e76b..60200c86 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -156,3 +156,19 @@ (conde ((fresh (a d) (conso a d l) (rel a))) ((fresh (a d) (conso a d l) (someo rel d)))))) + +(define + lasto + (fn + (l x) + (conde + ((conso x (list) l)) + ((fresh (a d) (conso a d l) (lasto d x)))))) + +(define + init-o + (fn + (l init) + (conde + ((fresh (x) (conso x (list) l) (== init (list)))) + ((fresh (a d d-init) (conso a d l) (conso a d-init init) (init-o d d-init)))))) diff --git a/lib/minikanren/tests/lasto.sx b/lib/minikanren/tests/lasto.sx new file mode 100644 index 00000000..110f8019 --- /dev/null +++ b/lib/minikanren/tests/lasto.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index fd39efa1..3515133f 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,10 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **lasto / init-o**: classic head/tail-style list relations. + lasto extracts the final element; init-o extracts everything-but-the-last. + Together with appendo, the round-trip `init ⊕ (last) = l` holds. 8 new + tests, 344/344 cumulative. - **2026-05-08** — **Datalog-style relational database queries**: tests/rdb.sx shows miniKanren as a query engine over fact tables. Defines two tables (employees + project assignments), wraps each with a relation that does From ada405b37b47e7b406e15e90ac71527192614361 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:27:49 +0000 Subject: [PATCH 32/84] =?UTF-8?q?mk:=20defrel=20=E2=80=94=20Prolog-style?= =?UTF-8?q?=20relation-definition=20macro?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (defrel (NAME ARGS...) (CLAUSE1 ...) (CLAUSE2 ...) ...) expands to (define NAME (fn (ARGS...) (conde (CLAUSE1 ...) (CLAUSE2 ...) ...))). Mirrors Prolog's `name(Args) :- goals.` shape. Inherits the Zzz-on-each- clause laziness from conde, so user relations defined via defrel terminate on partial answers without needing manual delay. Tests redefine membero / listo / pluso through defrel and verify equivalence. 3 new tests, 347/347 cumulative. --- lib/minikanren/defrel.sx | 25 +++++++++++++++++++++ lib/minikanren/tests/defrel.sx | 40 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 5 +++++ 3 files changed, 70 insertions(+) create mode 100644 lib/minikanren/defrel.sx create mode 100644 lib/minikanren/tests/defrel.sx diff --git a/lib/minikanren/defrel.sx b/lib/minikanren/defrel.sx new file mode 100644 index 00000000..03604542 --- /dev/null +++ b/lib/minikanren/defrel.sx @@ -0,0 +1,25 @@ +;; lib/minikanren/defrel.sx — Prolog-style defrel macro. +;; +;; (defrel (NAME ARG1 ARG2 ...) +;; (CLAUSE1 ...) +;; (CLAUSE2 ...) +;; ...) +;; +;; expands to +;; +;; (define NAME (fn (ARG1 ARG2 ...) (conde (CLAUSE1 ...) (CLAUSE2 ...)))) +;; +;; This puts each clause's goals immediately after the head, mirroring +;; Prolog's `name(Args) :- goals.` shape. Clauses are conde-conjoined +;; goals — `Zzz`-wrapping is automatic via `conde`, so recursive +;; relations terminate on partial answers. + +(defmacro + defrel + (head &rest clauses) + (let + ((name (first head)) (args (rest head))) + (list + (quote define) + name + (list (quote fn) args (cons (quote conde) clauses))))) diff --git a/lib/minikanren/tests/defrel.sx b/lib/minikanren/tests/defrel.sx new file mode 100644 index 00000000..9456bde7 --- /dev/null +++ b/lib/minikanren/tests/defrel.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 3515133f..56caa71c 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **defrel — Prolog-style relation definition macro**: + `(defrel (NAME ARGS...) (CLAUSE1 ...) (CLAUSE2 ...) ...)` expands to + `(define NAME (fn (ARGS...) (conde (CLAUSE1 ...) (CLAUSE2 ...) ...)))`. + Mirrors Prolog's clause syntax and inherits Zzz-via-conde so recursive + relations terminate. 3 new tests, 347/347 cumulative. - **2026-05-08** — **lasto / init-o**: classic head/tail-style list relations. lasto extracts the final element; init-o extracts everything-but-the-last. Together with appendo, the round-trip `init ⊕ (last) = l` holds. 8 new From 54a58c704eebec24c4e1e745d4a27733ca2c5905 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:30:02 +0000 Subject: [PATCH 33/84] =?UTF-8?q?mk:=20eveno=20+=20oddo=20=E2=80=94=20Pean?= =?UTF-8?q?o=20parity=20predicates?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit eveno: zero, or (s (s m)) when m is even. oddo: one, or (s (s m)) when m is odd. Both run forward (predicate test on a Peano number) and backward (enumerate even / odd numbers). The two are mutually exclusive — no number satisfies both. 12 new tests, 359/359 cumulative. --- lib/minikanren/peano.sx | 16 ++++++++++ lib/minikanren/tests/parity.sx | 58 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 4 +++ 3 files changed, 78 insertions(+) create mode 100644 lib/minikanren/tests/parity.sx diff --git a/lib/minikanren/peano.sx b/lib/minikanren/peano.sx index 9865cf72..cdbec76e 100644 --- a/lib/minikanren/peano.sx +++ b/lib/minikanren/peano.sx @@ -26,6 +26,22 @@ (define lto (fn (a b) (fresh (sa) (succ-of a sa) (lteo sa b)))) +(define + eveno + (fn + (n) + (conde + ((== n :z)) + ((fresh (m) (== n (list :s (list :s m))) (eveno m)))))) + +(define + oddo + (fn + (n) + (conde + ((== n (list :s :z))) + ((fresh (m) (== n (list :s (list :s m))) (oddo m)))))) + (define *o (fn diff --git a/lib/minikanren/tests/parity.sx b/lib/minikanren/tests/parity.sx new file mode 100644 index 00000000..fc445558 --- /dev/null +++ b/lib/minikanren/tests/parity.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 56caa71c..9834c5c4 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,10 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **eveno / oddo Peano predicates**: classic miniKanren parity + relations. eveno: 0 or successor-of-successor of even; oddo: 1 or + successor-of-successor of odd. Both run forward (test) and backward + (enumerate). 12 new tests, 359/359 cumulative. - **2026-05-08** — **defrel — Prolog-style relation definition macro**: `(defrel (NAME ARGS...) (CLAUSE1 ...) (CLAUSE2 ...) ...)` expands to `(define NAME (fn (ARGS...) (conde (CLAUSE1 ...) (CLAUSE2 ...) ...)))`. From 8c48a0be63a17bb0550dae931c0c608d04beda65 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:32:33 +0000 Subject: [PATCH 34/84] =?UTF-8?q?mk:=20tako=20+=20dropo=20=E2=80=94=20Pean?= =?UTF-8?q?o-indexed=20prefix=20and=20suffix?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (tako n l prefix) — prefix is the first n elements of l. (dropo n l suffix) — suffix is l after dropping the first n. Both use a Peano natural for the count. Round-trip holds: (tako n l) ⊕ (dropo n l) = l (verified by an end-to-end test) 9 new tests, 368/368 cumulative. --- lib/minikanren/relations.sx | 16 ++++++ lib/minikanren/tests/take-drop.sx | 92 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 3 + 3 files changed, 111 insertions(+) create mode 100644 lib/minikanren/tests/take-drop.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 60200c86..b9f382c5 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -172,3 +172,19 @@ (conde ((fresh (x) (conso x (list) l) (== init (list)))) ((fresh (a d d-init) (conso a d l) (conso a d-init init) (init-o d d-init)))))) + +(define + tako + (fn + (n l prefix) + (conde + ((== n :z) (== prefix (list))) + ((fresh (n-1 a d p-rest) (== n (list :s n-1)) (conso a d l) (conso a p-rest prefix) (tako n-1 d p-rest)))))) + +(define + dropo + (fn + (n l suffix) + (conde + ((== n :z) (== suffix l)) + ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (dropo n-1 d suffix)))))) diff --git a/lib/minikanren/tests/take-drop.sx b/lib/minikanren/tests/take-drop.sx new file mode 100644 index 00000000..c8c2959d --- /dev/null +++ b/lib/minikanren/tests/take-drop.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 9834c5c4..a2640338 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,9 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **tako + dropo (Peano-indexed prefix/suffix)**: takes / drops + the first n elements via a Peano-encoded count. Round-trip + `(tako n l) ⊕ (dropo n l) = l` holds. 9 new tests, 368/368 cumulative. - **2026-05-08** — **eveno / oddo Peano predicates**: classic miniKanren parity relations. eveno: 0 or successor-of-successor of even; oddo: 1 or successor-of-successor of odd. Both run forward (test) and backward From c2b238635f2f675cf822f229b61ff398b70b6690 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:34:28 +0000 Subject: [PATCH 35/84] mk: repeato + concato repeato: produces (or recognizes) a list of n copies of a value, with n Peano-encoded. Runs forward, backward (recover the count from a uniform list), and bidirectionally. concato: fold-appendo over a list-of-lists. (concato (list (list 1 2) (list) (list 3 4 5)) q) -> ((1 2 3 4 5)). 10 new tests, 378/378 cumulative. --- lib/minikanren/relations.sx | 16 ++++++ lib/minikanren/tests/repeato-concato.sx | 69 +++++++++++++++++++++++++ plans/minikanren-on-sx.md | 4 ++ 3 files changed, 89 insertions(+) create mode 100644 lib/minikanren/tests/repeato-concato.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index b9f382c5..6423a759 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -188,3 +188,19 @@ (conde ((== n :z) (== suffix l)) ((fresh (n-1 a d) (== n (list :s n-1)) (conso a d l) (dropo n-1 d suffix)))))) + +(define + repeato + (fn + (x n result) + (conde + ((== n :z) (== result (list))) + ((fresh (n-1 r-rest) (== n (list :s n-1)) (conso x r-rest result) (repeato x n-1 r-rest)))))) + +(define + concato + (fn + (lists result) + (conde + ((nullo lists) (nullo result)) + ((fresh (h t r-rest) (conso h t lists) (appendo h r-rest result) (concato t r-rest)))))) diff --git a/lib/minikanren/tests/repeato-concato.sx b/lib/minikanren/tests/repeato-concato.sx new file mode 100644 index 00000000..ff730413 --- /dev/null +++ b/lib/minikanren/tests/repeato-concato.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index a2640338..9f5749a6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,10 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **repeato + concato**: repeato builds a list of n copies + (Peano n); concato is fold-appendo over a list of lists. Both run forward + and backward — repeato can recover the count from a uniform list. 10 new + tests, 378/378 cumulative. - **2026-05-08** — **tako + dropo (Peano-indexed prefix/suffix)**: takes / drops the first n elements via a Peano-encoded count. Round-trip `(tako n l) ⊕ (dropo n l) = l` holds. 9 new tests, 368/368 cumulative. From 7b6cb64548d3eaf9d4bd39a8239d8f14f18ff460 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:36:14 +0000 Subject: [PATCH 36/84] =?UTF-8?q?mk:=20not-membero=20=E2=80=94=20relationa?= =?UTF-8?q?l=20"x=20is=20not=20in=20l"?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Mirrors the structure all-distincto already uses internally: walk the list, ensure each element is not equal to x via nafc, recurse on tail. Useful as a constraint-style filter: (membero x (list 1 2 3 4 5)) (not-membero x (list 2 4)) -> x in {1, 3, 5} 4 new tests, 382/382 cumulative. --- lib/minikanren/relations.sx | 10 +++++++++- lib/minikanren/tests/not-membero.sx | 29 +++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 4 ++++ 3 files changed, 42 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/not-membero.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 6423a759..b04768d7 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -50,6 +50,14 @@ ((fresh (d) (conso x d l))) ((fresh (a d) (conso a d l) (membero x d)))))) +(define + not-membero + (fn + (x l) + (conde + ((nullo l)) + ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d)))))) + (define reverseo (fn @@ -82,6 +90,7 @@ ((nullo l) (nullo p)) ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p)))))) + (define flatteno (fn @@ -97,7 +106,6 @@ (appendo hf tf flat))) ((nafc (nullo tree)) (nafc (pairo tree)) (== flat (list tree)))))) - (define rembero (fn diff --git a/lib/minikanren/tests/not-membero.sx b/lib/minikanren/tests/not-membero.sx new file mode 100644 index 00000000..8952f79e --- /dev/null +++ b/lib/minikanren/tests/not-membero.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 9f5749a6..733eaea6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,10 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **not-membero**: relational "x is not a member of l". + Uses `nafc + ==` per element (the same skeleton all-distincto uses). + Useful as a constraint-style filter: `(membero x dom) (not-membero x + excluded)`. 4 new tests, 382/382 cumulative. - **2026-05-08** — **repeato + concato**: repeato builds a list of n copies (Peano n); concato is fold-appendo over a list of lists. Both run forward and backward — repeato can recover the count from a uniform list. 10 new From 6ee02db2ab21ee2b8266ed5dc4519d3f01c5231d Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:38:29 +0000 Subject: [PATCH 37/84] =?UTF-8?q?mk:=20palindromeo=20=E2=80=94=20list=20re?= =?UTF-8?q?ads=20same=20forwards/backwards?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two-line definition: a list is a palindrome iff it equals its reverse. Direct composition of reverseo + ==. 7 new tests: empty / singleton / equal pair / unequal pair / 5-element-yes / 5-element-no / strings. 389/389 cumulative. --- lib/minikanren/relations.sx | 4 ++- lib/minikanren/tests/palindromeo.sx | 44 +++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/palindromeo.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index b04768d7..2475125a 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -66,6 +66,8 @@ ((nullo l) (nullo r)) ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r)))))) +(define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) + (define lengtho (fn @@ -82,6 +84,7 @@ ((conso a l p)) ((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt)))))) + (define permuteo (fn @@ -90,7 +93,6 @@ ((nullo l) (nullo p)) ((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p)))))) - (define flatteno (fn diff --git a/lib/minikanren/tests/palindromeo.sx b/lib/minikanren/tests/palindromeo.sx new file mode 100644 index 00000000..0d28773f --- /dev/null +++ b/lib/minikanren/tests/palindromeo.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 733eaea6..cb59ed9b 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **palindromeo**: 2-line definition (reverseo + ==). Succeeds when a list reads the same forwards and backwards. 7 new tests, 389/389 cumulative. - **2026-05-08** — **not-membero**: relational "x is not a member of l". Uses `nafc + ==` per element (the same skeleton all-distincto uses). Useful as a constraint-style filter: `(membero x dom) (not-membero x From fc14a8063b41eaef642d2ee43b12af05323b3747 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:40:28 +0000 Subject: [PATCH 38/84] =?UTF-8?q?mk:=20prefixo=20+=20suffixo=20=E2=80=94?= =?UTF-8?q?=20appendo-derived=20sublist=20relations?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two-line definitions over appendo: (prefixo p l) ≡ ∃rest. (appendo p rest l) (suffixo s l) ≡ ∃front. (appendo front s l) Both enumerate all prefixes/suffixes when called with a fresh first arg, and serve as decision relations when called with both grounded. 9 new tests, 398/398 cumulative. --- lib/minikanren/relations.sx | 6 ++- lib/minikanren/tests/prefix-suffix.sx | 76 +++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 82 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/prefix-suffix.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 2475125a..b86b5e3b 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -68,6 +68,11 @@ (define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) +(define prefixo (fn (p l) (fresh (rest) (appendo p rest l)))) + +(define suffixo (fn (s l) (fresh (front) (appendo front s l)))) + + (define lengtho (fn @@ -84,7 +89,6 @@ ((conso a l p)) ((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt)))))) - (define permuteo (fn diff --git a/lib/minikanren/tests/prefix-suffix.sx b/lib/minikanren/tests/prefix-suffix.sx new file mode 100644 index 00000000..7237ef1d --- /dev/null +++ b/lib/minikanren/tests/prefix-suffix.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index cb59ed9b..a12b67b3 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **prefixo + suffixo**: classic appendo-derived sublist relations. (prefixo p l) ≡ p ⊕ ? = l; (suffixo s l) ≡ ? ⊕ s = l. Both enumerate all prefixes/suffixes when given a fresh first arg. 9 new tests, 398/398 cumulative. - **2026-05-08** — **palindromeo**: 2-line definition (reverseo + ==). Succeeds when a list reads the same forwards and backwards. 7 new tests, 389/389 cumulative. - **2026-05-08** — **not-membero**: relational "x is not a member of l". Uses `nafc + ==` per element (the same skeleton all-distincto uses). From e202c81a0d4817da4e2a0f59a0fb5eeb1c029b58 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:45:31 +0000 Subject: [PATCH 39/84] =?UTF-8?q?mk:=20subo=20=E2=80=94=20contiguous=20sub?= =?UTF-8?q?list=20relation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Composes two appendos: l = front ++ s ++ back, equivalently (appendo front-and-s back l) and (appendo front s front-and-s). Goal order matters: doing the (appendo ground:l) split first makes the search finitary; the second appendo is then deterministic given front-and-s and ground s. Reversing the order causes divergence on failing inputs (the front search becomes unbounded). 7 new tests, 405/405 cumulative. --- lib/minikanren/relations.sx | 9 ++++++ lib/minikanren/tests/subo.sx | 60 ++++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 70 insertions(+) create mode 100644 lib/minikanren/tests/subo.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index b86b5e3b..4b9c61c2 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -73,6 +73,15 @@ (define suffixo (fn (s l) (fresh (front) (appendo front s l)))) +(define + subo + (fn + (s l) + (fresh + (front-and-s back front) + (appendo front-and-s back l) + (appendo front s front-and-s)))) + (define lengtho (fn diff --git a/lib/minikanren/tests/subo.sx b/lib/minikanren/tests/subo.sx new file mode 100644 index 00000000..a48c645a --- /dev/null +++ b/lib/minikanren/tests/subo.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index a12b67b3..b2dcaa2e 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **subo (contiguous sublist)**: Two appendos chained — l = front ++ s ++ back. Goal order matters: appendo on the ground l first, so the search is finitary; then constrain front. 7 new tests, 405/405 cumulative. - **2026-05-08** — **prefixo + suffixo**: classic appendo-derived sublist relations. (prefixo p l) ≡ p ⊕ ? = l; (suffixo s l) ≡ ? ⊕ s = l. Both enumerate all prefixes/suffixes when given a fresh first arg. 9 new tests, 398/398 cumulative. - **2026-05-08** — **palindromeo**: 2-line definition (reverseo + ==). Succeeds when a list reads the same forwards and backwards. 7 new tests, 389/389 cumulative. - **2026-05-08** — **not-membero**: relational "x is not a member of l". From 4d861575df8842b82ad152095575a07760f84194 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:47:27 +0000 Subject: [PATCH 40/84] =?UTF-8?q?mk:=20selecto=20=E2=80=94=20choose=20elem?= =?UTF-8?q?ent=20+=20rest=20of=20list?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Classic miniKanren relation. (selecto x rest l) holds when l contains x at any position with `rest` being everything else. Direct base case (l = (x . rest)) plus the skip-head recursion that threads the head through to the result rest. Run modes: enumerate every (x, rest) split; recover rest given an element; recover an element given the rest; (and ground/all combinations). 6 new tests, 411/411 cumulative. --- lib/minikanren/relations.sx | 8 ++++++ lib/minikanren/tests/selecto.sx | 46 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 55 insertions(+) create mode 100644 lib/minikanren/tests/selecto.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 4b9c61c2..b2b837a8 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -82,6 +82,14 @@ (appendo front-and-s back l) (appendo front s front-and-s)))) +(define + selecto + (fn + (x rest l) + (conde + ((conso x rest l)) + ((fresh (a d r) (conso a d l) (conso a r rest) (selecto x r d)))))) + (define lengtho (fn diff --git a/lib/minikanren/tests/selecto.sx b/lib/minikanren/tests/selecto.sx new file mode 100644 index 00000000..ba34a86b --- /dev/null +++ b/lib/minikanren/tests/selecto.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index b2dcaa2e..b040fb45 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **selecto**: classic miniKanren "choose an element + rest". Direct base (l = (x . rest)) plus skip-head recurse. Enumerates all (element, rest) splits in run*; runs forward, backward, mid-pipeline. 6 new tests, 411/411 cumulative. - **2026-05-08** — **subo (contiguous sublist)**: Two appendos chained — l = front ++ s ++ back. Goal order matters: appendo on the ground l first, so the search is finitary; then constrain front. 7 new tests, 405/405 cumulative. - **2026-05-08** — **prefixo + suffixo**: classic appendo-derived sublist relations. (prefixo p l) ≡ p ⊕ ? = l; (suffixo s l) ≡ ? ⊕ s = l. Both enumerate all prefixes/suffixes when given a fresh first arg. 9 new tests, 398/398 cumulative. - **2026-05-08** — **palindromeo**: 2-line definition (reverseo + ==). Succeeds when a list reads the same forwards and backwards. 7 new tests, 389/389 cumulative. From d992788a03b2a627f7dbaf0ebdf83c9de3408267 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:49:47 +0000 Subject: [PATCH 41/84] =?UTF-8?q?mk:=20even-i=20/=20odd-i=20=E2=80=94=20ho?= =?UTF-8?q?st-arithmetic=20parity=20goals?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two-line definitions over project + host even?/odd?. Ground-only — no relational behaviour, but they pair cleanly with membero for filtered enumeration: (fresh (x) (membero x (list 1 2 3 4 5 6)) (even-i x) (== q x)) -> (2 4 6) 5 new tests, 416/416 cumulative. --- lib/minikanren/intarith.sx | 8 ++++++++ lib/minikanren/tests/intarith.sx | 14 ++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 23 insertions(+) diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 1ca9aee2..ed3692a9 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -60,3 +60,11 @@ (define stringo (fn (x) (project (x) (if (string? x) succeed fail)))) (define symbolo (fn (x) (project (x) (if (symbol? x) succeed fail)))) + +(define + even-i + (fn (n) (project (n) (if (and (number? n) (even? n)) succeed fail)))) + +(define + odd-i + (fn (n) (project (n) (if (and (number? n) (odd? n)) succeed fail)))) diff --git a/lib/minikanren/tests/intarith.sx b/lib/minikanren/tests/intarith.sx index d81db4c1..baab8fe2 100644 --- a/lib/minikanren/tests/intarith.sx +++ b/lib/minikanren/tests/intarith.sx @@ -86,4 +86,18 @@ (== 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!) + diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index b040fb45..07f05f2c 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **even-i / odd-i (intarith)**: ground-only parity goals via project. Composes with membero for filtered enumeration: -> . 5 new tests, 416/416 cumulative. - **2026-05-08** — **selecto**: classic miniKanren "choose an element + rest". Direct base (l = (x . rest)) plus skip-head recurse. Enumerates all (element, rest) splits in run*; runs forward, backward, mid-pipeline. 6 new tests, 411/411 cumulative. - **2026-05-08** — **subo (contiguous sublist)**: Two appendos chained — l = front ++ s ++ back. Goal order matters: appendo on the ground l first, so the search is finitary; then constrain front. 7 new tests, 405/405 cumulative. - **2026-05-08** — **prefixo + suffixo**: classic appendo-derived sublist relations. (prefixo p l) ≡ p ⊕ ? = l; (suffixo s l) ≡ ? ⊕ s = l. Both enumerate all prefixes/suffixes when given a fresh first arg. 9 new tests, 398/398 cumulative. From 6fc155ddd82cdb6b687b761f9387c495de4ecdce Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:51:51 +0000 Subject: [PATCH 42/84] =?UTF-8?q?mk:=20rev-acco=20+=20rev-2o=20=E2=80=94?= =?UTF-8?q?=20accumulator-style=20reverse?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit rev-acco is the standard tail-recursive reverse with an accumulator; rev-2o starts the accumulator at the empty list. Faster than the appendo-driven reverseo for forward queries because there is no nested appendo per element. Trade-off: rev-acco is asymmetric. The accumulator's initial-empty cannot be enumerated backwards the way reverseo does, so reverseo is still the right choice when both directions matter. A test verifies rev-2o and reverseo agree on forward queries. 6 new tests, 422/422 cumulative. --- lib/minikanren/relations.sx | 12 ++++++++- lib/minikanren/tests/rev-acco.sx | 46 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 58 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/rev-acco.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index b2b837a8..ca2abf09 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -66,13 +66,23 @@ ((nullo l) (nullo r)) ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r)))))) +(define + rev-acco + (fn + (l acc result) + (conde + ((nullo l) (== result acc)) + ((fresh (a d acc-prime) (conso a d l) (conso a acc acc-prime) (rev-acco d acc-prime result)))))) + +(define rev-2o (fn (l result) (rev-acco l (list) result))) + (define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) + (define prefixo (fn (p l) (fresh (rest) (appendo p rest l)))) (define suffixo (fn (s l) (fresh (front) (appendo front s l)))) - (define subo (fn diff --git a/lib/minikanren/tests/rev-acco.sx b/lib/minikanren/tests/rev-acco.sx new file mode 100644 index 00000000..6733fe9a --- /dev/null +++ b/lib/minikanren/tests/rev-acco.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 07f05f2c..5307dc9c 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **rev-acco / rev-2o**: accumulator-style reversal — faster than appendo-driven reverseo for forward queries because no quadratic appendos. Trade-off: rev-acco is asymmetric (cannot run cleanly backward in run*). 6 new tests, 422/422 cumulative. - **2026-05-08** — **even-i / odd-i (intarith)**: ground-only parity goals via project. Composes with membero for filtered enumeration: -> . 5 new tests, 416/416 cumulative. - **2026-05-08** — **selecto**: classic miniKanren "choose an element + rest". Direct base (l = (x . rest)) plus skip-head recurse. Enumerates all (element, rest) splits in run*; runs forward, backward, mid-pipeline. 6 new tests, 411/411 cumulative. - **2026-05-08** — **subo (contiguous sublist)**: Two appendos chained — l = front ++ s ++ back. Goal order matters: appendo on the ground l first, so the search is finitary; then constrain front. 7 new tests, 405/405 cumulative. From 136cacbd3f66cfa46af2bb868074a3046ad1326a Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:54:24 +0000 Subject: [PATCH 43/84] =?UTF-8?q?mk:=20iterate-no=20=E2=80=94=20apply=20a?= =?UTF-8?q?=20relation=20n=20times?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (iterate-no rel n x result) holds when applying the 2-arg relation rel n times (Peano n) starting from x produces result. Base case: zero iterations means result equals x. Recursive case: rel x mid, then iterate-no n-1 from mid. Generalises common chains: succ iteration: (iterate-no succ-rel n :z q) -> n in Peano list growth: (iterate-no cons-rel n () q) -> n-element list 4 new tests, 426/426 cumulative. --- lib/minikanren/relations.sx | 8 +++++++ lib/minikanren/tests/iterate-no.sx | 38 ++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 47 insertions(+) create mode 100644 lib/minikanren/tests/iterate-no.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index ca2abf09..1afee3c5 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -182,6 +182,14 @@ ((nullo l1) (nullo l2)) ((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime)))))) +(define + iterate-no + (fn + (rel n x result) + (conde + ((== n :z) (== result x)) + ((fresh (n-1 mid) (== n (list :s n-1)) (rel x mid) (iterate-no rel n-1 mid result)))))) + (define everyo (fn diff --git a/lib/minikanren/tests/iterate-no.sx b/lib/minikanren/tests/iterate-no.sx new file mode 100644 index 00000000..56405e52 --- /dev/null +++ b/lib/minikanren/tests/iterate-no.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 5307dc9c..2307e5c2 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **iterate-no**: relational iterated application. Applies a 2-arg relation n times (Peano n) starting from x to produce result. Generalises succ-iteration / list-cons-iteration / etc. 4 new tests, 426/426 cumulative. - **2026-05-08** — **rev-acco / rev-2o**: accumulator-style reversal — faster than appendo-driven reverseo for forward queries because no quadratic appendos. Trade-off: rev-acco is asymmetric (cannot run cleanly backward in run*). 6 new tests, 422/422 cumulative. - **2026-05-08** — **even-i / odd-i (intarith)**: ground-only parity goals via project. Composes with membero for filtered enumeration: -> . 5 new tests, 416/416 cumulative. - **2026-05-08** — **selecto**: classic miniKanren "choose an element + rest". Direct base (l = (x . rest)) plus skip-head recurse. Enumerates all (element, rest) splits in run*; runs forward, backward, mid-pipeline. 6 new tests, 411/411 cumulative. From c04ddd105bb48bac86f595c73593812ac7e13505 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:57:12 +0000 Subject: [PATCH 44/84] =?UTF-8?q?mk:=20pairlisto=20=E2=80=94=20relational?= =?UTF-8?q?=20zip?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (pairlisto l1 l2 pairs): pairs is the zipped list of pairs (l1[i] l2[i]). Recurses on both l1 and l2 in lockstep, building pairs in parallel. Runs forward, can recover l1 given l2 and pairs, can recover l2 given l1 and pairs. Different-length lists fail. 5 new tests, 431/431 cumulative. --- lib/minikanren/relations.sx | 8 ++++++ lib/minikanren/tests/pairlisto.sx | 41 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 50 insertions(+) create mode 100644 lib/minikanren/tests/pairlisto.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 1afee3c5..ce49586c 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -190,6 +190,14 @@ ((== n :z) (== result x)) ((fresh (n-1 mid) (== n (list :s n-1)) (rel x mid) (iterate-no rel n-1 mid result)))))) +(define + pairlisto + (fn + (l1 l2 pairs) + (conde + ((nullo l1) (nullo l2) (nullo pairs)) + ((fresh (a1 d1 a2 d2 d-pairs) (conso a1 d1 l1) (conso a2 d2 l2) (conso (list a1 a2) d-pairs pairs) (pairlisto d1 d2 d-pairs)))))) + (define everyo (fn diff --git a/lib/minikanren/tests/pairlisto.sx b/lib/minikanren/tests/pairlisto.sx new file mode 100644 index 00000000..5406d37b --- /dev/null +++ b/lib/minikanren/tests/pairlisto.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 2307e5c2..9b096dd9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **pairlisto**: relational zip — pairs is the zipped list of (l1[i] l2[i]). Runs forward, recovers l1 given l2 and pairs, recovers l2 given l1 and pairs. 5 new tests, 431/431 cumulative. - **2026-05-08** — **iterate-no**: relational iterated application. Applies a 2-arg relation n times (Peano n) starting from x to produce result. Generalises succ-iteration / list-cons-iteration / etc. 4 new tests, 426/426 cumulative. - **2026-05-08** — **rev-acco / rev-2o**: accumulator-style reversal — faster than appendo-driven reverseo for forward queries because no quadratic appendos. Trade-off: rev-acco is asymmetric (cannot run cleanly backward in run*). 6 new tests, 422/422 cumulative. - **2026-05-08** — **even-i / odd-i (intarith)**: ground-only parity goals via project. Composes with membero for filtered enumeration: -> . 5 new tests, 416/416 cumulative. From eb69039935c91eda42ed2c94645985a0a4011089 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 11:59:41 +0000 Subject: [PATCH 45/84] =?UTF-8?q?mk:=20swap-firsto=20=E2=80=94=20swap=20fi?= =?UTF-8?q?rst=20two=20list=20elements?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Four conso calls express the (a b . rest) -> (b a . rest) rewrite as a purely relational constraint. Self-inverse on length-2+ lists; runs forward (swap given input) and backward (recover original from the swapped form). Fails on lists shorter than 2. 6 new tests, 437/437 cumulative. --- lib/minikanren/relations.sx | 11 ++++++++++ lib/minikanren/tests/swap-firsto.sx | 32 +++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 44 insertions(+) create mode 100644 lib/minikanren/tests/swap-firsto.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index ce49586c..73bfd532 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -198,6 +198,17 @@ ((nullo l1) (nullo l2) (nullo pairs)) ((fresh (a1 d1 a2 d2 d-pairs) (conso a1 d1 l1) (conso a2 d2 l2) (conso (list a1 a2) d-pairs pairs) (pairlisto d1 d2 d-pairs)))))) +(define + swap-firsto + (fn + (l result) + (fresh + (a b rest mid-l mid-r) + (conso a mid-l l) + (conso b rest mid-l) + (conso b mid-r result) + (conso a rest mid-r)))) + (define everyo (fn diff --git a/lib/minikanren/tests/swap-firsto.sx b/lib/minikanren/tests/swap-firsto.sx new file mode 100644 index 00000000..773a57c2 --- /dev/null +++ b/lib/minikanren/tests/swap-firsto.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 9b096dd9..f77aa993 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **swap-firsto**: swap the first two elements of a list. Built via four conso constraints. Self-inverse on length-2+ lists; runs forward and backward. 6 new tests, 437/437 cumulative. - **2026-05-08** — **pairlisto**: relational zip — pairs is the zipped list of (l1[i] l2[i]). Runs forward, recovers l1 given l2 and pairs, recovers l2 given l1 and pairs. 5 new tests, 431/431 cumulative. - **2026-05-08** — **iterate-no**: relational iterated application. Applies a 2-arg relation n times (Peano n) starting from x to produce result. Generalises succ-iteration / list-cons-iteration / etc. 4 new tests, 426/426 cumulative. - **2026-05-08** — **rev-acco / rev-2o**: accumulator-style reversal — faster than appendo-driven reverseo for forward queries because no quadratic appendos. Trade-off: rev-acco is asymmetric (cannot run cleanly backward in run*). 6 new tests, 422/422 cumulative. From 6bc3c14dac9f64eb115a7ad9501d56071f216a8c Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:02:13 +0000 Subject: [PATCH 46/84] =?UTF-8?q?mk:=20btree-walko=20=E2=80=94=20binary-tr?= =?UTF-8?q?ee=20walker=20via=20matche?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Demo of matche dispatch + conde + recursion for tree traversal: (matche tree ((:leaf x) (== v x)) ((:node l r) (conde ((btree-walko l v)) ((btree-walko r v))))) Test tree ((1 2) (3 (4 5))) yields all 5 leaves under run*. Also tests membership (run 1) and absence. 4 new tests, 441/441 cumulative. --- lib/minikanren/tests/btree-walko.sx | 54 +++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 2 files changed, 55 insertions(+) create mode 100644 lib/minikanren/tests/btree-walko.sx diff --git a/lib/minikanren/tests/btree-walko.sx b/lib/minikanren/tests/btree-walko.sx new file mode 100644 index 00000000..0dc617b1 --- /dev/null +++ b/lib/minikanren/tests/btree-walko.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index f77aa993..0bb00f17 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **btree-walko (matche showcase)**: walks a binary tree (:leaf v) | (:node l r) and emits each leaf value via conde. Demonstrates matche dispatch on tagged-list patterns, recursion through both branches via conde, and run* enumerating all 5 leaves of a small tree. 4 new tests, 441/441 cumulative. - **2026-05-08** — **swap-firsto**: swap the first two elements of a list. Built via four conso constraints. Self-inverse on length-2+ lists; runs forward and backward. 6 new tests, 437/437 cumulative. - **2026-05-08** — **pairlisto**: relational zip — pairs is the zipped list of (l1[i] l2[i]). Runs forward, recovers l1 given l2 and pairs, recovers l2 given l1 and pairs. 5 new tests, 431/431 cumulative. - **2026-05-08** — **iterate-no**: relational iterated application. Applies a 2-arg relation n times (Peano n) starting from x to produce result. Generalises succ-iteration / list-cons-iteration / etc. 4 new tests, 426/426 cumulative. From 58d78de32afdbe8268d23abfa4d57b105c804007 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:04:17 +0000 Subject: [PATCH 47/84] =?UTF-8?q?mk:=20removeo-allo=20=E2=80=94=20remove?= =?UTF-8?q?=20every=20occurrence?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three conde clauses: empty list -> empty result; head matches x -> skip and recurse; head differs (nafc-gated) -> keep and recurse. Distinct from rembero, which removes only the first occurrence. 5 new tests, 446/446 cumulative. --- lib/minikanren/relations.sx | 9 +++++++ lib/minikanren/tests/removeo-allo.sx | 39 ++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 49 insertions(+) create mode 100644 lib/minikanren/tests/removeo-allo.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 73bfd532..8a2cdcda 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -148,6 +148,15 @@ ((fresh (a d) (conso a d l) (== a x) (== out d))) ((fresh (a d res) (conso a d l) (nafc (== a x)) (conso a res out) (rembero x d res)))))) +(define + removeo-allo + (fn + (x l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d) (conso a d l) (== a x) (removeo-allo x d result))) + ((fresh (a d r-rest) (conso a d l) (nafc (== a x)) (conso a r-rest result) (removeo-allo x d r-rest)))))) + (define assoco (fn diff --git a/lib/minikanren/tests/removeo-allo.sx b/lib/minikanren/tests/removeo-allo.sx new file mode 100644 index 00000000..b7dd8a31 --- /dev/null +++ b/lib/minikanren/tests/removeo-allo.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 0bb00f17..d04acc87 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **removeo-allo**: removes every occurrence of x (vs rembero, which removes only the first). Three conde clauses: empty -> empty; head matches -> skip and recurse; head differs (nafc) -> keep and recurse. 5 new tests, 446/446 cumulative. - **2026-05-08** — **btree-walko (matche showcase)**: walks a binary tree (:leaf v) | (:node l r) and emits each leaf value via conde. Demonstrates matche dispatch on tagged-list patterns, recursion through both branches via conde, and run* enumerating all 5 leaves of a small tree. 4 new tests, 441/441 cumulative. - **2026-05-08** — **swap-firsto**: swap the first two elements of a list. Built via four conso constraints. Self-inverse on length-2+ lists; runs forward and backward. 6 new tests, 437/437 cumulative. - **2026-05-08** — **pairlisto**: relational zip — pairs is the zipped list of (l1[i] l2[i]). Runs forward, recovers l1 given l2 and pairs, recovers l2 given l1 and pairs. 5 new tests, 431/431 cumulative. From 4df277803d93c6c6683c8233e6d204791bd5265f Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:07:00 +0000 Subject: [PATCH 48/84] mk: cycle-free path search test Mitigation for the cyclic-graph divergence (see tests/cyclic-graph.sx). Threads a `visited` accumulator through the recursion; each candidate next-step is gated by `nafc (membero z visited)`. Terminates on graphs with cycles, no Phase-7 tabling required for the simple acyclic-path query. Demonstrates a viable alternative to tabling for the common case where the user wants finite path enumeration over a graph with cycles. 3 new tests, 449/449 cumulative. --- lib/minikanren/tests/path-cycle-free.sx | 40 +++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 2 files changed, 41 insertions(+) create mode 100644 lib/minikanren/tests/path-cycle-free.sx diff --git a/lib/minikanren/tests/path-cycle-free.sx b/lib/minikanren/tests/path-cycle-free.sx new file mode 100644 index 00000000..2c46e407 --- /dev/null +++ b/lib/minikanren/tests/path-cycle-free.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index d04acc87..300c3661 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **cycle-free path search**: mitigation for the cyclic-graph divergence — thread a accumulator through the recursion, gate each step with nafc + membero on visited. Terminates on graphs with cycles; no Phase-7 tabling required for the simple case. 3 new tests, 449/449 cumulative. - **2026-05-08** — **removeo-allo**: removes every occurrence of x (vs rembero, which removes only the first). Three conde clauses: empty -> empty; head matches -> skip and recurse; head differs (nafc) -> keep and recurse. 5 new tests, 446/446 cumulative. - **2026-05-08** — **btree-walko (matche showcase)**: walks a binary tree (:leaf v) | (:node l r) and emits each leaf value via conde. Demonstrates matche dispatch on tagged-list patterns, recursion through both branches via conde, and run* enumerating all 5 leaves of a small tree. 4 new tests, 441/441 cumulative. - **2026-05-08** — **swap-firsto**: swap the first two elements of a list. Built via four conso constraints. Self-inverse on length-2+ lists; runs forward and backward. 6 new tests, 437/437 cumulative. From 6454603568a9615211e1b12b72f69283049b7bef Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:09:06 +0000 Subject: [PATCH 49/84] =?UTF-8?q?mk:=20subseto=20=E2=80=94=20every=20eleme?= =?UTF-8?q?nt=20of=20l1=20is=20in=20l2?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Recursive: empty l1 trivially holds; otherwise the head is in l2 (via membero) and the tail is a subset. Duplicates in l1 are allowed since each is independently checked. 7 new tests, 456/456 cumulative. --- lib/minikanren/relations.sx | 10 +++++- lib/minikanren/tests/subseto.sx | 62 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 72 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/subseto.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 8a2cdcda..8f18d87b 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -58,6 +58,14 @@ ((nullo l)) ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d)))))) +(define + subseto + (fn + (l1 l2) + (conde + ((nullo l1)) + ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2)))))) + (define reverseo (fn @@ -76,8 +84,8 @@ (define rev-2o (fn (l result) (rev-acco l (list) result))) -(define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) +(define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) (define prefixo (fn (p l) (fresh (rest) (appendo p rest l)))) diff --git a/lib/minikanren/tests/subseto.sx b/lib/minikanren/tests/subseto.sx new file mode 100644 index 00000000..68c4cf82 --- /dev/null +++ b/lib/minikanren/tests/subseto.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 300c3661..b34ccb53 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **subseto**: every element of l1 is a member of l2. Recurses on l1, checking each element via membero. Allows duplicates in l1 (each independently in l2). 7 new tests, 456/456 cumulative. - **2026-05-08** — **cycle-free path search**: mitigation for the cyclic-graph divergence — thread a accumulator through the recursion, gate each step with nafc + membero on visited. Terminates on graphs with cycles; no Phase-7 tabling required for the simple case. 3 new tests, 449/449 cumulative. - **2026-05-08** — **removeo-allo**: removes every occurrence of x (vs rembero, which removes only the first). Three conde clauses: empty -> empty; head matches -> skip and recurse; head differs (nafc) -> keep and recurse. 5 new tests, 446/446 cumulative. - **2026-05-08** — **btree-walko (matche showcase)**: walks a binary tree (:leaf v) | (:node l r) and emits each leaf value via conde. Demonstrates matche dispatch on tagged-list patterns, recursion through both branches via conde, and run* enumerating all 5 leaves of a small tree. 4 new tests, 441/441 cumulative. From c4b6f1fa0fedf5b8f1c40b4c62006d7bdc742857 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:10:52 +0000 Subject: [PATCH 50/84] =?UTF-8?q?mk:=20sortedo=20=E2=80=94=20list=20is=20n?= =?UTF-8?q?on-decreasing=20(intarith)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three conde clauses: empty list / singleton list / two-or-more (where the first two satisfy lteo-i and the rest is recursively sorted). Uses ground-only integer comparison (intarith), so the input list must walk to ground integers. 7 new tests, 463/463 cumulative. --- lib/minikanren/intarith.sx | 9 ++++++++ lib/minikanren/tests/sortedo.sx | 40 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 50 insertions(+) create mode 100644 lib/minikanren/tests/sortedo.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index ed3692a9..108caf86 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -68,3 +68,12 @@ (define odd-i (fn (n) (project (n) (if (and (number? n) (odd? n)) succeed fail)))) + +(define + sortedo + (fn + (l) + (conde + ((nullo l)) + ((fresh (a) (== l (list a)))) + ((fresh (a b rest mid) (conso a mid l) (conso b rest mid) (lteo-i a b) (sortedo mid)))))) diff --git a/lib/minikanren/tests/sortedo.sx b/lib/minikanren/tests/sortedo.sx new file mode 100644 index 00000000..6137da0c --- /dev/null +++ b/lib/minikanren/tests/sortedo.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index b34ccb53..3a05e6c6 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **sortedo (intarith)**: list is non-decreasing under integer ordering. Three conde clauses: empty / singleton / pair-and-recurse. Uses lteo-i for the adjacent-pair check (ground integers). 7 new tests, 463/463 cumulative. - **2026-05-08** — **subseto**: every element of l1 is a member of l2. Recurses on l1, checking each element via membero. Allows duplicates in l1 (each independently in l2). 7 new tests, 456/456 cumulative. - **2026-05-08** — **cycle-free path search**: mitigation for the cyclic-graph divergence — thread a accumulator through the recursion, gate each step with nafc + membero on visited. Terminates on graphs with cycles; no Phase-7 tabling required for the simple case. 3 new tests, 449/449 cumulative. - **2026-05-08** — **removeo-allo**: removes every occurrence of x (vs rembero, which removes only the first). Three conde clauses: empty -> empty; head matches -> skip and recurse; head differs (nafc) -> keep and recurse. 5 new tests, 446/446 cumulative. From 4f5f8015fbff864cc700fd1b106a43a4cacd7e48 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:12:32 +0000 Subject: [PATCH 51/84] =?UTF-8?q?mk:=20mino=20+=20maxo=20=E2=80=94=20find?= =?UTF-8?q?=20min/max=20of=20a=20list?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two conde clauses each: singleton -> the element; multi -> compare head against the recursive min/max of the tail and pick. Uses lteo-i / lto-i for the comparisons, so the input must be ground integers. mino + maxo can run together: (fresh (mn mx) (mino l mn) (maxo l mx) (== q (list mn mx))) recovers both. 9 new tests, 472/472 cumulative. --- lib/minikanren/intarith.sx | 16 +++++++++++ lib/minikanren/tests/minmax.sx | 49 ++++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 66 insertions(+) create mode 100644 lib/minikanren/tests/minmax.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 108caf86..f5351ece 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -77,3 +77,19 @@ ((nullo l)) ((fresh (a) (== l (list a)))) ((fresh (a b rest mid) (conso a mid l) (conso b rest mid) (lteo-i a b) (sortedo mid)))))) + +(define + mino + (fn + (l m) + (conde + ((fresh (a) (== l (list a)) (== m a))) + ((fresh (a d rest-min) (conso a d l) (mino d rest-min) (conde ((lteo-i a rest-min) (== m a)) ((lto-i rest-min a) (== m rest-min)))))))) + +(define + maxo + (fn + (l m) + (conde + ((fresh (a) (== l (list a)) (== m a))) + ((fresh (a d rest-max) (conso a d l) (maxo d rest-max) (conde ((lteo-i rest-max a) (== m a)) ((lto-i a rest-max) (== m rest-max)))))))) diff --git a/lib/minikanren/tests/minmax.sx b/lib/minikanren/tests/minmax.sx new file mode 100644 index 00000000..76ea3dd5 --- /dev/null +++ b/lib/minikanren/tests/minmax.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 3a05e6c6..6f0c9ca4 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **mino + maxo (intarith)**: find the minimum/maximum of a non-empty list of ground integers. Two conde clauses each: singleton (return the element) / multi (compare head against recursive min/max of tail). 9 new tests, 472/472 cumulative. - **2026-05-08** — **sortedo (intarith)**: list is non-decreasing under integer ordering. Three conde clauses: empty / singleton / pair-and-recurse. Uses lteo-i for the adjacent-pair check (ground integers). 7 new tests, 463/463 cumulative. - **2026-05-08** — **subseto**: every element of l1 is a member of l2. Recurses on l1, checking each element via membero. Allows duplicates in l1 (each independently in l2). 7 new tests, 456/456 cumulative. - **2026-05-08** — **cycle-free path search**: mitigation for the cyclic-graph divergence — thread a accumulator through the recursion, gate each step with nafc + membero on visited. Terminates on graphs with cycles; no Phase-7 tabling required for the simple case. 3 new tests, 449/449 cumulative. From 064ab2900bc24c2fcbacb87d94e40fe692e77900 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:14:15 +0000 Subject: [PATCH 52/84] =?UTF-8?q?mk:=20sumo=20+=20producto=20=E2=80=94=20f?= =?UTF-8?q?old=20list=20to=20integer?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Sum and product over a list of ground integers via fold + intarith. Empty list yields the identity (0 for sum, 1 for product). Recurse combines the head with the recursively-computed tail value via pluso-i / *o-i. 9 new tests, 481/481 cumulative. --- lib/minikanren/intarith.sx | 16 +++++++++++ lib/minikanren/tests/sum-product.sx | 44 +++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 61 insertions(+) create mode 100644 lib/minikanren/tests/sum-product.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index f5351ece..015bea2d 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -93,3 +93,19 @@ (conde ((fresh (a) (== l (list a)) (== m a))) ((fresh (a d rest-max) (conso a d l) (maxo d rest-max) (conde ((lteo-i rest-max a) (== m a)) ((lto-i a rest-max) (== m rest-max)))))))) + +(define + sumo + (fn + (l total) + (conde + ((nullo l) (== total 0)) + ((fresh (a d rest-sum) (conso a d l) (sumo d rest-sum) (pluso-i a rest-sum total)))))) + +(define + producto + (fn + (l total) + (conde + ((nullo l) (== total 1)) + ((fresh (a d rest-prod) (conso a d l) (producto d rest-prod) (*o-i a rest-prod total)))))) diff --git a/lib/minikanren/tests/sum-product.sx b/lib/minikanren/tests/sum-product.sx new file mode 100644 index 00000000..6eddd96c --- /dev/null +++ b/lib/minikanren/tests/sum-product.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 6f0c9ca4..5ba00636 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **sumo + producto (intarith)**: fold a list of ground integers to its sum or product. Empty list -> identity (0 / 1). Recurse via pluso-i / *o-i. 9 new tests, 481/481 cumulative. - **2026-05-08** — **mino + maxo (intarith)**: find the minimum/maximum of a non-empty list of ground integers. Two conde clauses each: singleton (return the element) / multi (compare head against recursive min/max of tail). 9 new tests, 472/472 cumulative. - **2026-05-08** — **sortedo (intarith)**: list is non-decreasing under integer ordering. Three conde clauses: empty / singleton / pair-and-recurse. Uses lteo-i for the adjacent-pair check (ground integers). 7 new tests, 463/463 cumulative. - **2026-05-08** — **subseto**: every element of l1 is a member of l2. Recurses on l1, checking each element via membero. Allows duplicates in l1 (each independently in l2). 7 new tests, 456/456 cumulative. From 7ff72cefb24f3c88d12049776e5606496ad01dc0 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:15:53 +0000 Subject: [PATCH 53/84] =?UTF-8?q?mk:=20lengtho-i=20=E2=80=94=20integer-ind?= =?UTF-8?q?exed=20length?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Drop-in fast replacement for Peano lengtho when the count fits in a host integer. Two conde clauses: empty list -> 0; recurse, n = 1 + length(tail). Uses pluso-i so the length walks to a native int. 5 new tests, 486/486 cumulative. --- lib/minikanren/intarith.sx | 8 ++++++++ lib/minikanren/tests/lengtho-i.sx | 28 ++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 37 insertions(+) create mode 100644 lib/minikanren/tests/lengtho-i.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 015bea2d..e9548b4b 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -109,3 +109,11 @@ (conde ((nullo l) (== total 1)) ((fresh (a d rest-prod) (conso a d l) (producto d rest-prod) (*o-i a rest-prod total)))))) + +(define + lengtho-i + (fn + (l n) + (conde + ((nullo l) (== n 0)) + ((fresh (a d n-1) (conso a d l) (lengtho-i d n-1) (pluso-i 1 n-1 n)))))) diff --git a/lib/minikanren/tests/lengtho-i.sx b/lib/minikanren/tests/lengtho-i.sx new file mode 100644 index 00000000..6759e24e --- /dev/null +++ b/lib/minikanren/tests/lengtho-i.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 5ba00636..c55abc7d 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **lengtho-i**: integer-indexed length (intarith). Empty list -> 0; recurse with pluso-i. Drop-in fast replacement for Peano lengtho when the count fits in a host integer. 5 new tests, 486/486 cumulative. - **2026-05-08** — **sumo + producto (intarith)**: fold a list of ground integers to its sum or product. Empty list -> identity (0 / 1). Recurse via pluso-i / *o-i. 9 new tests, 481/481 cumulative. - **2026-05-08** — **mino + maxo (intarith)**: find the minimum/maximum of a non-empty list of ground integers. Two conde clauses each: singleton (return the element) / multi (compare head against recursive min/max of tail). 9 new tests, 472/472 cumulative. - **2026-05-08** — **sortedo (intarith)**: list is non-decreasing under integer ordering. Three conde clauses: empty / singleton / pair-and-recurse. Uses lteo-i for the adjacent-pair check (ground integers). 7 new tests, 463/463 cumulative. From 363ebc8f045054b5b5607a5058d63c1aeab5e0c7 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:16:40 +0000 Subject: [PATCH 54/84] =?UTF-8?q?mk:=20appendo3=20=E2=80=94=203-list=20app?= =?UTF-8?q?end?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Composes two appendos: (appendo a b mid) ∧ (appendo mid c r). Runs forward (concatenate three known lists) and backward (recover any of the three from the other two and the result). 5 new tests, 491/491 cumulative. --- lib/minikanren/relations.sx | 8 +++++- lib/minikanren/tests/appendo3.sx | 49 ++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/appendo3.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 8f18d87b..c3e5c53f 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -42,6 +42,12 @@ ;; --- membero --- ;; (membero x l) — x appears (at least once) in l. +(define + appendo3 + (fn + (l1 l2 l3 result) + (fresh (l12) (appendo l1 l2 l12) (appendo l12 l3 result)))) + (define membero (fn @@ -82,8 +88,8 @@ ((nullo l) (== result acc)) ((fresh (a d acc-prime) (conso a d l) (conso a acc acc-prime) (rev-acco d acc-prime result)))))) -(define rev-2o (fn (l result) (rev-acco l (list) result))) +(define rev-2o (fn (l result) (rev-acco l (list) result))) (define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) diff --git a/lib/minikanren/tests/appendo3.sx b/lib/minikanren/tests/appendo3.sx new file mode 100644 index 00000000..36f58269 --- /dev/null +++ b/lib/minikanren/tests/appendo3.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index c55abc7d..a3a3e49f 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **appendo3**: 3-list append via two appendos. (appendo3 a b c r) is (appendo a b mid) ∧ (appendo mid c r). Recovers any of the three lists given the other two and the result. 5 new tests, 491/491 cumulative. - **2026-05-08** — **lengtho-i**: integer-indexed length (intarith). Empty list -> 0; recurse with pluso-i. Drop-in fast replacement for Peano lengtho when the count fits in a host integer. 5 new tests, 486/486 cumulative. - **2026-05-08** — **sumo + producto (intarith)**: fold a list of ground integers to its sum or product. Empty list -> identity (0 / 1). Recurse via pluso-i / *o-i. 9 new tests, 481/481 cumulative. - **2026-05-08** — **mino + maxo (intarith)**: find the minimum/maximum of a non-empty list of ground integers. Two conde clauses each: singleton (return the element) / multi (compare head against recursive min/max of tail). 9 new tests, 472/472 cumulative. From 221c7fef358c2b2123dbe9f0ed52a4eec8110156 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:18:25 +0000 Subject: [PATCH 55/84] =?UTF-8?q?mk:=20partitiono=20=E2=80=94=20split=20li?= =?UTF-8?q?st=20by=20predicate?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (partitiono pred l yes no) — yes is the elements of l where pred succeeds; no is the rest. Conde dispatches on each element via the predicate goal vs nafc-of-the-predicate, threading the head through the matching output list. Composes with intarith / membero / etc. for any predicate-shaped goal: (partitiono (fn (x) (lto-i x 5)) (list 1 7 2 8 3) yes no) yes -> (1 2 3); no -> (7 8) 5 new tests, 496/496 cumulative. --- lib/minikanren/relations.sx | 10 +++- lib/minikanren/tests/partitiono.sx | 75 ++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 85 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/partitiono.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index c3e5c53f..23a1356f 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -48,6 +48,14 @@ (l1 l2 l3 result) (fresh (l12) (appendo l1 l2 l12) (appendo l12 l3 result)))) +(define + partitiono + (fn + (pred l yes no) + (conde + ((nullo l) (nullo yes) (nullo no)) + ((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest)))))))) + (define membero (fn @@ -80,6 +88,7 @@ ((nullo l) (nullo r)) ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r)))))) + (define rev-acco (fn @@ -88,7 +97,6 @@ ((nullo l) (== result acc)) ((fresh (a d acc-prime) (conso a d l) (conso a acc acc-prime) (rev-acco d acc-prime result)))))) - (define rev-2o (fn (l result) (rev-acco l (list) result))) (define palindromeo (fn (l) (fresh (rev) (reverseo l rev) (== l rev)))) diff --git a/lib/minikanren/tests/partitiono.sx b/lib/minikanren/tests/partitiono.sx new file mode 100644 index 00000000..282d1bda --- /dev/null +++ b/lib/minikanren/tests/partitiono.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index a3a3e49f..b4a77a5c 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **partitiono**: relational partition. (partitiono pred l yes no) splits l so yes contains elements where pred succeeds and no contains the rest. Composes with intarith for numeric predicates. 5 new tests, 496/496 cumulative. - **2026-05-08** — **appendo3**: 3-list append via two appendos. (appendo3 a b c r) is (appendo a b mid) ∧ (appendo mid c r). Recovers any of the three lists given the other two and the result. 5 new tests, 491/491 cumulative. - **2026-05-08** — **lengtho-i**: integer-indexed length (intarith). Empty list -> 0; recurse with pluso-i. Drop-in fast replacement for Peano lengtho when the count fits in a host integer. 5 new tests, 486/486 cumulative. - **2026-05-08** — **sumo + producto (intarith)**: fold a list of ground integers to its sum or product. Empty list -> identity (0 / 1). Recurse via pluso-i / *o-i. 9 new tests, 481/481 cumulative. From 08f4a7babdfec9ada4a8254b672d0408e29241eb Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:20:03 +0000 Subject: [PATCH 56/84] =?UTF-8?q?mk:=20enumerate-i=20/=20enumerate-from-i?= =?UTF-8?q?=20=E2=80=94=20501/501=20milestone?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (enumerate-i l result): result is l with each element paired with its 0-based index. (enumerate-from-i n l result): same but starts at n. (enumerate-i (list :a :b :c) q) -> (((0 :a) (1 :b) (2 :c))) 5 new tests, 501/501 cumulative. --- lib/minikanren/intarith.sx | 10 ++++++++++ lib/minikanren/tests/enumerate.sx | 31 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 42 insertions(+) create mode 100644 lib/minikanren/tests/enumerate.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index e9548b4b..85b2cb69 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -117,3 +117,13 @@ (conde ((nullo l) (== n 0)) ((fresh (a d n-1) (conso a d l) (lengtho-i d n-1) (pluso-i 1 n-1 n)))))) + +(define + enumerate-from-i + (fn + (start l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d r-rest start-prime) (conso a d l) (conso (list start a) r-rest result) (pluso-i 1 start start-prime) (enumerate-from-i start-prime d r-rest)))))) + +(define enumerate-i (fn (l result) (enumerate-from-i 0 l result))) diff --git a/lib/minikanren/tests/enumerate.sx b/lib/minikanren/tests/enumerate.sx new file mode 100644 index 00000000..bc1dd74a --- /dev/null +++ b/lib/minikanren/tests/enumerate.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index b4a77a5c..1c382418 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **enumerate-i / enumerate-from-i — 500-test milestone**: index-each-element relations. (enumerate-i l result) -> result is l with each element paired with its 0-based index. (enumerate-from-i n l result) starts at n. 5 new tests, **501/501** cumulative. - **2026-05-08** — **partitiono**: relational partition. (partitiono pred l yes no) splits l so yes contains elements where pred succeeds and no contains the rest. Composes with intarith for numeric predicates. 5 new tests, 496/496 cumulative. - **2026-05-08** — **appendo3**: 3-list append via two appendos. (appendo3 a b c r) is (appendo a b mid) ∧ (appendo mid c r). Recovers any of the three lists given the other two and the result. 5 new tests, 491/491 cumulative. - **2026-05-08** — **lengtho-i**: integer-indexed length (intarith). Empty list -> 0; recurse with pluso-i. Drop-in fast replacement for Peano lengtho when the count fits in a host integer. 5 new tests, 486/486 cumulative. From 3842496f3bdf409007663af68275be7f5c88d072 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:21:42 +0000 Subject: [PATCH 57/84] =?UTF-8?q?mk:=20foldr-o=20=E2=80=94=20relational=20?= =?UTF-8?q?right=20fold?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Takes a 3-arg combiner relation, a list, and an initial accumulator, produces the right-fold result. (rel a tail-result result) combines the head with the recursive result. Examples: (foldr-o appendo (list (list 1 2) (list 3) (list 4 5)) (list) q) -> ((1 2 3 4 5)) ; flatten (foldr-o conso (list 1 2 3) (list) q) -> ((1 2 3)) ; rebuild list 4 new tests, 505/505 cumulative. --- lib/minikanren/relations.sx | 10 ++++++++- lib/minikanren/tests/foldr-o.sx | 38 +++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/foldr-o.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 23a1356f..ac340736 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -56,6 +56,14 @@ ((nullo l) (nullo yes) (nullo no)) ((fresh (a d y-rest n-rest) (conso a d l) (conde ((pred a) (conso a y-rest yes) (== no n-rest) (partitiono pred d y-rest n-rest)) ((nafc (pred a)) (== yes y-rest) (conso a n-rest no) (partitiono pred d y-rest n-rest)))))))) +(define + foldr-o + (fn + (rel l acc result) + (conde + ((nullo l) (== result acc)) + ((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result)))))) + (define membero (fn @@ -80,6 +88,7 @@ ((nullo l1)) ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2)))))) + (define reverseo (fn @@ -88,7 +97,6 @@ ((nullo l) (nullo r)) ((fresh (a d res-rev) (conso a d l) (reverseo d res-rev) (appendo res-rev (list a) r)))))) - (define rev-acco (fn diff --git a/lib/minikanren/tests/foldr-o.sx b/lib/minikanren/tests/foldr-o.sx new file mode 100644 index 00000000..7a24ca5e --- /dev/null +++ b/lib/minikanren/tests/foldr-o.sx @@ -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!) From c51d52dae2486017b7b48d0c8cef3fbdc7f3edea Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:21:54 +0000 Subject: [PATCH 58/84] GUEST-plan: log foldr-o (post-commit oversight) --- plans/minikanren-on-sx.md | 1 + 1 file changed, 1 insertion(+) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 1c382418..d0903e32 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **foldr-o (relational right fold)**: takes a 3-arg combiner relation rel, a list, an initial accumulator, produces the result. (foldr-o appendo lists () q) is a flatten; (foldr-o conso l () q) rebuilds l. 4 new tests, 505/505 cumulative. - **2026-05-08** — **enumerate-i / enumerate-from-i — 500-test milestone**: index-each-element relations. (enumerate-i l result) -> result is l with each element paired with its 0-based index. (enumerate-from-i n l result) starts at n. 5 new tests, **501/501** cumulative. - **2026-05-08** — **partitiono**: relational partition. (partitiono pred l yes no) splits l so yes contains elements where pred succeeds and no contains the rest. Composes with intarith for numeric predicates. 5 new tests, 496/496 cumulative. - **2026-05-08** — **appendo3**: 3-list append via two appendos. (appendo3 a b c r) is (appendo a b mid) ∧ (appendo mid c r). Recovers any of the three lists given the other two and the result. 5 new tests, 491/491 cumulative. From f5ab66e1a3dcbf4b518647c8f6eacef0adc59017 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:23:40 +0000 Subject: [PATCH 59/84] =?UTF-8?q?mk:=20foldl-o=20=E2=80=94=20relational=20?= =?UTF-8?q?left=20fold?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Complement to foldr-o. The combiner relation has signature (acc head new-acc) — accumulator first. Examples: (foldl-o pluso-i (list 1 2 3 4 5) 0 q) -> (15) (foldl-o *o-i (list 1 2 3 4) 1 q) -> (24) (foldl-o (fn (acc x r) (conso x acc r)) ; flipped conso (list 1 2 3 4) (list) q) -> ((4 3 2 1)) ; reverse 5 new tests, 510/510 cumulative. --- lib/minikanren/relations.sx | 10 ++++++- lib/minikanren/tests/foldl-o.sx | 48 +++++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 1 + 3 files changed, 58 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/foldl-o.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index ac340736..c9b8b24e 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -64,6 +64,14 @@ ((nullo l) (== result acc)) ((fresh (a d r-rest) (conso a d l) (foldr-o rel d acc r-rest) (rel a r-rest result)))))) +(define + foldl-o + (fn + (rel l acc result) + (conde + ((nullo l) (== result acc)) + ((fresh (a d new-acc) (conso a d l) (rel acc a new-acc) (foldl-o rel d new-acc result)))))) + (define membero (fn @@ -80,6 +88,7 @@ ((nullo l)) ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d)))))) + (define subseto (fn @@ -88,7 +97,6 @@ ((nullo l1)) ((fresh (a d) (conso a d l1) (membero a l2) (subseto d l2)))))) - (define reverseo (fn diff --git a/lib/minikanren/tests/foldl-o.sx b/lib/minikanren/tests/foldl-o.sx new file mode 100644 index 00000000..2e196e43 --- /dev/null +++ b/lib/minikanren/tests/foldl-o.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index d0903e32..30519136 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,7 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **foldl-o (relational left fold)**: complement to foldr-o. Combiner has args (acc, head) -> new-acc. (foldl-o pluso-i (1 2 3 4 5) 0 q) -> 15; (foldl-o flipped-conso l () q) reverses l. 5 new tests, 510/510 cumulative. - **2026-05-08** — **foldr-o (relational right fold)**: takes a 3-arg combiner relation rel, a list, an initial accumulator, produces the result. (foldr-o appendo lists () q) is a flatten; (foldr-o conso l () q) rebuilds l. 4 new tests, 505/505 cumulative. - **2026-05-08** — **enumerate-i / enumerate-from-i — 500-test milestone**: index-each-element relations. (enumerate-i l result) -> result is l with each element paired with its 0-based index. (enumerate-from-i n l result) starts at n. 5 new tests, **501/501** cumulative. - **2026-05-08** — **partitiono**: relational partition. (partitiono pred l yes no) splits l so yes contains elements where pred succeeds and no contains the rest. Composes with intarith for numeric predicates. 5 new tests, 496/496 cumulative. From 091030f13ee08e7a0ae5bd9bcc411b96ba16068f Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:24:23 +0000 Subject: [PATCH 60/84] =?UTF-8?q?mk:=20flat-mapo=20=E2=80=94=20concatMap-s?= =?UTF-8?q?tyle=20relation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (flat-mapo rel l result): each element x of l is mapped to a list via rel x list-from-x, and all such lists are concatenated to form result. (flat-mapo (fn (x r) (== r (list x x))) (list 1 2 3) q) -> ((1 1 2 2 3 3)) 5 new tests, 515/515 cumulative. --- lib/minikanren/relations.sx | 10 +++++++- lib/minikanren/tests/flat-mapo.sx | 39 +++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/flat-mapo.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index c9b8b24e..a2c8f231 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -72,6 +72,14 @@ ((nullo l) (== result acc)) ((fresh (a d new-acc) (conso a d l) (rel acc a new-acc) (foldl-o rel d new-acc result)))))) +(define + flat-mapo + (fn + (rel l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result)))))) + (define membero (fn @@ -80,6 +88,7 @@ ((fresh (d) (conso x d l))) ((fresh (a d) (conso a d l) (membero x d)))))) + (define not-membero (fn @@ -88,7 +97,6 @@ ((nullo l)) ((fresh (a d) (conso a d l) (nafc (== a x)) (not-membero x d)))))) - (define subseto (fn diff --git a/lib/minikanren/tests/flat-mapo.sx b/lib/minikanren/tests/flat-mapo.sx new file mode 100644 index 00000000..fd98f3f3 --- /dev/null +++ b/lib/minikanren/tests/flat-mapo.sx @@ -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!) From d891831f0813ff0bfd57b2f8bc43b14e6afb0c68 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:25:36 +0000 Subject: [PATCH 61/84] =?UTF-8?q?mk:=20simplify-step-o=20=E2=80=94=20algeb?= =?UTF-8?q?raic-identity=20simplifier=20(conda=20demo)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Demonstrates conda for first-match-wins dispatch over a set of rewrite rules: 0+x = x, x+0 = x, 0*y = 0, x*0 = 0, 1*x = x, x*1 = x, default unchanged. Six rules + a fall-through default, all wrapped in a single conda. The first clause whose head succeeds commits to that rewrite. The fall- through default ensures the relation always succeeds with at least the unchanged input. 6 new tests, 521/521 cumulative. --- lib/minikanren/tests/simplifyo.sx | 47 +++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 lib/minikanren/tests/simplifyo.sx diff --git a/lib/minikanren/tests/simplifyo.sx b/lib/minikanren/tests/simplifyo.sx new file mode 100644 index 00000000..02a56e0b --- /dev/null +++ b/lib/minikanren/tests/simplifyo.sx @@ -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!) From f4a902a6df5a37ef8a41e8beba7ab01952ce8aea Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:27:03 +0000 Subject: [PATCH 62/84] =?UTF-8?q?mk:=20nub-o=20=E2=80=94=20dedupe=20by=20k?= =?UTF-8?q?eeping=20the=20last=20occurrence?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Walks the list; if the head appears in the tail (membero), drop it and recurse; otherwise keep it and recurse. Result preserves only the *last* occurrence of each value. Caveat: with input like (1 1 1) the membero check succeeds with multiplicity, so multiple (1) answers may emerge — each is shape- identical, but the test deliberately checks every-result-is-(1) rather than asserting answer count. 5 new tests, 526/526 cumulative. --- lib/minikanren/relations.sx | 10 +++++++++- lib/minikanren/tests/nub-o.sx | 31 +++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 1 deletion(-) create mode 100644 lib/minikanren/tests/nub-o.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index a2c8f231..eff42820 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -80,6 +80,15 @@ ((nullo l) (nullo result)) ((fresh (a d a-result rest-result) (conso a d l) (rel a a-result) (flat-mapo rel d rest-result) (appendo a-result rest-result result)))))) +(define + nub-o + (fn + (l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest)))))))) + + (define membero (fn @@ -88,7 +97,6 @@ ((fresh (d) (conso x d l))) ((fresh (a d) (conso a d l) (membero x d)))))) - (define not-membero (fn diff --git a/lib/minikanren/tests/nub-o.sx b/lib/minikanren/tests/nub-o.sx new file mode 100644 index 00000000..cffa5159 --- /dev/null +++ b/lib/minikanren/tests/nub-o.sx @@ -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!) From de6fd1b1837a1a4bdfda33cf28e4c0df0976a39f Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:28:31 +0000 Subject: [PATCH 63/84] =?UTF-8?q?mk:=20counto=20=E2=80=94=20count=20occurr?= =?UTF-8?q?ences=20of=20x=20in=20l=20(intarith)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Walks the list with a recursive count. On a head match, recurse and add 1 via pluso-i; on no match (nafc), recurse forwarding the count. Empty list yields 0. 6 new tests, 532/532 cumulative. --- lib/minikanren/intarith.sx | 8 ++++++++ lib/minikanren/tests/counto.sx | 35 ++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) create mode 100644 lib/minikanren/tests/counto.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 85b2cb69..51b2ee1e 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -127,3 +127,11 @@ ((fresh (a d r-rest start-prime) (conso a d l) (conso (list start a) r-rest result) (pluso-i 1 start start-prime) (enumerate-from-i start-prime d r-rest)))))) (define enumerate-i (fn (l result) (enumerate-from-i 0 l result))) + +(define + counto + (fn + (x l n) + (conde + ((nullo l) (== n 0)) + ((fresh (a d n-rest) (conso a d l) (conde ((== a x) (counto x d n-rest) (pluso-i 1 n-rest n)) ((nafc (== a x)) (counto x d n)))))))) diff --git a/lib/minikanren/tests/counto.sx b/lib/minikanren/tests/counto.sx new file mode 100644 index 00000000..0c9248fc --- /dev/null +++ b/lib/minikanren/tests/counto.sx @@ -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!) From d1e00e2e9e7570c353826caffd73e2541b25be40 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:29:34 +0000 Subject: [PATCH 64/84] =?UTF-8?q?mk:=20arith-progo=20=E2=80=94=20arithmeti?= =?UTF-8?q?c=20progression=20generation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (arith-progo start step len result): result is the list (start, start+step, ..., start+(len-1)*step). Length 0 yields the empty list. Negative steps and zero step are supported. Useful for FD-style domain construction: (arith-progo 1 1 9 dom) -> (1 2 3 4 5 6 7 8 9) 6 new tests, 538/538 cumulative. --- lib/minikanren/intarith.sx | 14 +++++++++++++ lib/minikanren/tests/arith-prog.sx | 33 ++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+) create mode 100644 lib/minikanren/tests/arith-prog.sx diff --git a/lib/minikanren/intarith.sx b/lib/minikanren/intarith.sx index 51b2ee1e..6aaf57bb 100644 --- a/lib/minikanren/intarith.sx +++ b/lib/minikanren/intarith.sx @@ -135,3 +135,17 @@ (conde ((nullo l) (== n 0)) ((fresh (a d n-rest) (conso a d l) (conde ((== a x) (counto x d n-rest) (pluso-i 1 n-rest n)) ((nafc (== a x)) (counto x d n)))))))) + +(define + mk-arith-prog + (fn + (start step len) + (cond + ((= len 0) (list)) + (:else (cons start (mk-arith-prog (+ start step) step (- len 1))))))) + +(define + arith-progo + (fn + (start step len result) + (project (start step len) (== result (mk-arith-prog start step len))))) diff --git a/lib/minikanren/tests/arith-prog.sx b/lib/minikanren/tests/arith-prog.sx new file mode 100644 index 00000000..2b1b7843 --- /dev/null +++ b/lib/minikanren/tests/arith-prog.sx @@ -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!) From 2a36e692f4e75acb985d73051729a8cda439123e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:30:53 +0000 Subject: [PATCH 65/84] =?UTF-8?q?mk:=20take-while-o=20+=20drop-while-o=20?= =?UTF-8?q?=E2=80=94=20predicate-driven=20prefix/suffix?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (take-while-o pred l result): take elements from l while pred holds, stopping at the first element that fails. (drop-while-o pred l result): drop matching elements, return the rest including the first non-match. Together: (take-while p l) ⊕ (drop-while p l) = l, verified by an end-to-end roundtrip test. 8 new tests, 546/546 cumulative. --- lib/minikanren/relations.sx | 16 ++++ lib/minikanren/tests/take-while-drop-while.sx | 80 +++++++++++++++++++ 2 files changed, 96 insertions(+) create mode 100644 lib/minikanren/tests/take-while-drop-while.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index eff42820..758d1df1 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -89,6 +89,22 @@ ((fresh (a d r-rest) (conso a d l) (conde ((membero a d) (nub-o d result)) ((nafc (membero a d)) (conso a r-rest result) (nub-o d r-rest)))))))) +(define + take-while-o + (fn + (pred l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d r-rest) (conso a d l) (conde ((pred a) (conso a r-rest result) (take-while-o pred d r-rest)) ((nafc (pred a)) (== result (list))))))))) + +(define + drop-while-o + (fn + (pred l result) + (conde + ((nullo l) (nullo result)) + ((fresh (a d) (conso a d l) (conde ((pred a) (drop-while-o pred d result)) ((nafc (pred a)) (== result l)))))))) + (define membero (fn diff --git a/lib/minikanren/tests/take-while-drop-while.sx b/lib/minikanren/tests/take-while-drop-while.sx new file mode 100644 index 00000000..99cd69cd --- /dev/null +++ b/lib/minikanren/tests/take-while-drop-while.sx @@ -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!) From f8b9bde1a559d62852f48105c7715ba1c7aeeae9 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:31:53 +0000 Subject: [PATCH 66/84] =?UTF-8?q?mk:=20zip-with-o=20=E2=80=94=20element-wi?= =?UTF-8?q?se=20combine=20of=20two=20lists?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Like Haskell's zipWith but relational. (zip-with-o rel l1 l2 result) applies a 3-arg combiner relation pointwise: rel l1[i] l2[i] result[i]. (zip-with-o pluso-i (list 1 2 3) (list 10 20 30) q) -> ((11 22 33)) (zip-with-o (fn (a b r) (== r (list a b))) (list :x :y) (list 1 2) q) -> (((:x 1) (:y 2))) Different-length lists fail. 5 new tests, 551/551 cumulative. --- lib/minikanren/relations.sx | 8 +++++ lib/minikanren/tests/zip-with-o.sx | 52 ++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 lib/minikanren/tests/zip-with-o.sx diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 758d1df1..35d87cb5 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -277,6 +277,14 @@ ((nullo l1) (nullo l2) (nullo pairs)) ((fresh (a1 d1 a2 d2 d-pairs) (conso a1 d1 l1) (conso a2 d2 l2) (conso (list a1 a2) d-pairs pairs) (pairlisto d1 d2 d-pairs)))))) +(define + zip-with-o + (fn + (rel l1 l2 result) + (conde + ((nullo l1) (nullo l2) (nullo result)) + ((fresh (a1 d1 a2 d2 a-result d-result) (conso a1 d1 l1) (conso a2 d2 l2) (rel a1 a2 a-result) (conso a-result d-result result) (zip-with-o rel d1 d2 d-result)))))) + (define swap-firsto (fn diff --git a/lib/minikanren/tests/zip-with-o.sx b/lib/minikanren/tests/zip-with-o.sx new file mode 100644 index 00000000..c3cea9ab --- /dev/null +++ b/lib/minikanren/tests/zip-with-o.sx @@ -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!) From 25f709549ef7eae7cb98a8ccfb56a4690629bcfb Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 12:32:57 +0000 Subject: [PATCH 67/84] =?UTF-8?q?GUEST-plan:=20session=20snapshot=20?= =?UTF-8?q?=E2=80=94=20551=20tests,=20phases=201-5=20complete?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Capture the current state: 17 library files (1229 LOC), 61 test files (4360 LOC), 551/551 tests passing. Phases 1-5 fully done; Phase 6 covered by minimal FD (ino, all-distincto) plus an intarith escape hatch; Phase 7 documented via the cyclic-graph divergence test as motivation for future tabling work. The lib-guest validation experiment is conclusive: lib/minikanren/ unify.sx adds ~50 lines of local logic over lib/guest/match.sx's ~100-line kit. The kit earns its keep at roughly 3x by line count. Classic miniKanren tests green: appendo forwards/backwards, Peano arithmetic enumeration (pluso, *o, lto), 4-queens (both solutions), Pythagorean triples, family-relation inference, symbolic differentiation, pet/colour permutation puzzle, Latin square 2x2, binary tree walker. --- plans/minikanren-on-sx.md | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 30519136..8e2055f1 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,29 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **Session snapshot**: 17 lib files, 61 test files, 1229 + library LOC + 4360 test LOC, **551/551 tests cumulative**. Library covers + Phases 1–5 fully, Phase 6 partial (FD helpers + intarith escape), Phase 7 + documented via cyclic-graph divergence test. lib-guest validation + completed: `lib/minikanren/unify.sx` ≈ 50 LOC of local logic over + `lib/guest/match.sx`'s ≈100 LOC kit (kit earns ~3× by line count). Major + classic miniKanren tests green: appendo forwards/backwards, Peano + arithmetic, 4-queens, Pythagorean triples, family-relations / pet + puzzle / symbolic differentiation, 2x2 Latin square. Ready for Phase 6 + (native FD with arc-consistency) and Phase 7 (tabling) as future work. +- **2026-05-08** — **zip-with-o**: element-wise relational combine over two + lists with a 3-arg combiner. Ground-only by composition. 5 new tests. +- **2026-05-08** — **take-while-o + drop-while-o**: predicate-driven + prefix/suffix split. Roundtrip property verified. 8 new tests. +- **2026-05-08** — **arith-progo**: arithmetic-progression list generator + via project. 6 new tests. +- **2026-05-08** — **counto**: count occurrences of x in l (intarith). + 6 new tests. +- **2026-05-08** — **nub-o**: dedupe via membero-on-tail. Multiplicity + caveat documented in tests. 5 new tests. +- **2026-05-08** — **simplify-step-o**: algebraic identity simplifier + (conda demo). 6 new tests. +- **2026-05-08** — **flat-mapo**: concatMap-style relation. 5 new tests. - **2026-05-08** — **foldl-o (relational left fold)**: complement to foldr-o. Combiner has args (acc, head) -> new-acc. (foldl-o pluso-i (1 2 3 4 5) 0 q) -> 15; (foldl-o flipped-conso l () q) reverses l. 5 new tests, 510/510 cumulative. - **2026-05-08** — **foldr-o (relational right fold)**: takes a 3-arg combiner relation rel, a list, an initial accumulator, produces the result. (foldr-o appendo lists () q) is a flatten; (foldr-o conso l () q) rebuilds l. 4 new tests, 505/505 cumulative. - **2026-05-08** — **enumerate-i / enumerate-from-i — 500-test milestone**: index-each-element relations. (enumerate-i l result) -> result is l with each element paired with its 0-based index. (enumerate-from-i n l result) starts at n. 5 new tests, **501/501** cumulative. From c71da0e1cf0f58cdaf4d79d6cc4df4fba7289911 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:06:19 +0000 Subject: [PATCH 68/84] =?UTF-8?q?mk:=20phase=206B=20=E2=80=94=20clpfd.sx?= =?UTF-8?q?=20domain=20primitives?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Foundation for native CLP(FD). The substitution dict carries a reserved "_fd" key holding a constraint store: {:domains {var-name -> sorted-int-list} :constraints (... pending constraints ...)} This commit ships only the domain machinery + accessors: fd-dom-from-list / fd-dom-range / fd-dom-empty? / fd-dom-singleton? fd-dom-min / fd-dom-max / fd-dom-member? / fd-dom-intersect / fd-dom-without fd-store-of / fd-domain-of / fd-set-domain / fd-with-store fd-set-domain returns nil when the domain becomes empty (failure), which is the wire signal subsequent constraint goals will consume. The constraints field is reserved for the next iteration. 26 new tests, 577/577 cumulative. --- lib/minikanren/clpfd.sx | 125 ++++++++++++++++++++++++ lib/minikanren/tests/clpfd-domains.sx | 133 ++++++++++++++++++++++++++ 2 files changed, 258 insertions(+) create mode 100644 lib/minikanren/clpfd.sx create mode 100644 lib/minikanren/tests/clpfd-domains.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx new file mode 100644 index 00000000..0b9134ee --- /dev/null +++ b/lib/minikanren/clpfd.sx @@ -0,0 +1,125 @@ +;; lib/minikanren/clpfd.sx — Phase 6 piece B: CLP(FD) foundation. +;; +;; A finite-domain layer on top of the existing miniKanren machinery. The +;; substitution dict carries an extra reserved key "_fd" that holds a +;; constraint-store record: +;; +;; {:domains {var-name -> sorted-int-list} +;; :constraints (... pending constraints ...)} +;; +;; Domains are sorted SX lists of ints (no duplicates). The constraints +;; field is reserved for later iterations; this commit ships only the +;; domain machinery + accessors. +;; +;; Naming: fd-* (domain primitives, kernel-style). + +(define fd-key "_fd") + +(define + fd-dom-rev + (fn + (xs acc) + (cond + ((empty? xs) acc) + (:else (fd-dom-rev (rest xs) (cons (first xs) acc)))))) + +(define + fd-dom-insert + (fn + (x desc) + (cond + ((empty? desc) (list x)) + ((= x (first desc)) desc) + ((> x (first desc)) (cons x desc)) + (:else (cons (first desc) (fd-dom-insert x (rest desc))))))) + +(define + fd-dom-sort-dedupe + (fn + (xs acc) + (cond + ((empty? xs) (fd-dom-rev acc (list))) + (:else (fd-dom-sort-dedupe (rest xs) (fd-dom-insert (first xs) acc)))))) + +(define fd-dom-from-list (fn (xs) (fd-dom-sort-dedupe xs (list)))) + +(define fd-dom-empty? (fn (d) (empty? d))) +(define + fd-dom-singleton? + (fn (d) (and (not (empty? d)) (empty? (rest d))))) +(define fd-dom-min (fn (d) (first d))) + +(define + fd-dom-last + (fn + (d) + (cond ((empty? (rest d)) (first d)) (:else (fd-dom-last (rest d)))))) + +(define fd-dom-max (fn (d) (fd-dom-last d))) + +(define fd-dom-member? (fn (x d) (some (fn (y) (= x y)) d))) + +(define + fd-dom-intersect + (fn + (a b) + (cond + ((empty? a) (list)) + ((empty? b) (list)) + ((= (first a) (first b)) + (cons (first a) (fd-dom-intersect (rest a) (rest b)))) + ((< (first a) (first b)) (fd-dom-intersect (rest a) b)) + (:else (fd-dom-intersect a (rest b)))))) + +(define + fd-dom-without + (fn + (x d) + (cond + ((empty? d) (list)) + ((= (first d) x) (rest d)) + ((> (first d) x) d) + (:else (cons (first d) (fd-dom-without x (rest d))))))) + +(define + fd-dom-range + (fn + (lo hi) + (cond + ((> lo hi) (list)) + (:else (cons lo (fd-dom-range (+ lo 1) hi)))))) + +(define fd-store-empty (fn () {:domains {} :constraints (list)})) + +(define + fd-store-of + (fn + (s) + (cond ((has-key? s fd-key) (get s fd-key)) (:else (fd-store-empty))))) + +(define fd-domains-of (fn (s) (get (fd-store-of s) :domains))) + +(define fd-with-store (fn (s store) (assoc s fd-key store))) + +(define + fd-domain-of + (fn + (s var-name) + (let + ((doms (fd-domains-of s))) + (cond ((has-key? doms var-name) (get doms var-name)) (:else nil))))) + +(define + fd-set-domain + (fn + (s var-name d) + (cond + ((fd-dom-empty? d) nil) + (:else + (let + ((store (fd-store-of s))) + (let + ((doms-prime (assoc (get store :domains) var-name d))) + (let + ((store-prime (assoc store :domains doms-prime))) + (fd-with-store s store-prime)))))))) diff --git a/lib/minikanren/tests/clpfd-domains.sx b/lib/minikanren/tests/clpfd-domains.sx new file mode 100644 index 00000000..a43a7270 --- /dev/null +++ b/lib/minikanren/tests/clpfd-domains.sx @@ -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!) From f2817bb6beb1a5a226257b52b86a2ea87c142a64 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:09:18 +0000 Subject: [PATCH 69/84] =?UTF-8?q?mk:=20phase=206C=20=E2=80=94=20fd-in=20+?= =?UTF-8?q?=20fd-label=20(domain=20narrowing=20+=20labelling)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit fd-in x dom-list: narrows x's domain. If x is a ground number, checks membership; if x is a logic var, intersects existing domain (or sets fresh) and stores via fd-set-domain. Fails if domain becomes empty. fd-label vars: drives search by enumerating each var's domain. Each var is unified with each value in its domain, in order, via mk-mplus of singleton streams. Forward: (fd-in x dom) (fd-label (list x)) iterates x over dom. Intersection: two fd-in goals on the same var compose via dom-intersect. Disjoint domains -> empty answer set. Ground value membership check gates pass/fail. Composes with the rest of the miniKanren machinery — fresh / conde / membero etc. all work alongside. 9 new tests, 586/586 cumulative. --- lib/minikanren/clpfd.sx | 63 +++++++++++++ lib/minikanren/tests/clpfd-in-label.sx | 120 +++++++++++++++++++++++++ 2 files changed, 183 insertions(+) create mode 100644 lib/minikanren/tests/clpfd-in-label.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index 0b9134ee..46c3ff52 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -123,3 +123,66 @@ (let ((store-prime (assoc store :domains doms-prime))) (fd-with-store s store-prime)))))))) + +(define + fd-in + (fn + (x dom-list) + (fn + (s) + (let + ((new-dom (fd-dom-from-list dom-list))) + (let + ((wx (mk-walk x s))) + (cond + ((number? wx) + (cond ((fd-dom-member? wx new-dom) (unit s)) (:else mzero))) + ((is-var? wx) + (let + ((existing (fd-domain-of s (var-name wx)))) + (let + ((narrowed (cond ((= existing nil) new-dom) (:else (fd-dom-intersect existing new-dom))))) + (let + ((s2 (fd-set-domain s (var-name wx) narrowed))) + (cond ((= s2 nil) mzero) (:else (unit s2))))))) + (:else mzero))))))) + +(define + fd-try-each-value + (fn + (x dom s) + (cond + ((empty? dom) mzero) + (:else + (let + ((s2 (mk-unify x (first dom) s))) + (let + ((this-stream (cond ((= s2 nil) mzero) (:else (unit s2)))) + (rest-stream (fd-try-each-value x (rest dom) s))) + (mk-mplus this-stream rest-stream))))))) + +(define + fd-label-one + (fn + (x) + (fn + (s) + (let + ((wx (mk-walk x s))) + (cond + ((number? wx) (unit s)) + ((is-var? wx) + (let + ((dom (fd-domain-of s (var-name wx)))) + (cond + ((= dom nil) mzero) + (:else (fd-try-each-value wx dom s))))) + (:else mzero)))))) + +(define + fd-label + (fn + (vars) + (cond + ((empty? vars) succeed) + (:else (mk-conj (fd-label-one (first vars)) (fd-label (rest vars))))))) diff --git a/lib/minikanren/tests/clpfd-in-label.sx b/lib/minikanren/tests/clpfd-in-label.sx new file mode 100644 index 00000000..7393fdf6 --- /dev/null +++ b/lib/minikanren/tests/clpfd-in-label.sx @@ -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!) From 27637aa0f9401b485803d52e4a3a1c147f7d29b1 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:24:28 +0000 Subject: [PATCH 70/84] =?UTF-8?q?mk:=20phase=206D=20=E2=80=94=20fd-neq=20w?= =?UTF-8?q?ith=20propagation=20+=20constraint=20reactivation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit fd-neq adds a closure to the constraint store and runs it once on post. After every label binding, fd-fire-store re-runs all stored constraints — when one side of a fd-neq later becomes ground, the domain of the other side has the value removed. Propagator semantics: (number, number) -> equal? fail : ok (number, var) -> remove number from var's domain (var, number) -> symmetric (var, var) -> defer (re-fires after each label step) Pigeonhole-fails test confirms the constraint flow ends correctly: 3 vars all-pairwise-distinct over a 2-element domain has no solutions. 7 new tests, 593/593 cumulative. --- lib/minikanren/clpfd.sx | 103 ++++++++++++++++++++++++++---- lib/minikanren/tests/clpfd-neq.sx | 82 ++++++++++++++++++++++++ 2 files changed, 171 insertions(+), 14 deletions(-) create mode 100644 lib/minikanren/tests/clpfd-neq.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index 46c3ff52..b55df8ba 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -1,20 +1,19 @@ -;; lib/minikanren/clpfd.sx — Phase 6 piece B: CLP(FD) foundation. +;; lib/minikanren/clpfd.sx — Phase 6: native CLP(FD) on miniKanren. ;; -;; A finite-domain layer on top of the existing miniKanren machinery. The -;; substitution dict carries an extra reserved key "_fd" that holds a +;; The substitution dict carries an extra reserved key "_fd" that holds a ;; constraint-store record: ;; ;; {:domains {var-name -> sorted-int-list} -;; :constraints (... pending constraints ...)} +;; :constraints (... pending constraint closures ...)} ;; -;; Domains are sorted SX lists of ints (no duplicates). The constraints -;; field is reserved for later iterations; this commit ships only the -;; domain machinery + accessors. -;; -;; Naming: fd-* (domain primitives, kernel-style). +;; Domains are sorted SX lists of ints (no duplicates). +;; Constraints are functions s -> s-or-nil that propagate / re-check. +;; They are re-fired after every label binding via fd-fire-store. (define fd-key "_fd") +;; --- domain primitives --- + (define fd-dom-rev (fn @@ -56,7 +55,6 @@ (cond ((empty? (rest d)) (first d)) (:else (fd-dom-last (rest d)))))) (define fd-dom-max (fn (d) (fd-dom-last d))) - (define fd-dom-member? (fn (x d) (some (fn (y) (= x y)) d))) (define @@ -89,6 +87,8 @@ ((> lo hi) (list)) (:else (cons lo (fd-dom-range (+ lo 1) hi)))))) +;; --- constraint store accessors --- + (define fd-store-empty (fn () {:domains {} :constraints (list)})) (define @@ -98,7 +98,6 @@ (cond ((has-key? s fd-key) (get s fd-key)) (:else (fd-store-empty))))) (define fd-domains-of (fn (s) (get (fd-store-of s) :domains))) - (define fd-with-store (fn (s store) (assoc s fd-key store))) (define @@ -124,6 +123,37 @@ ((store-prime (assoc store :domains doms-prime))) (fd-with-store s store-prime)))))))) +(define + fd-add-constraint + (fn + (s c) + (let + ((store (fd-store-of s))) + (let + ((cs-prime (cons c (get store :constraints)))) + (let + ((store-prime (assoc store :constraints cs-prime))) + (fd-with-store s store-prime)))))) + +(define + fd-fire-list + (fn + (cs s) + (cond + ((empty? cs) s) + (:else + (let + ((s2 ((first cs) s))) + (cond ((= s2 nil) nil) (:else (fd-fire-list (rest cs) s2)))))))) + +(define + fd-fire-store + (fn + (s) + (let ((cs (get (fd-store-of s) :constraints))) (fd-fire-list cs s)))) + +;; --- user-facing goals --- + (define fd-in (fn @@ -147,6 +177,49 @@ (cond ((= s2 nil) mzero) (:else (unit s2))))))) (:else mzero))))))) +;; --- fd-neq with propagation --- + +(define + fd-neq-prop + (fn + (x y s) + (let + ((wx (mk-walk x s)) (wy (mk-walk y s))) + (cond + ((and (number? wx) (number? wy)) + (cond ((= wx wy) nil) (:else s))) + ((and (number? wx) (is-var? wy)) + (let + ((y-dom (fd-domain-of s (var-name wy)))) + (cond + ((= y-dom nil) s) + (:else + (fd-set-domain s (var-name wy) (fd-dom-without wx y-dom)))))) + ((and (number? wy) (is-var? wx)) + (let + ((x-dom (fd-domain-of s (var-name wx)))) + (cond + ((= x-dom nil) s) + (:else + (fd-set-domain s (var-name wx) (fd-dom-without wy x-dom)))))) + (:else s))))) + +(define + fd-neq + (fn + (x y) + (fn + (s) + (let + ((c (fn (s-prime) (fd-neq-prop x y s-prime)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + +;; --- labelling --- + (define fd-try-each-value (fn @@ -157,9 +230,11 @@ (let ((s2 (mk-unify x (first dom) s))) (let - ((this-stream (cond ((= s2 nil) mzero) (:else (unit s2)))) - (rest-stream (fd-try-each-value x (rest dom) s))) - (mk-mplus this-stream rest-stream))))))) + ((s3 (cond ((= s2 nil) nil) (:else (fd-fire-store s2))))) + (let + ((this-stream (cond ((= s3 nil) mzero) (:else (unit s3)))) + (rest-stream (fd-try-each-value x (rest dom) s))) + (mk-mplus this-stream rest-stream)))))))) (define fd-label-one diff --git a/lib/minikanren/tests/clpfd-neq.sx b/lib/minikanren/tests/clpfd-neq.sx new file mode 100644 index 00000000..2a533e3c --- /dev/null +++ b/lib/minikanren/tests/clpfd-neq.sx @@ -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!) From c01ddc2b2392dafe6ca9a4cecef5afdd2c44ba28 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:34:10 +0000 Subject: [PATCH 71/84] =?UTF-8?q?mk:=20phase=206E=20=E2=80=94=20fd-lt=20+?= =?UTF-8?q?=20fd-lte=20+=20fd-eq=20with=20propagation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three more constraint goals built on the same propagator-store machinery as fd-neq: fd-lt: x < y. Ground/ground compares; var/num filters domain; var/var narrows x's domain to (< y-max) and y's to (> x-min). fd-lte: ≤ variant. fd-eq: x = y. Ground/ground checks. Var/num: requires num to be in var's domain (or var unconstrained) before binding. Var/var: intersect domains, narrow both, then unify the vars. 10 new tests: narrowing against ground, ordered-pair generation, chained x v wx)) yd)))))) + ((and (is-var? wx) (number? wy)) + (let + ((xd (fd-domain-of s (var-name wx)))) + (cond + ((= xd nil) s) + (:else + (fd-set-domain + s + (var-name wx) + (filter (fn (v) (< v wy)) xd)))))) + ((and (is-var? wx) (is-var? wy)) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy)))) + (cond + ((or (= xd nil) (= yd nil)) s) + (:else + (let + ((xd-prime (filter (fn (v) (< v (fd-dom-max yd))) xd))) + (let + ((s2 (fd-set-domain s (var-name wx) xd-prime))) + (cond + ((= s2 nil) nil) + (:else + (let + ((yd-prime (filter (fn (v) (> v (fd-dom-min xd-prime))) yd))) + (fd-set-domain s2 (var-name wy) yd-prime)))))))))) + (:else s))))) + +(define + fd-lt + (fn + (x y) + (fn + (s) + (let + ((c (fn (sp) (fd-lt-prop x y sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + +;; --- fd-lte --- + +(define + fd-lte-prop + (fn + (x y s) + (let + ((wx (mk-walk x s)) (wy (mk-walk y s))) + (cond + ((and (number? wx) (number? wy)) + (cond ((<= wx wy) s) (:else nil))) + ((and (number? wx) (is-var? wy)) + (let + ((yd (fd-domain-of s (var-name wy)))) + (cond + ((= yd nil) s) + (:else + (fd-set-domain + s + (var-name wy) + (filter (fn (v) (>= v wx)) yd)))))) + ((and (is-var? wx) (number? wy)) + (let + ((xd (fd-domain-of s (var-name wx)))) + (cond + ((= xd nil) s) + (:else + (fd-set-domain + s + (var-name wx) + (filter (fn (v) (<= v wy)) xd)))))) + ((and (is-var? wx) (is-var? wy)) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy)))) + (cond + ((or (= xd nil) (= yd nil)) s) + (:else + (let + ((xd-prime (filter (fn (v) (<= v (fd-dom-max yd))) xd))) + (let + ((s2 (fd-set-domain s (var-name wx) xd-prime))) + (cond + ((= s2 nil) nil) + (:else + (let + ((yd-prime (filter (fn (v) (>= v (fd-dom-min xd-prime))) yd))) + (fd-set-domain s2 (var-name wy) yd-prime)))))))))) + (:else s))))) + +(define + fd-lte + (fn + (x y) + (fn + (s) + (let + ((c (fn (sp) (fd-lte-prop x y sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + +;; --- fd-eq --- + +(define + fd-eq-prop + (fn + (x y s) + (let + ((wx (mk-walk x s)) (wy (mk-walk y s))) + (cond + ((and (number? wx) (number? wy)) + (cond ((= wx wy) s) (:else nil))) + ((and (number? wx) (is-var? wy)) + (let + ((yd (fd-domain-of s (var-name wy)))) + (cond + ((and (not (= yd nil)) (not (fd-dom-member? wx yd))) nil) + (:else + (let + ((s2 (mk-unify wy wx s))) + (cond ((= s2 nil) nil) (:else s2))))))) + ((and (is-var? wx) (number? wy)) + (let + ((xd (fd-domain-of s (var-name wx)))) + (cond + ((and (not (= xd nil)) (not (fd-dom-member? wy xd))) nil) + (:else + (let + ((s2 (mk-unify wx wy s))) + (cond ((= s2 nil) nil) (:else s2))))))) + ((and (is-var? wx) (is-var? wy)) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy)))) + (cond + ((and (= xd nil) (= yd nil)) + (let + ((s2 (mk-unify wx wy s))) + (cond ((= s2 nil) nil) (:else s2)))) + (:else + (let + ((shared (cond ((= xd nil) yd) ((= yd nil) xd) (:else (fd-dom-intersect xd yd))))) + (cond + ((fd-dom-empty? shared) nil) + (:else + (let + ((s2 (fd-set-domain s (var-name wx) shared))) + (cond + ((= s2 nil) nil) + (:else + (let + ((s3 (fd-set-domain s2 (var-name wy) shared))) + (cond + ((= s3 nil) nil) + (:else (mk-unify wx wy s3)))))))))))))) + (:else s))))) + +(define + fd-eq + (fn + (x y) + (fn + (s) + (let + ((c (fn (sp) (fd-eq-prop x y sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ;; --- labelling --- (define diff --git a/lib/minikanren/tests/clpfd-ord.sx b/lib/minikanren/tests/clpfd-ord.sx new file mode 100644 index 00000000..535f127d --- /dev/null +++ b/lib/minikanren/tests/clpfd-ord.sx @@ -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!) From f88388b2f926e2ffbff82c7e6ae89497b6114893 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:35:19 +0000 Subject: [PATCH 72/84] =?UTF-8?q?mk:=20phase=206F=20=E2=80=94=20fd-distinc?= =?UTF-8?q?t=20(pairwise=20alldifferent)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (fd-distinct (list a b c ...)) imposes pairwise distinctness via O(n²) fd-neq constraints. Each fd-neq propagates independently when any pair becomes ground or has a domain-removable value. Tests: empty/singleton trivially succeed; pair-distinct/equal cover correctness; 3-perms-of-3 = 6 and 4-perms-of-4 = 24 confirm full permutation enumeration; pigeonhole 4-of-3 fails. 7 new tests, 610/610 cumulative. --- lib/minikanren/clpfd.sx | 25 +++++++++++++ lib/minikanren/tests/clpfd-distinct.sx | 52 ++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100644 lib/minikanren/tests/clpfd-distinct.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index e356e60a..fedc87c7 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -459,3 +459,28 @@ (cond ((empty? vars) succeed) (:else (mk-conj (fd-label-one (first vars)) (fd-label (rest vars))))))) + +;; --- fd-distinct (pairwise distinct via fd-neq) --- + +(define + fd-distinct-from-head + (fn + (x others) + (cond + ((empty? others) succeed) + (:else + (mk-conj + (fd-neq x (first others)) + (fd-distinct-from-head x (rest others))))))) + +(define + fd-distinct + (fn + (vars) + (cond + ((empty? vars) succeed) + ((empty? (rest vars)) succeed) + (:else + (mk-conj + (fd-distinct-from-head (first vars) (rest vars)) + (fd-distinct (rest vars))))))) diff --git a/lib/minikanren/tests/clpfd-distinct.sx b/lib/minikanren/tests/clpfd-distinct.sx new file mode 100644 index 00000000..1c2d7d11 --- /dev/null +++ b/lib/minikanren/tests/clpfd-distinct.sx @@ -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!) From 5d3c248fdd6ebe17a56e8071999c26ecd4d9eaf5 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:36:25 +0000 Subject: [PATCH 73/84] =?UTF-8?q?mk:=20phase=206G=20=E2=80=94=20fd-plus=20?= =?UTF-8?q?(x=20+=20y=20=3D=20z)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ground-cases propagator: when at least two of {x, y, z} walk to ground numbers, the third is derived (or checked, if also ground). Three vars with domains: deferred — no bounds-consistency in this iteration. Includes a small fd-bind-or-narrow helper that handles the common "bind a var to a target int, respecting any existing domain" pattern shared across propagators. 7 new tests: ground/ground/ground, recover x, recover y, impossible case, domain-check rejection, x+y=5 enumeration, large numbers. 617/617 cumulative. --- lib/minikanren/clpfd.sx | 50 ++++++++++++++++++++++++ lib/minikanren/tests/clpfd-plus.sx | 62 ++++++++++++++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 lib/minikanren/tests/clpfd-plus.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index fedc87c7..ce2c36d8 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -484,3 +484,53 @@ (mk-conj (fd-distinct-from-head (first vars) (rest vars)) (fd-distinct (rest vars))))))) + +;; --- fd-plus (x + y = z, ground-cases propagator) --- + +(define + fd-bind-or-narrow + (fn + (w target s) + (cond + ((number? w) (cond ((= w target) s) (:else nil))) + ((is-var? w) + (let + ((wd (fd-domain-of s (var-name w)))) + (cond + ((and (not (= wd nil)) (not (fd-dom-member? target wd))) nil) + (:else + (let + ((s2 (mk-unify w target s))) + (cond ((= s2 nil) nil) (:else s2))))))) + (:else nil)))) + +(define + fd-plus-prop + (fn + (x y z s) + (let + ((wx (mk-walk x s)) (wy (mk-walk y s)) (wz (mk-walk z s))) + (cond + ((and (number? wx) (number? wy) (number? wz)) + (cond ((= (+ wx wy) wz) s) (:else nil))) + ((and (number? wx) (number? wy)) + (fd-bind-or-narrow wz (+ wx wy) s)) + ((and (number? wx) (number? wz)) + (fd-bind-or-narrow wy (- wz wx) s)) + ((and (number? wy) (number? wz)) + (fd-bind-or-narrow wx (- wz wy) s)) + (:else s))))) + +(define + fd-plus + (fn + (x y z) + (fn + (s) + (let + ((c (fn (sp) (fd-plus-prop x y z sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) diff --git a/lib/minikanren/tests/clpfd-plus.sx b/lib/minikanren/tests/clpfd-plus.sx new file mode 100644 index 00000000..81b01d18 --- /dev/null +++ b/lib/minikanren/tests/clpfd-plus.sx @@ -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!) From a6e758664be57fdd8211bdff58ca0b16d5506fce Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:37:17 +0000 Subject: [PATCH 74/84] =?UTF-8?q?mk:=20phase=206H=20=E2=80=94=20fd-times?= =?UTF-8?q?=20(x=20*=20y=20=3D=20z)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ground-cases propagator parallel to fd-plus. Division back-direction checks (mod z x) = 0 before recovering a divisor. Edge cases: multiplying by zero binds the product to zero; with z=0 and one factor zero, the other factor is unconstrained. 7 tests including divisor enumeration, square-of-each, divisibility rejection. 624/624 cumulative. --- lib/minikanren/clpfd.sx | 39 +++++++++++++ lib/minikanren/tests/clpfd-times.sx | 85 +++++++++++++++++++++++++++++ 2 files changed, 124 insertions(+) create mode 100644 lib/minikanren/tests/clpfd-times.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index ce2c36d8..bd03ece2 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -534,3 +534,42 @@ (let ((s3 (c s2))) (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + +;; --- fd-times (x * y = z, ground-cases propagator) --- + +(define + fd-times-prop + (fn + (x y z s) + (let + ((wx (mk-walk x s)) (wy (mk-walk y s)) (wz (mk-walk z s))) + (cond + ((and (number? wx) (number? wy) (number? wz)) + (cond ((= (* wx wy) wz) s) (:else nil))) + ((and (number? wx) (number? wy)) + (fd-bind-or-narrow wz (* wx wy) s)) + ((and (number? wx) (number? wz)) + (cond + ((= wx 0) (cond ((= wz 0) s) (:else nil))) + ((not (= (mod wz wx) 0)) nil) + (:else (fd-bind-or-narrow wy (/ wz wx) s)))) + ((and (number? wy) (number? wz)) + (cond + ((= wy 0) (cond ((= wz 0) s) (:else nil))) + ((not (= (mod wz wy) 0)) nil) + (:else (fd-bind-or-narrow wx (/ wz wy) s)))) + (:else s))))) + +(define + fd-times + (fn + (x y z) + (fn + (s) + (let + ((c (fn (sp) (fd-times-prop x y z sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s3 (c s2))) + (cond ((= s3 nil) mzero) (:else (unit s3))))))))) diff --git a/lib/minikanren/tests/clpfd-times.sx b/lib/minikanren/tests/clpfd-times.sx new file mode 100644 index 00000000..c858a537 --- /dev/null +++ b/lib/minikanren/tests/clpfd-times.sx @@ -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!) From 8644668fc91a7ac8ab88dcae40006f4e9eca2fbc Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 14:44:59 +0000 Subject: [PATCH 75/84] =?UTF-8?q?mk:=20phase=206=20done=20=E2=80=94=20fd-f?= =?UTF-8?q?ire-store=20iterates,=20N-queens=20FD=20works?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The previous fd-fire-store fired every constraint exactly once. That left the propagation incomplete in chains like fd-plus c4 1 a; fd-neq c3 a where, on the round c4 binds, fd-plus binds a, but fd-neq c3 a was already past — so the conflict went undetected. New: fd-store-signature is sum-of-domain-sizes + count-of-bindings. fd-fire-store calls fd-fire-list and recurses while the signature strictly decreases. Reaches a fixed point or fails. This makes N-queens via FD tractable: 4-queens -> ((2 4 1 3) (3 1 4 2)) — exactly the two solutions. 5-queens -> 10 solutions (the canonical count), in seconds. Phase 6 marked complete in the plan: domains, fd-in, fd-eq, fd-neq, fd-lt, fd-lte, fd-plus, fd-times, fd-distinct, fd-label, all wired through the constraint-reactivation loop. Two new tests, 626/626 cumulative. --- lib/minikanren/clpfd.sx | 17 +++++- lib/minikanren/tests/queens-fd.sx | 97 +++++++++++++++++++++++++++++++ plans/minikanren-on-sx.md | 30 ++++++++-- 3 files changed, 138 insertions(+), 6 deletions(-) create mode 100644 lib/minikanren/tests/queens-fd.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index bd03ece2..ab2fb10b 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -146,11 +146,26 @@ ((s2 ((first cs) s))) (cond ((= s2 nil) nil) (:else (fd-fire-list (rest cs) s2)))))))) +(define + fd-store-signature + (fn + (s) + (let + ((doms (fd-domains-of s))) + (let + ((dom-sizes (reduce (fn (acc k) (+ acc (len (get doms k)))) 0 (keys doms)))) + (+ dom-sizes (len (keys s))))))) + (define fd-fire-store (fn (s) - (let ((cs (get (fd-store-of s) :constraints))) (fd-fire-list cs s)))) + (let + ((s2 (fd-fire-list (get (fd-store-of s) :constraints) s))) + (cond + ((= s2 nil) nil) + ((= (fd-store-signature s) (fd-store-signature s2)) s2) + (:else (fd-fire-store s2)))))) ;; --- user-facing goals --- diff --git a/lib/minikanren/tests/queens-fd.sx b/lib/minikanren/tests/queens-fd.sx new file mode 100644 index 00000000..7457abd0 --- /dev/null +++ b/lib/minikanren/tests/queens-fd.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 8e2055f1..702ddde9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -145,11 +145,31 @@ Key semantic mappings: - [ ] Tests: Zebra puzzle, N-queens, Sudoku via `project`, family relations via `matche` ### Phase 6 — arithmetic constraints CLP(FD) -- [ ] Finite domain variables: `fd-var` with domain `[lo..hi]` -- [x] `ino` `x` `domain` — alias for `(membero x domain)` with the - constraint-store-friendly argument order. Sufficient for the - enumerate-then-filter style of finite-domain solving. -- [x] `all-distincto` `l` — pairwise-distinct elements via `nafc + membero`. +- [x] Finite domain variables: domain stored under reserved key `_fd` in + the substitution dict; ascending sorted-int-list representation; + domain primitives `fd-dom-from-list`, `fd-dom-intersect`, + `fd-dom-without`, `fd-dom-range`, `fd-dom-min/max/empty?/singleton?`. +- [x] `fd-in x dom` — narrows x's domain by intersection. +- [x] `fd-eq x y`, `fd-neq x y`, `fd-lt`, `fd-lte` — propagator-store + goals. Each adds a closure to the constraints field and runs it + on post; closures re-fire after every label step via fd-fire-store. +- [x] `fd-plus x y z`, `fd-times x y z` — ground-cases propagators + (when 2 of 3 walk to numbers, the third is derived). +- [x] `fd-distinct vars` — pairwise alldifferent via fd-neq folds. +- [x] Constraint reactivation: `fd-fire-store` iterates to fixed point + using a domain+bindings signature comparison; ensures multi-step + propagation chains (e.g. fd-plus binds a fresh var, which then + lets a downstream fd-neq fire). +- [x] Labelling: `fd-label vars` enumerates each var's domain via + mk-mplus over singleton bindings; constraint store re-fires after + each binding. +- [x] Tests: N-queens via FD — 4-queens finds both solutions, 5-queens + finds all 10 in seconds (vs the naive enumerate-then-filter + version which times out past N=4). +- [x] `ino` `x` `domain` — alias for `(membero x domain)` (kept for + the simple enumerate-then-filter pattern alongside fd-in). +- [x] `all-distincto` `l` — original membero-based version (kept alongside + the newer fd-distinct). - [ ] `fd-eq` `x` `y` — x = y (constraint propagation) - [ ] `fd-neq` `x` `y` — x ≠ y - [ ] `fd-lt` `fd-lte` `fd-gt` `fd-gte` — ordering constraints From adc8467c78e8d4a7f2e51f9c72941831f0cb56c3 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 22:27:10 +0000 Subject: [PATCH 76/84] =?UTF-8?q?mk:=20phase=207=20=E2=80=94=20naive=20gro?= =?UTF-8?q?und-arg=20tabling,=20Fibonacci=20canary=20green?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `table-2` wraps a 2-arg (input, output) relation. On a ground input walk, looks up the (string-encoded) cache key; on miss, runs the relation, drains the answer stream, extracts walk*-output values from each subst, stores them, and replays. On hit, replays the cached values directly — no recomputation. Cache lifetime: a single global mk-tab-cache (mutated via set!). mk-tab-clear! resets between independent queries. Canonical demo: tabled fib(25) = 75025 in ~5 seconds; the same naive fib-o times out at 60s. Memoization collapses the exponential redundant recomputation in the binary recursion. Limitations (deferred to future SLG work): cyclic recursive calls with the same ground key still diverge — naive memoization populates the cache only AFTER computation completes, so a recursive call inside its own computation can't see the in-progress entry. The brief's "tabled patho on cyclic graphs" use case requires producer/consumer scheduling and is left for a future iteration. 12 new tests, fib(0..20) + ground-term predicate + cache-replay verification. 638/638 cumulative. --- lib/minikanren/tabling.sx | 91 +++++++++++++++++++++++++++++++++ lib/minikanren/tests/tabling.sx | 60 ++++++++++++++++++++++ plans/minikanren-on-sx.md | 17 ++++-- 3 files changed, 164 insertions(+), 4 deletions(-) create mode 100644 lib/minikanren/tabling.sx create mode 100644 lib/minikanren/tests/tabling.sx diff --git a/lib/minikanren/tabling.sx b/lib/minikanren/tabling.sx new file mode 100644 index 00000000..70ad2967 --- /dev/null +++ b/lib/minikanren/tabling.sx @@ -0,0 +1,91 @@ +;; lib/minikanren/tabling.sx — Phase 7 piece A: naive memoization. +;; +;; A `table-2` wrapper for 2-arg relations (input, output). Caches by +;; ground input (walked at call time). On hit, replays the cached output +;; values; on miss, runs the relation, collects all output values from +;; the answer stream, stores, then replays. +;; +;; Limitations of naive memoization (vs proper SLG / producer-consumer +;; tabling): +;; - Each call must terminate before its result enters the cache — +;; so cyclic recursive calls with the SAME ground input would still +;; diverge (not addressed here). +;; - Caching by full ground walk only; partially-ground args fall +;; through to the underlying relation. +;; +;; Despite the limitations, naive memoization is enough for the +;; canonical demo: Fibonacci goes from exponential to linear because +;; each fib(k) result is computed at most once. +;; +;; Cache lifetime: a single global mk-tab-cache. Use `(mk-tab-clear!)` +;; between independent queries. + +(define mk-tab-cache {}) + +(define mk-tab-clear! (fn () (set! mk-tab-cache {}))) + +(define + mk-tab-lookup + (fn + (key) + (cond + ((has-key? mk-tab-cache key) (get mk-tab-cache key)) + (:else :miss)))) + +(define + mk-tab-store! + (fn (key vals) (set! mk-tab-cache (assoc mk-tab-cache key vals)))) + +(define + mk-tab-ground-term? + (fn + (t) + (cond + ((is-var? t) false) + ((mk-cons-cell? t) + (and + (mk-tab-ground-term? (mk-cons-head t)) + (mk-tab-ground-term? (mk-cons-tail t)))) + ((mk-list-pair? t) (every? mk-tab-ground-term? t)) + (:else true)))) + +(define + mk-tab-replay-vals + (fn + (vals output s) + (cond + ((empty? vals) mzero) + (:else + (let + ((sp (mk-unify output (first vals) s))) + (let + ((this-stream (cond ((= sp nil) mzero) (:else (unit sp))))) + (mk-mplus this-stream (mk-tab-replay-vals (rest vals) output s)))))))) + +(define + table-2 + (fn + (name rel-fn) + (fn + (input output) + (fn + (s) + (let + ((winput (mk-walk* input s))) + (cond + ((mk-tab-ground-term? winput) + (let + ((key (str name "@" winput))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :miss) + (let + ((all-substs (stream-take -1 ((rel-fn input output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s))))) + (:else (mk-tab-replay-vals cached output s)))))) + (:else ((rel-fn input output) s)))))))) diff --git a/lib/minikanren/tests/tabling.sx b/lib/minikanren/tests/tabling.sx new file mode 100644 index 00000000..031d2f35 --- /dev/null +++ b/lib/minikanren/tests/tabling.sx @@ -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!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 702ddde9..201129d9 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -180,10 +180,19 @@ Key semantic mappings: - [ ] Tests: send-more-money, N-queens with CLP(FD), map coloring, cryptarithmetic ### Phase 7 — tabling (memoization of relations) -- [ ] `tabled` annotation: memoize calls to a relation using a hash table -- [ ] Prevents infinite loops in recursive relations like `patho` on cyclic graphs -- [ ] Producer/consumer scheduling for tabled relations (variant of SLG resolution) -- [ ] Tests: cyclic graph reachability, mutual recursion, Fibonacci via tabling +- [x] `table-2` wrapper: ground-arg memoization for 2-arg relations. + Cache keyed by walked input; on miss runs underlying relation, + collects all output values from the answer stream, stores, and + replays. Subsequent calls with the same ground input replay the + cached values (no recomputation). +- [x] Fibonacci canary green: tabled `fib(25) = 75025` in seconds; + naive `fib(25)` times out at 60s. Memoization turns exponential + recursion into linear. +- [ ] Producer/consumer SLG scheduling — required to handle recursive + tabled calls with the SAME ground key (e.g. cyclic `patho` with a + shared key); naive memoization deferred to a future iteration. +- [ ] Tests: cyclic graph reachability via tabled patho (deferred — + requires SLG); mutual recursion (deferred). ## Blockers From 80ab039ada8c122160b4556814263663ca8c92b4 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 22:29:15 +0000 Subject: [PATCH 77/84] =?UTF-8?q?mk:=20phase=207=20=E2=80=94=20table-1=20+?= =?UTF-8?q?=20table-3,=20Ackermann=20canary?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two more arities of the naive memoization wrapper: table-1: predicate (1-arg) tabling. Cache entry is :ok / :no. Demonstrated with a tabled membero-as-predicate. table-3: 3-arg (i1 i2 output) tabling. Cache key joins the two inputs; cache value is the output value list. Canonical demo: tabled Ackermann. (ack-o 0 0 q) -> 1 (ack-o 2 3 q) -> 9 (ack-o 3 3 q) -> 61 A(3,3) executes A(2,..) many times, A(1,..) more, A(0,..) most. With table-3 each (m, n) pair is computed once. 6 new tests, 644/644 cumulative. --- lib/minikanren/tabling.sx | 66 ++++++++++++++++++++++++++++ lib/minikanren/tests/tabling-more.sx | 55 +++++++++++++++++++++++ 2 files changed, 121 insertions(+) create mode 100644 lib/minikanren/tests/tabling-more.sx diff --git a/lib/minikanren/tabling.sx b/lib/minikanren/tabling.sx index 70ad2967..8dad2174 100644 --- a/lib/minikanren/tabling.sx +++ b/lib/minikanren/tabling.sx @@ -89,3 +89,69 @@ (mk-tab-replay-vals vals output s))))) (:else (mk-tab-replay-vals cached output s)))))) (:else ((rel-fn input output) s)))))))) + +;; --- table-1: 1-arg relation (one input, no output to cache) --- +;; The relation is a predicate `(p input)` that succeeds or fails. +;; Cache stores either :ok or :no. + +(define + table-1 + (fn + (name rel-fn) + (fn + (input) + (fn + (s) + (let + ((winput (mk-walk* input s))) + (cond + ((mk-tab-ground-term? winput) + (let + ((key (str name "@1@" winput))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :miss) + (let + ((stream ((rel-fn input) s))) + (let + ((peek (stream-take 1 stream))) + (cond + ((empty? peek) + (begin (mk-tab-store! key :no) mzero)) + (:else (begin (mk-tab-store! key :ok) stream)))))) + ((= cached :ok) (unit s)) + ((= cached :no) mzero) + (:else mzero))))) + (:else ((rel-fn input) s)))))))) + +;; --- table-3: 3-arg relation (input1 input2 output) --- +;; Cache keyed by (input1, input2). Output values cached as a list. + +(define + table-3 + (fn + (name rel-fn) + (fn + (i1 i2 output) + (fn + (s) + (let + ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s))) + (cond + ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2)) + (let + ((key (str name "@3@" wi1 "/" wi2))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :miss) + (let + ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s))))) + (:else (mk-tab-replay-vals cached output s)))))) + (:else ((rel-fn i1 i2 output) s)))))))) diff --git a/lib/minikanren/tests/tabling-more.sx b/lib/minikanren/tests/tabling-more.sx new file mode 100644 index 00000000..332c1177 --- /dev/null +++ b/lib/minikanren/tests/tabling-more.sx @@ -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!) From 5c51f5ef8f3b0d3e2d6be9af523a597da402ea76 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 8 May 2026 22:29:49 +0000 Subject: [PATCH 78/84] =?UTF-8?q?GUEST-plan:=20phase=207=20status=20?= =?UTF-8?q?=E2=80=94=20naive=20tabling=20done,=20SLG=20deferred?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- plans/minikanren-on-sx.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 201129d9..16816005 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -180,6 +180,8 @@ Key semantic mappings: - [ ] Tests: send-more-money, N-queens with CLP(FD), map coloring, cryptarithmetic ### Phase 7 — tabling (memoization of relations) +- [x] `table-1`, `table-2`, `table-3` wrappers: ground-arg memoization + for 1-, 2-, and 3-argument relations. - [x] `table-2` wrapper: ground-arg memoization for 2-arg relations. Cache keyed by walked input; on miss runs underlying relation, collects all output values from the answer stream, stores, and @@ -188,6 +190,7 @@ Key semantic mappings: - [x] Fibonacci canary green: tabled `fib(25) = 75025` in seconds; naive `fib(25)` times out at 60s. Memoization turns exponential recursion into linear. +- [x] Ackermann canary green via `table-3`: `A(3, 3) = 61`. - [ ] Producer/consumer SLG scheduling — required to handle recursive tabled calls with the SAME ground key (e.g. cyclic `patho` with a shared key); naive memoization deferred to a future iteration. From d1817e026d1119b58894e376695816e8c823b92c Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 13:18:29 +0000 Subject: [PATCH 79/84] =?UTF-8?q?mk:=20phase=206=20piece=20B=20=E2=80=94?= =?UTF-8?q?=20bounds-consistency=20for=20fd-plus=20+=20fd-times?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit fd-plus-prop now propagates in the four partial- and all-domain cases (vvn, nvv, vnv, vvv) by interval reasoning: x in [z.min - y.max .. z.max - y.min] y in [z.min - x.max .. z.max - x.min] z in [x.min + y.min .. x.max + y.max] Helpers added: fd-narrow-or-skip — common "no-domain? skip; else filter & set" path. fd-int-floor-div / fd-int-ceil-div — integer-division wrappers because SX `/` returns rationals; floor/ceil computed via (a - (mod a b)). fd-times-prop gets the same treatment for positive domains. Mixed-sign domains pass through (sound, but no narrowing). 10 new tests in clpfd-bounds.sx demonstrate domains shrinking BEFORE labelling: x+y=10 with x in {1..10}, y in {1..3} narrows x to {7..9}; 3*y=z narrows z to {3..12}; impossible bounds (x+y=100, x,y in {1..10}) return :no-subst directly. 132/132 across the clpfd test files. Suggested next: Piece D (send-more-money + Sudoku 4x4) to validate this against larger puzzles. --- lib/minikanren/clpfd.sx | 256 ++++++++++++++++++++++ lib/minikanren/tests/clpfd-bounds.sx | 316 +++++++++++++++++++++++++++ 2 files changed, 572 insertions(+) create mode 100644 lib/minikanren/tests/clpfd-bounds.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index ab2fb10b..46fd4fff 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -519,6 +519,118 @@ (cond ((= s2 nil) nil) (:else s2))))))) (:else nil)))) +(define + fd-narrow-or-skip + (fn + (s var-key d lo hi) + (cond + ((= d nil) s) + (:else + (fd-set-domain + s + var-key + (filter (fn (v) (and (>= v lo) (<= v hi))) d)))))) + +(define + fd-plus-prop-vvn + (fn + (wx wy wz s) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy)))) + (cond + ((or (= xd nil) (= yd nil)) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (- wz (fd-dom-max yd)) (- wz (fd-dom-min yd))))) + (cond + ((= s1 nil) nil) + (:else + (let + ((xd2 (fd-domain-of s1 (var-name wx)))) + (fd-narrow-or-skip + s1 + (var-name wy) + yd + (- wz (fd-dom-max xd2)) + (- wz (fd-dom-min xd2)))))))))))) + +(define + fd-plus-prop-nvv + (fn + (wx wy wz s) + (let + ((yd (fd-domain-of s (var-name wy))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= yd nil) (= zd nil)) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wy) yd (- (fd-dom-min zd) wx) (- (fd-dom-max zd) wx)))) + (cond + ((= s1 nil) nil) + (:else + (let + ((yd2 (fd-domain-of s1 (var-name wy)))) + (fd-narrow-or-skip + s1 + (var-name wz) + zd + (+ wx (fd-dom-min yd2)) + (+ wx (fd-dom-max yd2)))))))))))) + +(define + fd-plus-prop-vnv + (fn + (wx wy wz s) + (let + ((xd (fd-domain-of s (var-name wx))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= xd nil) (= zd nil)) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (- (fd-dom-min zd) wy) (- (fd-dom-max zd) wy)))) + (cond + ((= s1 nil) nil) + (:else + (let + ((xd2 (fd-domain-of s1 (var-name wx)))) + (fd-narrow-or-skip + s1 + (var-name wz) + zd + (+ (fd-dom-min xd2) wy) + (+ (fd-dom-max xd2) wy))))))))))) + +(define + fd-plus-prop-vvv + (fn + (wx wy wz s) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= xd nil) (or (= yd nil) (= zd nil))) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (- (fd-dom-min zd) (fd-dom-max yd)) (- (fd-dom-max zd) (fd-dom-min yd))))) + (cond + ((= s1 nil) nil) + (:else + (let + ((s2 (fd-narrow-or-skip s1 (var-name wy) yd (- (fd-dom-min zd) (fd-dom-max xd)) (- (fd-dom-max zd) (fd-dom-min xd))))) + (cond + ((= s2 nil) nil) + (:else + (fd-narrow-or-skip + s2 + (var-name wz) + zd + (+ (fd-dom-min xd) (fd-dom-min yd)) + (+ (fd-dom-max xd) (fd-dom-max yd)))))))))))))) + (define fd-plus-prop (fn @@ -534,6 +646,14 @@ (fd-bind-or-narrow wy (- wz wx) s)) ((and (number? wy) (number? wz)) (fd-bind-or-narrow wx (- wz wy) s)) + ((and (is-var? wx) (is-var? wy) (number? wz)) + (fd-plus-prop-vvn wx wy wz s)) + ((and (number? wx) (is-var? wy) (is-var? wz)) + (fd-plus-prop-nvv wx wy wz s)) + ((and (is-var? wx) (number? wy) (is-var? wz)) + (fd-plus-prop-vnv wx wy wz s)) + ((and (is-var? wx) (is-var? wy) (is-var? wz)) + (fd-plus-prop-vvv wx wy wz s)) (:else s))))) (define @@ -552,6 +672,134 @@ ;; --- fd-times (x * y = z, ground-cases propagator) --- +(define + fd-int-ceil-div + (fn + (a b) + (cond + ((= (mod a b) 0) (/ a b)) + (:else (+ (fd-int-floor-div a b) 1))))) + +(define fd-int-floor-div (fn (a b) (/ (- a (mod a b)) b))) + +(define + fd-dom-positive? + (fn + (d) + (cond ((empty? d) false) (:else (>= (fd-dom-min d) 1))))) + +(define + fd-times-prop-vvv + (fn + (wx wy wz s) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= xd nil) (or (= yd nil) (= zd nil))) s) + ((not (and (fd-dom-positive? xd) (and (fd-dom-positive? yd) (fd-dom-positive? zd)))) + s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div (fd-dom-min zd) (fd-dom-max yd)) (fd-int-floor-div (fd-dom-max zd) (fd-dom-min yd))))) + (cond + ((= s1 nil) nil) + (:else + (let + ((s2 (fd-narrow-or-skip s1 (var-name wy) yd (fd-int-ceil-div (fd-dom-min zd) (fd-dom-max xd)) (fd-int-floor-div (fd-dom-max zd) (fd-dom-min xd))))) + (cond + ((= s2 nil) nil) + (:else + (fd-narrow-or-skip + s2 + (var-name wz) + zd + (* (fd-dom-min xd) (fd-dom-min yd)) + (* (fd-dom-max xd) (fd-dom-max yd)))))))))))))) + +(define + fd-times-prop-vvn + (fn + (wx wy wz s) + (let + ((xd (fd-domain-of s (var-name wx))) + (yd (fd-domain-of s (var-name wy)))) + (cond + ((or (= xd nil) (= yd nil)) s) + ((not (and (fd-dom-positive? xd) (fd-dom-positive? yd))) s) + ((<= wz 0) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div wz (fd-dom-max yd)) (fd-int-floor-div wz (fd-dom-min yd))))) + (cond + ((= s1 nil) nil) + (:else + (let + ((xd2 (fd-domain-of s1 (var-name wx)))) + (fd-narrow-or-skip + s1 + (var-name wy) + yd + (fd-int-ceil-div wz (fd-dom-max xd2)) + (fd-int-floor-div wz (fd-dom-min xd2)))))))))))) + +(define + fd-times-prop-nvv + (fn + (wx wy wz s) + (cond + ((<= wx 0) s) + (:else + (let + ((yd (fd-domain-of s (var-name wy))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= yd nil) (= zd nil)) s) + ((not (and (fd-dom-positive? yd) (fd-dom-positive? zd))) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wy) yd (fd-int-ceil-div (fd-dom-min zd) wx) (fd-int-floor-div (fd-dom-max zd) wx)))) + (cond + ((= s1 nil) nil) + (:else + (let + ((yd2 (fd-domain-of s1 (var-name wy)))) + (fd-narrow-or-skip + s1 + (var-name wz) + zd + (* wx (fd-dom-min yd2)) + (* wx (fd-dom-max yd2)))))))))))))) + +(define + fd-times-prop-vnv + (fn + (wx wy wz s) + (cond + ((<= wy 0) s) + (:else + (let + ((xd (fd-domain-of s (var-name wx))) + (zd (fd-domain-of s (var-name wz)))) + (cond + ((or (= xd nil) (= zd nil)) s) + ((not (and (fd-dom-positive? xd) (fd-dom-positive? zd))) s) + (:else + (let + ((s1 (fd-narrow-or-skip s (var-name wx) xd (fd-int-ceil-div (fd-dom-min zd) wy) (fd-int-floor-div (fd-dom-max zd) wy)))) + (cond + ((= s1 nil) nil) + (:else + (let + ((xd2 (fd-domain-of s1 (var-name wx)))) + (fd-narrow-or-skip + s1 + (var-name wz) + zd + (* (fd-dom-min xd2) wy) + (* (fd-dom-max xd2) wy))))))))))))) + (define fd-times-prop (fn @@ -573,6 +821,14 @@ ((= wy 0) (cond ((= wz 0) s) (:else nil))) ((not (= (mod wz wy) 0)) nil) (:else (fd-bind-or-narrow wx (/ wz wy) s)))) + ((and (is-var? wx) (is-var? wy) (number? wz)) + (fd-times-prop-vvn wx wy wz s)) + ((and (number? wx) (is-var? wy) (is-var? wz)) + (fd-times-prop-nvv wx wy wz s)) + ((and (is-var? wx) (number? wy) (is-var? wz)) + (fd-times-prop-vnv wx wy wz s)) + ((and (is-var? wx) (is-var? wy) (is-var? wz)) + (fd-times-prop-vvv wx wy wz s)) (:else s))))) (define diff --git a/lib/minikanren/tests/clpfd-bounds.sx b/lib/minikanren/tests/clpfd-bounds.sx new file mode 100644 index 00000000..32a02f44 --- /dev/null +++ b/lib/minikanren/tests/clpfd-bounds.sx @@ -0,0 +1,316 @@ +;; lib/minikanren/tests/clpfd-bounds.sx — Phase 6 piece B: bounds-consistency +;; for fd-plus and fd-times in the partial- and all-domain cases. +;; +;; We probe domains directly (peek at the FD store) before any labelling +;; happens. This isolates the propagator's narrowing behaviour from the +;; search engine. + +(define + probe-dom + (fn + (goal var-key) + (let + ((s (first (stream-take 1 (goal empty-s))))) + (cond ((= s nil) :no-subst) (:else (fd-domain-of s var-key)))))) + +;; --- fd-plus partial-domain narrowing --- + +(mk-test + "fd-plus-vvn-narrows-x" + (let + ((x (mk-var "x")) (y (mk-var "y"))) + (probe-dom + (mk-conj + (fd-in + x + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10)) + (fd-in y (list 1 2 3)) + (fd-plus x y 10)) + "x")) + (list 7 8 9)) + +(mk-test + "fd-plus-vvn-narrows-y" + (let + ((x (mk-var "x")) (y (mk-var "y"))) + (probe-dom + (mk-conj + (fd-in + x + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10)) + (fd-in y (list 1 2 3)) + (fd-plus x y 10)) + "y")) + (list 1 2 3)) + +(mk-test + "fd-plus-nvv-narrows" + (let + ((y (mk-var "y")) (z (mk-var "z"))) + (probe-dom + (mk-conj + (fd-in y (list 1 2 3)) + (fd-in + z + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20)) + (fd-plus 5 y z)) + "z")) + (list 6 7 8)) + +(mk-test + "fd-plus-vvv-narrows-z" + (let + ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z"))) + (probe-dom + (mk-conj + (fd-in x (list 1 2 3)) + (fd-in y (list 1 2 3)) + (fd-in + z + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20)) + (fd-plus x y z)) + "z")) + (list 2 3 4 5 6)) + +(mk-test + "fd-plus-vvv-narrows-x" + (let + ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z"))) + (probe-dom + (mk-conj + (fd-in + x + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10)) + (fd-in y (list 1 2 3)) + (fd-in z (list 5 6 7)) + (fd-plus x y z)) + "x")) + (list 2 3 4 5 6)) + +;; --- fd-times partial-domain narrowing (positive domains) --- + +(mk-test + "fd-times-vvn-narrows" + (let + ((x (mk-var "x")) (y (mk-var "y"))) + (probe-dom + (mk-conj + (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)) + "x")) + (list 2 3 4 5 6)) + +(mk-test + "fd-times-nvv-narrows" + (let + ((y (mk-var "y")) (z (mk-var "z"))) + (probe-dom + (mk-conj + (fd-in y (list 1 2 3 4)) + (fd-in + z + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20)) + (fd-times 3 y z)) + "z")) + (list + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12)) + +(mk-test + "fd-times-vvv-narrows" + (let + ((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z"))) + (probe-dom + (mk-conj + (fd-in x (list 1 2 3)) + (fd-in y (list 1 2 3)) + (fd-in + z + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 + 14 + 15 + 16 + 17 + 18 + 19 + 20)) + (fd-times x y z)) + "z")) + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9)) + +;; --- bounds force impossible branches to fail early --- + +(mk-test + "fd-plus-impossible-via-bounds" + (let + ((x (mk-var "x")) (y (mk-var "y"))) + (probe-dom + (mk-conj + (fd-in + x + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10)) + (fd-in + y + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10)) + (fd-plus x y 100)) + "x")) + :no-subst) + +(mk-tests-run!) From 2921aa30b43ebea7d9a41394af41970c12c39392 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:06:47 +0000 Subject: [PATCH 80/84] =?UTF-8?q?mk:=20phase=206=20piece=20D=20=E2=80=94?= =?UTF-8?q?=20send-more-money=20+=20Sudoku=204x4?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two CLP(FD) demo puzzles plus an underlying improvement. clpfd.sx: each fd-* posting goal now wraps its post-time propagation in fd-fire-store, so cross-constraint narrowing happens BEFORE labelling. Without this, a chain like fd-eq xyc z-plus-tenc1 followed by fd-plus 2 ten-c1 z-plus-tenc1 wouldn't deduce ten-c1 = 10 until labelling kicked in. Now the deduction happens at goal-construction time. Guard against (c s2) returning nil before fd-fire-store runs. tests/send-more-money.sx: full column-by-column carry encoding (D+E = Y+10*c1; N+R+c1 = E+10*c2; E+O+c2 = N+10*c3; S+M+c3 = O+10*M). Verifies the encoding against the known answer (9 5 6 7 1 0 8 2); the full search labelling 11 vars from {0..9} is too slow for naive labelling order — documented as a known limitation. Real CLP(FD) needs first-fail / failure-driven heuristics for SMM to be fast. tests/sudoku-4x4.sx: 16 cells / 12 distinctness constraints. The empty grid enumerates exactly 288 distinct fillings (the known count for 4x4 Latin squares with 2x2 box constraints). An impossible-clue test (two 1s in row 0) fails immediately. 50/50 sudoku + smm tests, full clpfd suite green at 132/132. --- lib/minikanren/clpfd.sx | 36 ++++++--- lib/minikanren/tests/send-more-money.sx | 97 +++++++++++++++++++++++++ lib/minikanren/tests/sudoku-4x4.sx | 89 +++++++++++++++++++++++ 3 files changed, 210 insertions(+), 12 deletions(-) create mode 100644 lib/minikanren/tests/send-more-money.sx create mode 100644 lib/minikanren/tests/sudoku-4x4.sx diff --git a/lib/minikanren/clpfd.sx b/lib/minikanren/clpfd.sx index 46fd4fff..fb2851a8 100644 --- a/lib/minikanren/clpfd.sx +++ b/lib/minikanren/clpfd.sx @@ -230,8 +230,10 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) ;; --- fd-lt --- @@ -294,8 +296,10 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) ;; --- fd-lte --- @@ -358,8 +362,10 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) ;; --- fd-eq --- @@ -428,8 +434,10 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) ;; --- labelling --- @@ -667,8 +675,10 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) ;; --- fd-times (x * y = z, ground-cases propagator) --- @@ -842,5 +852,7 @@ (let ((s2 (fd-add-constraint s c))) (let - ((s3 (c s2))) - (cond ((= s3 nil) mzero) (:else (unit s3))))))))) + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) diff --git a/lib/minikanren/tests/send-more-money.sx b/lib/minikanren/tests/send-more-money.sx new file mode 100644 index 00000000..9fd81cf9 --- /dev/null +++ b/lib/minikanren/tests/send-more-money.sx @@ -0,0 +1,97 @@ +;; lib/minikanren/tests/send-more-money.sx — classic cryptarithmetic +;; +;; S E N D +;; + M O R E +;; --------- +;; M O N E Y +;; +;; Column-by-column encoding with carries c1, c2, c3, and the +;; leftmost column produces a carry which equals M (the result is 5 digits). +;; All 8 letters distinct; S ≠ 0, M ≠ 0. +;; Unique solution: S=9, E=5, N=6, D=7, M=1, O=0, R=8, Y=2. +;; +;; Note: the full search labelling 11 variables from {0..9} is too slow +;; for naive labelling order (10^11 combinations naively, even with +;; bounds-consistency the branching factor dominates). Real CLP(FD) +;; systems use first-fail heuristics. Here we only verify the encoding +;; against the known answer. + +(define + digits-0-9 + (list + 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9)) +(define + digits-1-9 + (list + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9)) + +(define + smm-col-with-carry + (fn + (x y carry-in z carry-out) + (fresh + (xy xyc ten-cout z-plus-ten-cout) + (fd-plus x y xy) + (fd-plus xy carry-in xyc) + (fd-times 10 carry-out ten-cout) + (fd-plus z ten-cout z-plus-ten-cout) + (fd-eq xyc z-plus-ten-cout)))) + +(define + send-more-money + (fn + (S E N D M O R Y) + (fresh + (c1 c2 c3) + (mk-conj + (fd-in S digits-1-9) + (fd-in M digits-1-9) + (fd-in E digits-0-9) + (fd-in N digits-0-9) + (fd-in D digits-0-9) + (fd-in O digits-0-9) + (fd-in R digits-0-9) + (fd-in Y digits-0-9) + (fd-in c1 (list 0 1)) + (fd-in c2 (list 0 1)) + (fd-in c3 (list 0 1)) + (fd-distinct (list S E N D M O R Y)) + (smm-col-with-carry D E 0 Y c1) + (smm-col-with-carry N R c1 E c2) + (smm-col-with-carry E O c2 N c3) + (smm-col-with-carry S M c3 O M) + (fd-label (list S E N D M O R Y c1 c2 c3)))))) + +(mk-test + "send-more-money-verify-known-solution" + (run* + q + (send-more-money + 9 + 5 + 6 + 7 + 1 + 0 + 8 + 2)) + (list (make-symbol "_.0"))) + +(mk-tests-run!) diff --git a/lib/minikanren/tests/sudoku-4x4.sx b/lib/minikanren/tests/sudoku-4x4.sx new file mode 100644 index 00000000..771e0fc7 --- /dev/null +++ b/lib/minikanren/tests/sudoku-4x4.sx @@ -0,0 +1,89 @@ +;; lib/minikanren/tests/sudoku-4x4.sx — Sudoku 4×4 via CLP(FD). +;; +;; Grid in row-major order: +;; +;; c0 c1 | c2 c3 +;; c4 c5 | c6 c7 +;; ------+------ +;; c8 c9 | cA cB +;; cC cD | cE cF +;; +;; Each cell ∈ {1, 2, 3, 4}. 4 rows + 4 cols + 4 2x2 boxes are each a +;; distinct permutation. + +(define digits-1-4 (list 1 2 3 4)) + +(define + sudoku-4x4 + (fn + (cells) + (let + ((c0 (nth cells 0)) + (c1 (nth cells 1)) + (c2 (nth cells 2)) + (c3 (nth cells 3)) + (c4 (nth cells 4)) + (c5 (nth cells 5)) + (c6 (nth cells 6)) + (c7 (nth cells 7)) + (c8 (nth cells 8)) + (c9 (nth cells 9)) + (cA (nth cells 10)) + (cB (nth cells 11)) + (cC (nth cells 12)) + (cD (nth cells 13)) + (cE (nth cells 14)) + (cF (nth cells 15))) + (mk-conj + (fd-in c0 digits-1-4) + (fd-in c1 digits-1-4) + (fd-in c2 digits-1-4) + (fd-in c3 digits-1-4) + (fd-in c4 digits-1-4) + (fd-in c5 digits-1-4) + (fd-in c6 digits-1-4) + (fd-in c7 digits-1-4) + (fd-in c8 digits-1-4) + (fd-in c9 digits-1-4) + (fd-in cA digits-1-4) + (fd-in cB digits-1-4) + (fd-in cC digits-1-4) + (fd-in cD digits-1-4) + (fd-in cE digits-1-4) + (fd-in cF digits-1-4) + (fd-distinct (list c0 c1 c2 c3)) + (fd-distinct (list c4 c5 c6 c7)) + (fd-distinct (list c8 c9 cA cB)) + (fd-distinct (list cC cD cE cF)) + (fd-distinct (list c0 c4 c8 cC)) + (fd-distinct (list c1 c5 c9 cD)) + (fd-distinct (list c2 c6 cA cE)) + (fd-distinct (list c3 c7 cB cF)) + (fd-distinct (list c0 c1 c4 c5)) + (fd-distinct (list c2 c3 c6 c7)) + (fd-distinct (list c8 c9 cC cD)) + (fd-distinct (list cA cB cE cF)) + (fd-label cells))))) + +;; --- Tests --- + +(mk-test + "sudoku-4x4-empty-grid-count" + (let + ((sols (run* q (fresh (c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF) (== q (list c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF)) (sudoku-4x4 (list c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF)))))) + (len sols)) + 288) + +(mk-test + "sudoku-4x4-impossible-clue-empty" + (run* + q + (fresh + (c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF) + (== c0 1) + (== c1 1) + (== q (list c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF)) + (sudoku-4x4 (list c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 cA cB cC cD cE cF)))) + (list)) + +(mk-tests-run!) From 0cb0c1b7827890b754d621cd4ecfa520618110e4 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:08:44 +0000 Subject: [PATCH 81/84] =?UTF-8?q?mk:=20phase=205=20polish=20=E2=80=94=20?= =?UTF-8?q?=3D/=3D=20disequality=20with=20constraint=20store?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (=/= u v) posts a closure to the same _fd constraint store the CLP(FD) goals use; the closure is fd-fire-store-driven, so it re-checks after every binding. Semantics: - mk-unify u v s; nil result -> distinct, drop the constraint. - unify succeeded with no new bindings (key-count unchanged) -> equal, fail. - otherwise -> partially unifiable, keep the constraint. ==-cs is the constraint-aware drop-in for == that fires fd-fire-store after the binding; plain == doesn't reactivate the store, so a binding that should violate a pending =/= would go undetected. Use ==-cs whenever a program mixes =/= (or fd-* goals re-checked after non-FD bindings) with regular unification. 12 new tests covering ground/structural/late-binding cases; 60/60 clpfd-and-diseq tests pass. --- lib/minikanren/diseq.sx | 71 ++++++++++++++++++++++++++++++ lib/minikanren/tests/diseq.sx | 83 +++++++++++++++++++++++++++++++++++ 2 files changed, 154 insertions(+) create mode 100644 lib/minikanren/diseq.sx create mode 100644 lib/minikanren/tests/diseq.sx diff --git a/lib/minikanren/diseq.sx b/lib/minikanren/diseq.sx new file mode 100644 index 00000000..1567287e --- /dev/null +++ b/lib/minikanren/diseq.sx @@ -0,0 +1,71 @@ +;; lib/minikanren/diseq.sx — Phase 5 polish: =/= disequality with a +;; constraint store, generalising nafc / fd-neq to logic terms. +;; +;; The constraint store lives under the same `_fd` reserved key as the +;; CLP(FD) propagators (a disequality is just another constraint +;; closure that the existing fd-fire-store machinery re-runs). +;; +;; =/= semantics: +;; - If u and v walk to ground non-unifiable terms, succeed (drop). +;; - If they walk to terms that COULD become equal under a future +;; binding, store the constraint; re-check after each binding. +;; - If they're already equal (unify with no new bindings), fail. +;; +;; Implementation: each =/= test attempts (mk-unify wu wv s). +;; nil — distinct, keep s, drop the constraint (return s). +;; subst eq — equal, fail (return nil). +;; subst > — partially unifiable; keep the constraint, return s. +;; +;; "Substitution equal to s" is detected via key-count: mk-unify only +;; ever extends a substitution, never removes from it, so equal +;; key-count means no new bindings were needed. + +(define + =/=-prop + (fn + (u v s) + (let + ((s-after (mk-unify u v s))) + (cond + ((= s-after nil) s) + ((= (len (keys s)) (len (keys s-after))) nil) + (:else s))))) + +(define + =/= + (fn + (u v) + (fn + (s) + (let + ((c (fn (sp) (=/=-prop u v sp)))) + (let + ((s2 (fd-add-constraint s c))) + (let + ((s2-or-nil (c s2))) + (let + ((s3 (cond ((= s2-or-nil nil) nil) (:else (fd-fire-store s2-or-nil))))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) + +;; --- constraint-aware == --- +;; +;; Plain `==` doesn't fire the constraint store, so a binding that +;; should violate a pending =/= goes undetected. `==-cs` is the +;; drop-in replacement that fires fd-fire-store after each binding. +;; Use ==-cs in any program that mixes =/= (or fd-* goals that should +;; re-check after non-FD bindings) with regular unification. + +(define + ==-cs + (fn + (u v) + (fn + (s) + (let + ((s2 (mk-unify u v s))) + (cond + ((= s2 nil) mzero) + (:else + (let + ((s3 (fd-fire-store s2))) + (cond ((= s3 nil) mzero) (:else (unit s3)))))))))) diff --git a/lib/minikanren/tests/diseq.sx b/lib/minikanren/tests/diseq.sx new file mode 100644 index 00000000..e88fc5bc --- /dev/null +++ b/lib/minikanren/tests/diseq.sx @@ -0,0 +1,83 @@ +;; lib/minikanren/tests/diseq.sx — Phase 5 polish: =/= disequality. + +;; --- ground cases --- + +(mk-test + "=/=-ground-distinct" + (run* q (=/= 1 2)) + (list (make-symbol "_.0"))) +(mk-test "=/=-ground-equal" (run* q (=/= 1 1)) (list)) +(mk-test + "=/=-ground-strings" + (run* q (=/= "a" "b")) + (list (make-symbol "_.0"))) +(mk-test "=/=-ground-strings-eq" (run* q (=/= "a" "a")) (list)) + +;; --- structural --- + +(mk-test + "=/=-pair-distinct" + (run* q (=/= (list 1 2) (list 1 3))) + (list (make-symbol "_.0"))) +(mk-test + "=/=-pair-equal" + (run* q (=/= (list 1 2) (list 1 2))) + (list)) +(mk-test + "=/=-pair-vs-atom" + (run* q (=/= (list 1) 1)) + (list (make-symbol "_.0"))) + +;; --- partial / late binding --- +;; +;; ==-cs is required to wake up the constraint store after a binding; +;; plain == doesn't fire constraints. + +(mk-test + "=/=-late-bind-violates" + (run* q (fresh (x) (=/= x 5) (==-cs x 5) (== q x))) + (list)) + +(mk-test + "=/=-late-bind-ok" + (run* q (fresh (x) (=/= x 5) (==-cs x 7) (== q x))) + (list 7)) + +(mk-test + "=/=-two-vars-equal-late-fails" + (run* + q + (fresh + (x y) + (=/= x y) + (==-cs x 1) + (==-cs y 1) + (== q (list x y)))) + (list)) + +(mk-test + "=/=-two-vars-distinct-late" + (run* + q + (fresh + (x y) + (=/= x y) + (==-cs x 1) + (==-cs y 2) + (== q (list x y)))) + (list (list 1 2))) + +;; --- compose with conde / fresh --- + +(mk-test + "=/=-with-membero-filter" + (run* + q + (fresh + (x) + (membero x (list 1 2 3)) + (=/= x 2) + (== q x))) + (list 1 3)) + +(mk-tests-run!) From 1d7400a54aa02d027c08c4fb974f2ef45b4cc8a8 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:10:43 +0000 Subject: [PATCH 82/84] =?UTF-8?q?mk:=20phase=207=20piece=20A=20=E2=80=94?= =?UTF-8?q?=20SLG-style=20tabling=20with=20in-progress=20sentinel?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Solves the canonical cyclic-graph divergence problem from the deferred plan. Naive memoization (table-1/2/3 in tabling.sx) drains the body's answer stream eagerly; cyclic recursive calls with the same ground key diverge before populating the cache. table-2-slg / table-3-slg add an in-progress sentinel: before evaluating the body, mark the cache entry :in-progress. Any recursive call to the same key sees the sentinel and returns mzero (no answers yet). Outer recursion thus terminates on cycles. After the body finishes, the sentinel is replaced with the actual answer-value list. Demo: tab-patho with a 3-edge graph (a -> b, b -> a, b -> c). (run* q (tab-patho :a :c q)) -> ((:a :b :c)) ; finite (run* q (tab-patho :a :a q)) -> ((:a :b :a)) ; one cycle visit (run* q (tab-patho :a :b q)) -> ((:a :b)) ; direct edge Without SLG, all three diverge. Limitation: single-pass — answers found by cycle-dependent recursive calls are not iteratively re-discovered. Full SLG with fixed-point iteration (re-running until no new answers) is left for follow-up. 5 new tests including SLG-fib for sanity (matches naive table-2), 3 cyclic patho cases. --- lib/minikanren/tabling-slg.sx | 78 +++++++++++++++++++++++++++++ lib/minikanren/tests/tabling-slg.sx | 56 +++++++++++++++++++++ 2 files changed, 134 insertions(+) create mode 100644 lib/minikanren/tabling-slg.sx create mode 100644 lib/minikanren/tests/tabling-slg.sx diff --git a/lib/minikanren/tabling-slg.sx b/lib/minikanren/tabling-slg.sx new file mode 100644 index 00000000..ed2550c9 --- /dev/null +++ b/lib/minikanren/tabling-slg.sx @@ -0,0 +1,78 @@ +;; lib/minikanren/tabling-slg.sx — Phase 7 piece A: SLG-style tabling. +;; +;; Naive memoization (table-1/2/3 in tabling.sx) drains the body's +;; answer stream eagerly, then caches. Recursive tabled calls with the +;; SAME ground key see an empty cache (the in-progress entry doesn't +;; exist), so they recurse and the host overflows on cyclic relations. +;; +;; This module ships the in-progress-sentinel piece of SLG resolution: +;; before evaluating the body, mark the cache entry as :in-progress; +;; any recursive call to the same key sees the sentinel and returns +;; mzero (no answers yet). Outer recursion thus terminates on cycles. +;; Limitation: a single pass — answers found by cycle-dependent +;; recursive calls are NOT discovered. Full SLG with fixed-point +;; iteration (re-running until no new answers) is left for follow-up. + +(define + table-2-slg + (fn + (name rel-fn) + (fn + (input output) + (fn + (s) + (let + ((winput (mk-walk* input s))) + (cond + ((mk-tab-ground-term? winput) + (let + ((key (str name "/slg/" winput))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :in-progress) mzero) + ((not (= cached :miss)) + (mk-tab-replay-vals cached output s)) + (:else + (begin + (mk-tab-store! key :in-progress) + (let + ((all-substs (stream-take -1 ((rel-fn input output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s)))))))))) + (:else ((rel-fn input output) s)))))))) + +(define + table-3-slg + (fn + (name rel-fn) + (fn + (i1 i2 output) + (fn + (s) + (let + ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s))) + (cond + ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2)) + (let + ((key (str name "/slg3/" wi1 "/" wi2))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :in-progress) mzero) + ((not (= cached :miss)) + (mk-tab-replay-vals cached output s)) + (:else + (begin + (mk-tab-store! key :in-progress) + (let + ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s)))))))))) + (:else ((rel-fn i1 i2 output) s)))))))) diff --git a/lib/minikanren/tests/tabling-slg.sx b/lib/minikanren/tests/tabling-slg.sx new file mode 100644 index 00000000..e4409390 --- /dev/null +++ b/lib/minikanren/tests/tabling-slg.sx @@ -0,0 +1,56 @@ +;; lib/minikanren/tests/tabling-slg.sx — Phase 7 piece A: SLG-style tabling. + +;; --- table-2-slg with Fibonacci (sanity: same answer as naive table-2) --- + +(mk-tab-clear!) +(define + slg-fib-o + (table-2-slg + "slg-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) (slg-fib-o n-1 r-1) (slg-fib-o n-2 r-2) (pluso-i r-1 r-2 result))))))) + +(mk-tab-clear!) +(mk-test "slg-fib-five" (run* q (slg-fib-o 5 q)) (list 5)) +(mk-tab-clear!) +(mk-test "slg-fib-ten" (run* q (slg-fib-o 10 q)) (list 55)) + +;; --- table-3-slg with cyclic-graph patho --- + +(define slg-cyc-edges (list (list :a :b) (list :b :a) (list :b :c))) +(define slg-cyc-edgeo (fn (x y) (membero (list x y) slg-cyc-edges))) + +(mk-tab-clear!) +(define + tab-patho + (table-3-slg + "patho" + (fn + (x y path) + (conde + ((slg-cyc-edgeo x y) (== path (list x y))) + ((fresh (z mid) (slg-cyc-edgeo x z) (tab-patho z y mid) (conso x mid path))))))) + +(mk-tab-clear!) +(mk-test + "slg-cyclic-direct" + (run* q (tab-patho :a :b q)) + (list (list :a :b))) + +(mk-tab-clear!) +(mk-test + "slg-cyclic-multi-hop" + (run* q (tab-patho :a :c q)) + (list (list :a :b :c))) + +(mk-tab-clear!) +(mk-test + "slg-cyclic-self-loop-finite" + (run* q (tab-patho :a :a q)) + (list (list :a :b :a))) + +(mk-tests-run!) From 28bd8bb98cec31b1c7b37d3988fa254a8ee924ce Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:12:36 +0000 Subject: [PATCH 83/84] =?UTF-8?q?mk:=20phase=207=20piece=20A=20=E2=80=94?= =?UTF-8?q?=20fixed-point=20iteration=20in=20SLG=20tabling?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace the single-pass body run with table-2-slg-iter / table-3-slg-iter: each iteration stores the current vals in cache and re-runs the body; loop until vals length stops growing. The cache thus grows monotonically until no new answers appear. For simple cycles (single tabled relation) this is sound and terminating — len comparison is O(1) and the cache only grows. Limitation: mutually-recursive tabled relations have INDEPENDENT iteration loops. Each runs to its own fixed point in isolation; the two don't coordinate. True SLG uses a worklist that cross-fires re-iteration when any subgoal's cache grows. Left as a future refinement. All 5 SLG tests still pass (Fibonacci unchanged, 3 cyclic-patho cases unchanged). --- lib/minikanren/tabling-slg.sx | 56 ++++++++++++++++++++++------------- 1 file changed, 36 insertions(+), 20 deletions(-) diff --git a/lib/minikanren/tabling-slg.sx b/lib/minikanren/tabling-slg.sx index ed2550c9..c952e3ce 100644 --- a/lib/minikanren/tabling-slg.sx +++ b/lib/minikanren/tabling-slg.sx @@ -13,6 +13,23 @@ ;; recursive calls are NOT discovered. Full SLG with fixed-point ;; iteration (re-running until no new answers) is left for follow-up. +(define + table-2-slg-iter + (fn + (rel-fn input output s key prev-vals) + (begin + (mk-tab-store! key prev-vals) + (let + ((all-substs (stream-take -1 ((rel-fn input output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (cond + ((= (len vals) (len prev-vals)) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s))) + (:else (table-2-slg-iter rel-fn input output s key vals)))))))) + (define table-2-slg (fn @@ -30,21 +47,29 @@ (let ((cached (mk-tab-lookup key))) (cond - ((= cached :in-progress) mzero) ((not (= cached :miss)) (mk-tab-replay-vals cached output s)) (:else - (begin - (mk-tab-store! key :in-progress) - (let - ((all-substs (stream-take -1 ((rel-fn input output) s)))) - (let - ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) - (begin - (mk-tab-store! key vals) - (mk-tab-replay-vals vals output s)))))))))) + (table-2-slg-iter rel-fn input output s key (list))))))) (:else ((rel-fn input output) s)))))))) +(define + table-3-slg-iter + (fn + (rel-fn i1 i2 output s key prev-vals) + (begin + (mk-tab-store! key prev-vals) + (let + ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (cond + ((= (len vals) (len prev-vals)) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s))) + (:else (table-3-slg-iter rel-fn i1 i2 output s key vals)))))))) + (define table-3-slg (fn @@ -62,17 +87,8 @@ (let ((cached (mk-tab-lookup key))) (cond - ((= cached :in-progress) mzero) ((not (= cached :miss)) (mk-tab-replay-vals cached output s)) (:else - (begin - (mk-tab-store! key :in-progress) - (let - ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s)))) - (let - ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) - (begin - (mk-tab-store! key vals) - (mk-tab-replay-vals vals output s)))))))))) + (table-3-slg-iter rel-fn i1 i2 output s key (list))))))) (:else ((rel-fn i1 i2 output) s)))))))) From 96f5809a29d9aff408ccfbd03ed4c72fe7410c30 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:20:28 +0000 Subject: [PATCH 84/84] =?UTF-8?q?GUEST-plan:=20deferred=20work=20shipped?= =?UTF-8?q?=20=E2=80=94=20pieces=20A=20B=20C=20D?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- plans/minikanren-on-sx.md | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 16816005..8cc0f953 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -205,6 +205,23 @@ _(none yet)_ _Newest first._ +- **2026-05-09** — **deferred-plan execution**: shipped all four pieces from + `plans/minikanren-deferred.md` (on architecture): + - **Piece B** — bounds-consistency for `fd-plus` / `fd-times` (vvn / nvv / + vnv / vvv branches; integer-division helpers for ceil/floor); + - **Piece D** — send-more-money (column-with-carry encoding, verified + against the known answer) and Sudoku 4×4 (288 fillings of empty grid; + immediate failure on contradictory clues); + - **Piece C** — `=/=` disequality with constraint store, plus `==-cs` + constraint-aware unify so the store re-fires on bindings; + - **Piece A** — SLG-style tabling: in-progress sentinel + fixed-point + iteration. Cyclic patho terminates: `(tab-patho :a :c q)` on a graph + with cycle `a↔b` plus `b→c` returns `((:a :b :c))`. Naive tabling + diverged on the same query. Mutually-recursive coordination across + independent tabled relations is left for follow-up (proper SLG + worklist). + 170/170 across the new+FD-related test files. + - **2026-05-08** — **Session snapshot**: 17 lib files, 61 test files, 1229 library LOC + 4360 test LOC, **551/551 tests cumulative**. Library covers Phases 1–5 fully, Phase 6 partial (FD helpers + intarith escape), Phase 7