mk: phase 7 piece A — SLG-style tabling with in-progress sentinel
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s

Solves the canonical cyclic-graph divergence problem from the deferred
plan. Naive memoization (table-1/2/3 in tabling.sx) drains the body's
answer stream eagerly; cyclic recursive calls with the same ground key
diverge before populating the cache.

table-2-slg / table-3-slg add an in-progress sentinel: before
evaluating the body, mark the cache entry :in-progress. Any recursive
call to the same key sees the sentinel and returns mzero (no answers
yet). Outer recursion thus terminates on cycles. After the body
finishes, the sentinel is replaced with the actual answer-value list.

Demo: tab-patho with a 3-edge graph (a -> b, b -> a, b -> c).
  (run* q (tab-patho :a :c q))   -> ((:a :b :c))   ; finite
  (run* q (tab-patho :a :a q))   -> ((:a :b :a))   ; one cycle visit
  (run* q (tab-patho :a :b q))   -> ((:a :b))      ; direct edge

Without SLG, all three diverge.

Limitation: single-pass — answers found by cycle-dependent recursive
calls are not iteratively re-discovered. Full SLG with fixed-point
iteration (re-running until no new answers) is left for follow-up.

5 new tests including SLG-fib for sanity (matches naive table-2),
3 cyclic patho cases.
This commit is contained in:
2026-05-09 14:10:43 +00:00
parent 0cb0c1b782
commit 1d7400a54a
2 changed files with 134 additions and 0 deletions

View File

@@ -0,0 +1,56 @@
;; lib/minikanren/tests/tabling-slg.sx — Phase 7 piece A: SLG-style tabling.
;; --- table-2-slg with Fibonacci (sanity: same answer as naive table-2) ---
(mk-tab-clear!)
(define
slg-fib-o
(table-2-slg
"slg-fib"
(fn
(n result)
(conde
((== n 0) (== result 0))
((== n 1) (== result 1))
((fresh (n-1 n-2 r-1 r-2) (lto-i 1 n) (minuso-i n 1 n-1) (minuso-i n 2 n-2) (slg-fib-o n-1 r-1) (slg-fib-o n-2 r-2) (pluso-i r-1 r-2 result)))))))
(mk-tab-clear!)
(mk-test "slg-fib-five" (run* q (slg-fib-o 5 q)) (list 5))
(mk-tab-clear!)
(mk-test "slg-fib-ten" (run* q (slg-fib-o 10 q)) (list 55))
;; --- table-3-slg with cyclic-graph patho ---
(define slg-cyc-edges (list (list :a :b) (list :b :a) (list :b :c)))
(define slg-cyc-edgeo (fn (x y) (membero (list x y) slg-cyc-edges)))
(mk-tab-clear!)
(define
tab-patho
(table-3-slg
"patho"
(fn
(x y path)
(conde
((slg-cyc-edgeo x y) (== path (list x y)))
((fresh (z mid) (slg-cyc-edgeo x z) (tab-patho z y mid) (conso x mid path)))))))
(mk-tab-clear!)
(mk-test
"slg-cyclic-direct"
(run* q (tab-patho :a :b q))
(list (list :a :b)))
(mk-tab-clear!)
(mk-test
"slg-cyclic-multi-hop"
(run* q (tab-patho :a :c q))
(list (list :a :b :c)))
(mk-tab-clear!)
(mk-test
"slg-cyclic-self-loop-finite"
(run* q (tab-patho :a :a q))
(list (list :a :b :a)))
(mk-tests-run!)