giles
28bd8bb98c
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Replace the single-pass body run with table-2-slg-iter / table-3-slg-iter: each iteration stores the current vals in cache and re-runs the body; loop until vals length stops growing. The cache thus grows monotonically until no new answers appear. For simple cycles (single tabled relation) this is sound and terminating — len comparison is O(1) and the cache only grows. Limitation: mutually-recursive tabled relations have INDEPENDENT iteration loops. Each runs to its own fixed point in isolation; the two don't coordinate. True SLG uses a worklist that cross-fires re-iteration when any subgoal's cache grows. Left as a future refinement. All 5 SLG tests still pass (Fibonacci unchanged, 3 cyclic-patho cases unchanged).
95 lines
3.1 KiB
Plaintext
95 lines
3.1 KiB
Plaintext
;; 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-iter
|
|
(fn
|
|
(rel-fn input output s key prev-vals)
|
|
(begin
|
|
(mk-tab-store! key prev-vals)
|
|
(let
|
|
((all-substs (stream-take -1 ((rel-fn input output) s))))
|
|
(let
|
|
((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
|
|
(cond
|
|
((= (len vals) (len prev-vals))
|
|
(begin
|
|
(mk-tab-store! key vals)
|
|
(mk-tab-replay-vals vals output s)))
|
|
(:else (table-2-slg-iter rel-fn input output s key vals))))))))
|
|
|
|
(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
|
|
((not (= cached :miss))
|
|
(mk-tab-replay-vals cached output s))
|
|
(:else
|
|
(table-2-slg-iter rel-fn input output s key (list)))))))
|
|
(:else ((rel-fn input output) s))))))))
|
|
|
|
(define
|
|
table-3-slg-iter
|
|
(fn
|
|
(rel-fn i1 i2 output s key prev-vals)
|
|
(begin
|
|
(mk-tab-store! key prev-vals)
|
|
(let
|
|
((all-substs (stream-take -1 ((rel-fn i1 i2 output) s))))
|
|
(let
|
|
((vals (map (fn (s2) (mk-walk* output s2)) all-substs)))
|
|
(cond
|
|
((= (len vals) (len prev-vals))
|
|
(begin
|
|
(mk-tab-store! key vals)
|
|
(mk-tab-replay-vals vals output s)))
|
|
(:else (table-3-slg-iter rel-fn i1 i2 output s key vals))))))))
|
|
|
|
(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
|
|
((not (= cached :miss))
|
|
(mk-tab-replay-vals cached output s))
|
|
(:else
|
|
(table-3-slg-iter rel-fn i1 i2 output s key (list)))))))
|
|
(:else ((rel-fn i1 i2 output) s))))))))
|