Files
rose-ash/lib/minikanren/matche.sx
giles 57a84b372d
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Merge loops/minikanren into architecture: full miniKanren-on-SX library
Squash merge of 76 commits from loops/minikanren. Adds lib/minikanren/
— a complete miniKanren-on-SX implementation built on top of
lib/guest/match.sx, validating the lib-guest unify-and-match kit as
intended.

Modules (20 .sx files, ~1700 LOC):
  unify, stream, goals, fresh, conde, condu, conda, run, relations,
  peano, intarith, project, nafc, matche, fd, queens, defrel, clpfd,
  tabling

Phases 1–5 fully done (core miniKanren API, all classic relations,
matche, conda, project, nafc).

Phase 6 — native CLP(FD): domain primitives, fd-in / fd-eq / fd-neq /
fd-lt / fd-lte / fd-plus / fd-times / fd-distinct / fd-label, with
constraint reactivation iterating to fixed point. N-queens via FD:
4-queens 2 solutions, 5-queens 10 solutions (vs naive timeout past N=4).

Phase 7 — naive ground-arg tabling: table-1 / table-2 / table-3.
Fibonacci canary: tab-fib(25) = 75025 in seconds, naive fib(25) times
out at 60s. Ackermann via table-3: A(3,3) = 61.

71 test files, 644+ tests passing across the suite. Producer/consumer
SLG (cyclic patho, mutual recursion) deferred — research-grade work.

The lib-guest validation experiment is conclusive: lib/minikanren/
unify.sx adds ~50 lines of local logic (custom cfg, deep walk*, fresh
counter) over lib/guest/match.sx's ~100-line kit. The kit earns its
keep ~3× by line count.
2026-05-08 23:01:54 +00:00

77 lines
2.4 KiB
Plaintext

;; lib/minikanren/matche.sx — Phase 5 piece D: pattern matching over terms.
;;
;; (matche TARGET
;; (PATTERN1 g1 g2 ...)
;; (PATTERN2 g1 ...)
;; ...)
;;
;; Pattern grammar:
;; _ wildcard — fresh anonymous var
;; x plain symbol — fresh var, bind by name
;; 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-in-pat) (== target pat-expr) body...))`.
;;
;; 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 — 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-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-collect-vars
(fn (pat) (matche-collect-vars-acc pat (list))))
(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)))
((keyword? pat) 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)))