Files
rose-ash/lib/minikanren/relations.sx
giles e7dca2675c
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
mk: everyo / someo — predicate-style relations
(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.
2026-05-08 11:13:22 +00:00

159 lines
3.5 KiB
Plaintext

;; 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))))))
(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))))))
(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))))))
(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))))))
(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))))))
(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))))))
(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))))))
(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))))))