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