From f13e03e6251a7ae22d955ecf527271a8fa0f6ea6 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 7 May 2026 19:45:47 +0000 Subject: [PATCH] =?UTF-8?q?mk:=20phase=201=20=E2=80=94=20unify.sx=20+=2048?= =?UTF-8?q?=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.