Skip to content

Commit f1deb98

Browse files
tompassarellitompassarelli
committed
refactor(chartroom): factor shared call-edges + blast-closure (one reaches impl)
Extract resolve.clj's callgraph-mode derivation into two reusable library fns: call-edges (scope-correct defn->defn edges over the bound corpus, keyed on node identity) and blast-closure (the transitive reaches radius via Fram Datalog). The callgraph mode and chartroom/callgraph.clj both delegate, so the per-query throwaway recursion store now lives in exactly ONE place — the substrate the daemon's warm :blast/:concern-overlap (thread 019f1010-2705) will share. No behavior change: JSON output byte-identical; chartroom-seam guard green.
1 parent 51105fe commit f1deb98

2 files changed

Lines changed: 91 additions & 74 deletions

File tree

‎chartroom/src/callgraph.clj‎

Lines changed: 7 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@
2323
(:require [clojure.edn :as edn]
2424
[clojure.string :as str]
2525
[cheshire.core :as json]
26-
[fram.cnf :as c]
27-
[fram.datalog :as d]))
26+
[resolve :as rsv])) ; rsv/blast-closure: the ONE reaches-closure impl
2827

2928
;; ---- parse the @file-delimited claim stream (from beagle-claims) -----------
3029
;; NOTE: Racket ~s emits some escapes (\e, \a, ...) Clojure's EDN reader rejects.
@@ -103,28 +102,12 @@
103102
distinct vec)]
104103
{:defns defns :by-name by-name :edges edges}))
105104

106-
;; ---- transitive blast radius via Fram Datalog (the persistent-store seam) ---
107-
;; blast(D) = {x | x transitively calls D} = D's transitive callers (who breaks if D changes).
108-
(defn blast-radius [edges]
109-
(let [ctx (c/new-store)
110-
tx (c/begin-tx! ctx "code")
111-
EDGE (c/value! ctx "calls-defn")
112-
k->id (volatile! {})
113-
ent (fn [k] (or (get @k->id k)
114-
(let [e (c/entity! ctx)] (vswap! k->id assoc k e) e)))
115-
_ (doseq [[a b] edges] (c/claim! ctx (ent a) EDGE (ent b) tx))
116-
id->k (into {} (map (fn [[k v]] [v k]) @k->id))
117-
db (d/run-rules ctx
118-
[(d/rule "reaches" [(d/v :x) (d/v :y)]
119-
[(d/lit "triple" [(d/v :x) EDGE (d/v :y)])])
120-
(d/rule "reaches" [(d/v :x) (d/v :z)]
121-
[(d/lit "triple" [(d/v :x) EDGE (d/v :y)])
122-
(d/lit "reaches" [(d/v :y) (d/v :z)])])])
123-
reaches (set (d/facts db "reaches"))
124-
blast (reduce (fn [m [xid yid]]
125-
(update m (id->k yid) (fnil conj #{}) (id->k xid)))
126-
{} reaches)]
127-
{:blast blast :reaches reaches}))
105+
;; ---- transitive blast radius (the persistent-store seam) -------------------
106+
;; blast(D) = {x | x transitively calls D} = D's transitive callers (who breaks if D
107+
;; changes). Delegates to resolve/blast-closure — the ONE reaches-closure impl shared
108+
;; by the daemon's warm :blast/:concern-overlap, the `callgraph` mode, and this CLI; the
109+
;; per-query throwaway recursion store now lives in exactly that one helper (decision J).
110+
(defn blast-radius [edges] (rsv/blast-closure edges))
128111

129112
;; ---- CLI: claims-file -> JSON {defns, edges, blast} ------------------------
130113
(defn -main [& args]

‎chartroom/src/resolve.clj‎

Lines changed: 84 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -1558,6 +1558,84 @@
15581558
(System/exit 2)))))))
15591559
module))
15601560

1561+
;; ============================================================================
1562+
;; call graph — the scope-correct calls_defn edges + transitive blast radius.
1563+
;; ============================================================================
1564+
;; Factored out of the `callgraph` MODE so the daemon's warm :blast/:concern-overlap,
1565+
;; the offline `callgraph` mode, and chartroom/callgraph.clj all share ONE derivation
1566+
;; (call-edges) and ONE reaches closure (blast-closure) — the per-query throwaway-store
1567+
;; rebuild now lives in exactly one place (decision J: "one implementation shared by
1568+
;; concern-overlap and who-calls").
1569+
1570+
;; call-edges — scope-correct defn->defn edges over the CURRENTLY BOUND corpus
1571+
;; (srcs/file-modframe + materialized refers_to must already be in scope — call under
1572+
;; with-resolve-read / resolve-edn!). A "call" is any resolved reference inside a
1573+
;; top-level defn's body whose binding (via refers_to, transitively) is itself a
1574+
;; top-level defn; the caller is that enclosing defn. Edges are keyed on the binding's
1575+
;; NODE entity-id (@mod#int identity — rename-stable, scope-correct: same-named fns in
1576+
;; different modules are distinct nodes, so they never false-merge). Returns
1577+
;; {:defn-meta {leaf -> {:key :file :module :name}} :edges [[caller-leaf callee-leaf]]
1578+
;; :defn-set #{leaf}} — the daemon joins footprint @concern->@node against :edges; the
1579+
;; CLI maps leaf->:key for JSON.
1580+
(defn call-edges []
1581+
(let [dkey (fn [src leaf] (str src "#" leaf))
1582+
defn-meta (into {} (for [src srcs, [nm leaf] (file-modframe src)]
1583+
[leaf {:key (dkey src leaf) :file src
1584+
:module (or (module-name src)
1585+
(-> src (str/split #"/") last (str/replace #"\.[^.]+$" "")))
1586+
:name nm}]))
1587+
defn-set (set (keys defn-meta))
1588+
;; ALL resolved reference symbols in a subtree (any position — head call,
1589+
;; value-pass, threaded step, `:- T` annotation): every reference to a defn is a
1590+
;; blast dependency; head-only under-reports (proven on shipped fram/src).
1591+
call-refs (fn call-refs [node]
1592+
(if (refers-target node) [node]
1593+
(when (= "list" (kind-of node)) (mapcat call-refs (ordered-children node)))))
1594+
callers (mapcat
1595+
(fn [form]
1596+
(let [d (unwrap-def form) h (head-sym d)]
1597+
(cond
1598+
(VALUE-DEFS h)
1599+
(let [cl (second (ordered-children d))] (when (defn-meta cl) [[cl d]]))
1600+
(#{"extend-type" "extend-protocol"} h)
1601+
(keep (fn [c] (when (= "list" (kind-of c))
1602+
(let [mnode (first (ordered-children c))
1603+
cl (when (sym-val mnode) (ultimate (refers-target mnode)))]
1604+
(when (and cl (defn-meta cl)) [cl c]))))
1605+
(rest (ordered-children d))))))
1606+
(mapcat forms-of srcs))
1607+
edges (vec (distinct
1608+
(for [[caller-leaf body] callers
1609+
r (call-refs body)
1610+
:let [callee (ultimate (refers-target r))] ; follow refers_to to the bound defn
1611+
:when (and (defn-set callee) (not= callee caller-leaf))]
1612+
[caller-leaf callee])))]
1613+
{:defn-meta defn-meta :edges edges :defn-set defn-set}))
1614+
1615+
;; blast-closure — transitive blast radius over a set of [caller callee] edges via Fram
1616+
;; Datalog: blast(D) = {x | x transitively calls D} = D's transitive callers (who breaks
1617+
;; if D changes). Edge keys are any hashable (node-ids for the warm path, "src#leaf"
1618+
;; strings for JSON). Returns {:reaches #{[x y]} :blast {callee -> #{transitive-callers}}}.
1619+
;; The ONE reaches implementation; the throwaway recursion store lives only here.
1620+
(defn blast-closure [edges]
1621+
(let [ctx (c/new-store)
1622+
tx (c/begin-tx! ctx "code")
1623+
EDGE (c/value! ctx "calls-defn")
1624+
k->id (volatile! {})
1625+
ent (fn [k] (or (get @k->id k)
1626+
(let [e (c/entity! ctx)] (vswap! k->id assoc k e) e)))
1627+
_ (doseq [[a b] edges] (c/claim! ctx (ent a) EDGE (ent b) tx))
1628+
id->k (into {} (map (fn [[k v]] [v k]) @k->id))
1629+
db (d/run-rules ctx
1630+
[(d/rule "reaches" [(d/v :x) (d/v :y)]
1631+
[(d/lit "triple" [(d/v :x) EDGE (d/v :y)])])
1632+
(d/rule "reaches" [(d/v :x) (d/v :z)]
1633+
[(d/lit "triple" [(d/v :x) EDGE (d/v :y)])
1634+
(d/lit "reaches" [(d/v :y) (d/v :z)])])])
1635+
reaches (set (map (fn [[xid yid]] [(id->k xid) (id->k yid)]) (d/facts db "reaches")))
1636+
blast (reduce (fn [m [x y]] (update m y (fnil conj #{}) x)) {} reaches)]
1637+
{:reaches reaches :blast blast}))
1638+
15611639
;; ============================================================================
15621640
;; CLI entry. Slice the edn paths off *command-line-args* per mode (the old
15631641
;; `(def srcs ...)` slice), then run the WHOLE pipeline + mode dispatch inside
@@ -1637,59 +1715,15 @@
16371715
;; (a/f, m/f) cross-module calls. Emits the JSON beagle-cascade consumes.
16381716
;; ============================================================================
16391717
"callgraph"
1640-
(let [dkey (fn [src leaf] (str src "#" leaf))
1641-
defn-meta (into {} (for [src srcs, [nm leaf] (file-modframe src)]
1642-
[leaf {:key (dkey src leaf) :file src
1643-
:module (or (module-name src)
1644-
(-> src (str/split #"/") last (str/replace #"\.[^.]+$" "")))
1645-
:name nm}]))
1646-
defn-set (set (keys defn-meta))
1647-
;; ALL resolved reference symbols in a subtree (any position — not just list-head).
1648-
;; For a BLAST RADIUS ("what must change if I change X"), every reference to a defn is
1649-
;; a dependency: a head call (f x), a value-pass (mapv f xs), a threaded step (-> x f),
1650-
;; a `:- T` annotation. Head-only silently under-reports (proven on shipped fram/src).
1651-
call-refs (fn call-refs [node]
1652-
(if (refers-target node) [node]
1653-
(when (= "list" (kind-of node)) (mapcat call-refs (ordered-children node)))))
1654-
;; callers = [caller-defn-leaf, body-node] pairs. A top-level value defn is one caller;
1655-
;; an extend-type/extend-protocol attributes each impl method's body to that protocol
1656-
;; method (the impl method-name resolves to it via refers_to) — those bodies were skipped.
1657-
callers (mapcat
1658-
(fn [form]
1659-
(let [d (unwrap-def form) h (head-sym d)]
1660-
(cond
1661-
(VALUE-DEFS h)
1662-
(let [cl (second (ordered-children d))] (when (defn-meta cl) [[cl d]]))
1663-
(#{"extend-type" "extend-protocol"} h)
1664-
(keep (fn [c] (when (= "list" (kind-of c))
1665-
(let [mnode (first (ordered-children c))
1666-
cl (when (sym-val mnode) (ultimate (refers-target mnode)))]
1667-
(when (and cl (defn-meta cl)) [cl c]))))
1668-
(rest (ordered-children d))))))
1669-
(mapcat forms-of srcs))
1670-
edges (vec (distinct
1671-
(for [[caller-leaf body] callers
1672-
r (call-refs body)
1673-
:let [callee (ultimate (refers-target r))] ; follow refers_to to the bound defn
1674-
:when (and (defn-set callee) (not= callee caller-leaf))]
1675-
[(:key (defn-meta caller-leaf)) (:key (defn-meta callee))])))
1676-
;; transitive blast radius via Fram Datalog: blast(D) = {x | x transitively calls D}
1677-
bctx (c/new-store) btx (c/begin-tx! bctx "code") EDGE (c/value! bctx "calls-defn")
1678-
k->e (volatile! {})
1679-
bent (fn [k] (or (get @k->e k) (let [e (c/entity! bctx)] (vswap! k->e assoc k e) e)))
1680-
_ (doseq [[a b] edges] (c/claim! bctx (bent a) EDGE (bent b) btx))
1681-
e->k (into {} (map (fn [[k v]] [v k]) @k->e))
1682-
db (d/run-rules bctx
1683-
[(d/rule "reaches" [(d/v :x) (d/v :y)] [(d/lit "triple" [(d/v :x) EDGE (d/v :y)])])
1684-
(d/rule "reaches" [(d/v :x) (d/v :z)] [(d/lit "triple" [(d/v :x) EDGE (d/v :y)])
1685-
(d/lit "reaches" [(d/v :y) (d/v :z)])])])
1686-
reaches (set (d/facts db "reaches"))
1687-
blast (reduce (fn [m [xid yid]] (update m (e->k yid) (fnil conj #{}) (e->k xid))) {} reaches)]
1718+
(let [{:keys [defn-meta edges]} (call-edges)
1719+
key->s (fn [leaf] (:key (defn-meta leaf)))
1720+
edges-s (mapv (fn [[a b]] [(key->s a) (key->s b)]) edges)
1721+
{:keys [reaches blast]} (blast-closure edges-s)]
16881722
(binding [*out* *err*]
16891723
(println (format "callgraph: %d defns, %d scope-correct edges, %d transitive reaches-pairs (refers_to + Fram Datalog)"
1690-
(count defn-meta) (count edges) (count reaches))))
1724+
(count defn-meta) (count edges-s) (count reaches))))
16911725
(println (json/generate-string
1692-
{:defns (vec (vals defn-meta)) :edges edges
1726+
{:defns (vec (vals defn-meta)) :edges edges-s
16931727
:blast (into {} (map (fn [[k vs]] [k (vec vs)]) blast))}))))))))
16941728

16951729
;; GUARD: run the pipeline only when invoked as a CLI with a recognized mode.

0 commit comments

Comments
 (0)