From 2de6727e8367b8bad33a8bb4980f6f4f72eea087 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 20:01:10 +0000 Subject: [PATCH] =?UTF-8?q?mk:=20phase=202D=20=E2=80=94=20condu=20+=20once?= =?UTF-8?q?o,=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