From 1d7400a54aa02d027c08c4fb974f2ef45b4cc8a8 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 9 May 2026 14:10:43 +0000 Subject: [PATCH] =?UTF-8?q?mk:=20phase=207=20piece=20A=20=E2=80=94=20SLG-s?= =?UTF-8?q?tyle=20tabling=20with=20in-progress=20sentinel?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- lib/minikanren/tabling-slg.sx | 78 +++++++++++++++++++++++++++++ lib/minikanren/tests/tabling-slg.sx | 56 +++++++++++++++++++++ 2 files changed, 134 insertions(+) create mode 100644 lib/minikanren/tabling-slg.sx create mode 100644 lib/minikanren/tests/tabling-slg.sx diff --git a/lib/minikanren/tabling-slg.sx b/lib/minikanren/tabling-slg.sx new file mode 100644 index 00000000..ed2550c9 --- /dev/null +++ b/lib/minikanren/tabling-slg.sx @@ -0,0 +1,78 @@ +;; lib/minikanren/tabling-slg.sx — Phase 7 piece A: SLG-style tabling. +;; +;; Naive memoization (table-1/2/3 in tabling.sx) drains the body's +;; answer stream eagerly, then caches. Recursive tabled calls with the +;; SAME ground key see an empty cache (the in-progress entry doesn't +;; exist), so they recurse and the host overflows on cyclic relations. +;; +;; This module ships the in-progress-sentinel piece of SLG resolution: +;; before evaluating the body, mark the cache entry as :in-progress; +;; any recursive call to the same key sees the sentinel and returns +;; mzero (no answers yet). Outer recursion thus terminates on cycles. +;; Limitation: a single pass — answers found by cycle-dependent +;; recursive calls are NOT discovered. Full SLG with fixed-point +;; iteration (re-running until no new answers) is left for follow-up. + +(define + table-2-slg + (fn + (name rel-fn) + (fn + (input output) + (fn + (s) + (let + ((winput (mk-walk* input s))) + (cond + ((mk-tab-ground-term? winput) + (let + ((key (str name "/slg/" winput))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :in-progress) mzero) + ((not (= cached :miss)) + (mk-tab-replay-vals cached output s)) + (:else + (begin + (mk-tab-store! key :in-progress) + (let + ((all-substs (stream-take -1 ((rel-fn input output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s)))))))))) + (:else ((rel-fn input output) s)))))))) + +(define + table-3-slg + (fn + (name rel-fn) + (fn + (i1 i2 output) + (fn + (s) + (let + ((wi1 (mk-walk* i1 s)) (wi2 (mk-walk* i2 s))) + (cond + ((and (mk-tab-ground-term? wi1) (mk-tab-ground-term? wi2)) + (let + ((key (str name "/slg3/" wi1 "/" wi2))) + (let + ((cached (mk-tab-lookup key))) + (cond + ((= cached :in-progress) mzero) + ((not (= cached :miss)) + (mk-tab-replay-vals cached output s)) + (:else + (begin + (mk-tab-store! key :in-progress) + (let + ((all-substs (stream-take -1 ((rel-fn i1 i2 output) s)))) + (let + ((vals (map (fn (s2) (mk-walk* output s2)) all-substs))) + (begin + (mk-tab-store! key vals) + (mk-tab-replay-vals vals output s)))))))))) + (:else ((rel-fn i1 i2 output) s)))))))) diff --git a/lib/minikanren/tests/tabling-slg.sx b/lib/minikanren/tests/tabling-slg.sx new file mode 100644 index 00000000..e4409390 --- /dev/null +++ b/lib/minikanren/tests/tabling-slg.sx @@ -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!)