diff --git a/lib/minikanren/relations.sx b/lib/minikanren/relations.sx index 768dff92..1fcddd6d 100644 --- a/lib/minikanren/relations.sx +++ b/lib/minikanren/relations.sx @@ -96,3 +96,31 @@ (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)))))) diff --git a/lib/minikanren/tests/list-relations.sx b/lib/minikanren/tests/list-relations.sx new file mode 100644 index 00000000..9c36ff8e --- /dev/null +++ b/lib/minikanren/tests/list-relations.sx @@ -0,0 +1,89 @@ +;; lib/minikanren/tests/list-relations.sx — rembero, assoco, nth-o. + +;; --- rembero (remove first occurrence) --- + +(mk-test + "rembero-element-present" + (run* + q + (rembero 2 (list 1 2 3 2) q)) + (list (list 1 3 2))) + +(mk-test + "rembero-element-not-present" + (run* q (rembero 99 (list 1 2 3) q)) + (list (list 1 2 3))) + +(mk-test + "rembero-empty" + (run* q (rembero 1 (list) q)) + (list (list))) + +(mk-test + "rembero-only-element" + (run* q (rembero 5 (list 5) q)) + (list (list))) + +(mk-test + "rembero-first-of-many" + (run* + q + (rembero 1 (list 1 2 3 4) q)) + (list (list 2 3 4))) + +;; --- assoco (alist lookup) --- + +(define + test-pairs + (list + (list "alice" 30) + (list "bob" 25) + (list "carol" 35))) + +(mk-test + "assoco-found" + (run* q (assoco "bob" test-pairs q)) + (list 25)) + +(mk-test + "assoco-first" + (run* q (assoco "alice" test-pairs q)) + (list 30)) + +(mk-test "assoco-missing" (run* q (assoco "dave" test-pairs q)) (list)) + +(mk-test + "assoco-find-keys-with-value" + (run* q (assoco q test-pairs 25)) + (list "bob")) + +;; --- nth-o (Peano-indexed access) --- + +(mk-test + "nth-o-zero" + (run* q (nth-o :z (list 10 20 30) q)) + (list 10)) + +(mk-test + "nth-o-one" + (run* q (nth-o (list :s :z) (list 10 20 30) q)) + (list 20)) + +(mk-test + "nth-o-two" + (run* + q + (nth-o (list :s (list :s :z)) (list 10 20 30) q)) + (list 30)) + +(mk-test + "nth-o-out-of-range" + (run* + q + (nth-o + (list :s (list :s (list :s :z))) + (list 10 20 30) + q)) + (list)) + +(mk-tests-run!) diff --git a/plans/minikanren-on-sx.md b/plans/minikanren-on-sx.md index 1b71ac0f..117f88b7 100644 --- a/plans/minikanren-on-sx.md +++ b/plans/minikanren-on-sx.md @@ -173,6 +173,11 @@ _(none yet)_ _Newest first._ +- **2026-05-08** — **rembero / assoco / nth-o**: more standard list relations. + rembero removes the first occurrence (uses `nafc (== a x)` to gate the + skip clause, so it's well-defined on ground lists). assoco is alist + lookup — works forward (key → value) and backward (value → key). nth-o + uses Peano indices into a list. 13 new tests, 266/266 cumulative. - **2026-05-08** — **flatteno**: nested-list flattener via conde + appendo. Atom-ness is detected via `nafc (nullo ...) + nafc (pairo ...)` so the third clause only fires when the input is a ground non-list. Works for