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