;; lib/guest/reflective/class-chain.sx — class inheritance walker.
;;
;; Extracted from Smalltalk's `st-method-lookup-walk` (single-parent
;; class chain for message-send dispatch) and CLOS's `clos-specificity`
;; (multi-parent class graph for method-precedence distance). Both walk
;; a class-name → parent-name(s) graph applying a probe at each node;
;; the cfg adapter normalises single-parent and multi-parent classes
;; into a uniform `:parents-of` callback that returns a (possibly
;; empty) list of parent class names.
;;
;; Adapter cfg
;; -----------
;;   :parents-of  — fn (class-name) → list of parent class names.
;;                  Empty list = no parents (root). Single-parent guests
;;                  return a 1-element list; multi-parent guests (CLOS)
;;                  may return any number.
;;   :class?      — fn (name) → bool. False short-circuits the walk —
;;                  used to skip non-existent class names mid-chain.
;;
;; Public API
;;   (refl-class-chain-find-with CFG CLASS-NAME PROBE)
;;     Depth-first walk from CLASS-NAME up its parent chain. At each
;;     class, calls `(probe class-name)`. Returns the first non-nil
;;     probe result, or nil if no class produces one. Probes evaluate
;;     left-to-right across siblings in multi-parent guests.
;;
;;   (refl-class-chain-depth-with CFG CLASS-NAME ANCESTOR-NAME)
;;     Minimum hop count from CLASS-NAME to ANCESTOR-NAME along any
;;     parent path. CLASS-NAME itself counts as depth 0. Returns nil
;;     if ANCESTOR-NAME is unreachable.
;;
;;   (refl-class-chain-ancestors-with CFG CLASS-NAME)
;;     Flat list of all reachable ancestor names in DFS order (no
;;     dedup; multi-parent guests may want to dedup themselves).
;;
;; Consumer migrations
;; -------------------
;; - Smalltalk: see `lib/smalltalk/runtime.sx` — `st-method-lookup-walk`
;;   becomes a one-line probe through `refl-class-chain-find-with`.
;; - CLOS: see `lib/common-lisp/clos.sx` — `clos-specificity` becomes a
;;   thin wrapper around `refl-class-chain-depth-with`.

(define
  refl-find-in-parents-with
  (fn
    (cfg parents probe)
    (cond
      ((or (nil? parents) (= (length parents) 0)) nil)
      (:else
        (let
          ((hit (refl-class-chain-find-with cfg (first parents) probe)))
          (cond
            ((not (nil? hit)) hit)
            (:else (refl-find-in-parents-with cfg (rest parents) probe))))))))

(define
  refl-class-chain-find-with
  (fn
    (cfg class-name probe)
    (cond
      ((nil? class-name) nil)
      ((not ((get cfg :class?) class-name)) nil)
      (:else
        (let
          ((hit (probe class-name)))
          (cond
            ((not (nil? hit)) hit)
            (:else
              (refl-find-in-parents-with
                cfg
                ((get cfg :parents-of) class-name)
                probe))))))))

(define
  refl-class-chain-depth-walk
  (fn
    (cfg cur target depth)
    (cond
      ((= cur target) depth)
      ((nil? cur) nil)
      ((not ((get cfg :class?) cur)) nil)
      (:else
        (let
          ((parents ((get cfg :parents-of) cur)))
          (let
            ((results (map (fn (p) (refl-class-chain-depth-walk cfg p target (+ depth 1))) parents)))
            (let
              ((non-nil (filter (fn (x) (not (nil? x))) results)))
              (cond
                ((or (nil? non-nil) (= (length non-nil) 0)) nil)
                (:else
                  (reduce
                    (fn (a b) (if (< a b) a b))
                    (first non-nil)
                    (rest non-nil)))))))))))

(define
  refl-class-chain-depth-with
  (fn
    (cfg class-name ancestor-name)
    (refl-class-chain-depth-walk cfg class-name ancestor-name 0)))

(define
  refl-class-chain-ancestors-with
  (fn (cfg class-name) (refl-ancestors-walk cfg class-name (list))))

(define
  refl-ancestors-walk
  (fn
    (cfg cn acc)
    (cond
      ((nil? cn) acc)
      ((not ((get cfg :class?) cn)) acc)
      (:else
        (let
          ((parents ((get cfg :parents-of) cn)))
          (refl-ancestors-walk-list cfg parents (append acc (list cn))))))))

(define
  refl-ancestors-walk-list
  (fn
    (cfg parents acc)
    (cond
      ((or (nil? parents) (= (length parents) 0)) acc)
      (:else
        (refl-ancestors-walk-list
          cfg
          (rest parents)
          (refl-ancestors-walk cfg (first parents) acc))))))