simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add reduce-ir-children; rebuild the read-only IR walks on it

Browse source 
map-ir-children single-sourced the child layout for rewrite passes; the read-only
analyses each re-enumerated ops by hand. Add a fold companion, reduce-ir-children,
and rebuild body-size, pure?, and body-closed? on it (each reduces to a leaf value
+ the special ops it actually needs). local-escapes? stays an explicit walk — its
default is conservatively true and it inspects node shape beyond child purity, so
folding an unhandled op over its children would be unsound for scalar replacement.
This commit is contained in:
Yogthos 2026-06-23 01:28:32 -04:00
parent adf00a3b51
commit 524d4cd8d1
3 changed files with 247 additions and 241 deletions
Download patch file Download diff file Expand all files Collapse all files

34
jolt-core/jolt/ir.clj
View file

@ -124,3 +124,37 @@
n)
;; :const :local :var :host :host-static :the-var :quote — no child nodes
:else node)))
;; The read-only companion to map-ir-children: fold f over node's child IR nodes,
;; left to right, threading acc — same single-sourced child layout, so a read-only
;; analysis (size/closedness/purity) built on it is TOTAL over the op set (an
;; unknown op, or a leaf, folds over no children and returns acc unchanged). Skips
;; the same non-node positions map-ir-children does (binding NAMES, fn :params/
;; :rest, :op/:ns/:name/:val). f is (acc child) -> acc.
(defn reduce-ir-children [f acc node]
(let [op (get node :op)]
(cond
(= op :if) (f (f (f acc (get node :test)) (get node :then)) (get node :else))
(= op :do) (f (reduce f acc (get node :statements)) (get node :ret))
(= op :throw) (f acc (get node :expr))
(= op :set-var) (f acc (get node :val))
(= op :set-field) (f (f acc (get node :obj)) (get node :val))
(= op :defmacro) (f acc (get node :fn))
(= op :invoke) (reduce f (f acc (get node :fn)) (get node :args))
(= op :vector) (reduce f acc (get node :items))
(= op :set) (reduce f acc (get node :items))
(= op :map) (reduce (fn [a pr] (f (f a (nth pr 0)) (nth pr 1))) acc (get node :pairs))
(= op :let) (f (reduce (fn [a b] (f a (nth b 1))) acc (get node :bindings)) (get node :body))
(= op :loop) (f (reduce (fn [a b] (f a (nth b 1))) acc (get node :bindings)) (get node :body))
(= op :recur) (reduce f acc (get node :args))
(= op :fn) (reduce (fn [a ar] (f a (get ar :body))) acc (get node :arities))
(= op :def) (if (get node :init) (f acc (get node :init)) acc)
(= op :host-call) (reduce f (f acc (get node :target)) (get node :args))
(= op :host-new) (reduce f acc (get node :args))
(= op :try)
(let [a (f acc (get node :body))
a (if (get node :catch-body) (f a (get node :catch-body)) a)
a (if (get node :finally) (f a (get node :finally)) a)]
a)
;; leaves and any op with no child nodes
:else acc)))

74
jolt-core/jolt/passes/inline.clj
View file

@ -4,7 +4,7 @@
share the alpha-rename invariant (every spliced binder is made globally fresh)
and the `dirty` fixpoint flag. Portable Clojure (compiler-tier)."
(:require [jolt.host :refer [inline-ir]]
[jolt.ir :refer [map-ir-children]]
[jolt.ir :refer [map-ir-children reduce-ir-children]]
[jolt.passes.fold :refer [scalar-const?]]))
;; ---------------------------------------------------------------------------
@ -54,27 +54,12 @@
(defn- body-size
"Node count of an inline-eligible body. A disallowed op contributes a number
larger than any budget, so the caller's (<= size budget) test fails and we
never try to inline (or alpha-rename) such a body."
never try to inline (or alpha-rename) such a body. Only reached for safe ops,
so the shared child fold covers it exactly (leaves fold to 1)."
[node]
(let [op (get node :op)]
(cond
(not (safe-op? op)) 100000
(= op :if) (+ 1 (body-size (get node :test))
(body-size (get node :then))
(body-size (get node :else)))
(= op :do) (+ 1 (reduce + 0 (mapv body-size (get node :statements)))
(body-size (get node :ret)))
(= op :throw) (+ 1 (body-size (get node :expr)))
(= op :invoke) (+ 1 (body-size (get node :fn))
(reduce + 0 (mapv body-size (get node :args))))
(= op :let) (+ 1 (reduce + 0 (mapv (fn [b] (body-size (nth b 1))) (get node :bindings)))
(body-size (get node :body)))
(= op :vector) (+ 1 (reduce + 0 (mapv body-size (get node :items))))
(= op :set) (+ 1 (reduce + 0 (mapv body-size (get node :items))))
(= op :map) (+ 1 (reduce + 0 (mapv (fn [pr] (+ (body-size (nth pr 0))
(body-size (nth pr 1))))
(get node :pairs))))
:else 1)))
(if (not (safe-op? (get node :op)))
100000
(reduce-ir-children (fn [acc c] (+ acc (body-size c))) 1 node)))
(defn- subst
"Substitute locals in node per env (a map name -> replacement IR node), and
@ -129,24 +114,8 @@
(let [op (get node :op)]
(cond
(= op :local) (contains? scope (get node :name))
(= op :const) true
(= op :var) true
(= op :host) true
(= op :the-var) true
(= op :quote) true
(= op :if) (and (body-closed? (get node :test) scope)
(body-closed? (get node :then) scope)
(body-closed? (get node :else) scope))
(= op :do) (and (every? (fn [s] (body-closed? s scope)) (get node :statements))
(body-closed? (get node :ret) scope))
(= op :throw) (body-closed? (get node :expr) scope)
(= op :invoke) (and (body-closed? (get node :fn) scope)
(every? (fn [a] (body-closed? a scope)) (get node :args)))
(= op :vector) (every? (fn [x] (body-closed? x scope)) (get node :items))
(= op :set) (every? (fn [x] (body-closed? x scope)) (get node :items))
(= op :map) (every? (fn [pr] (and (body-closed? (nth pr 0) scope)
(body-closed? (nth pr 1) scope)))
(get node :pairs))
;; :let threads scope sequentially (each binding extends it), so it can't go
;; through the uniform fold.
(= op :let)
(let [res (reduce (fn [acc b]
(let [sc (nth acc 0) ok (nth acc 1)]
@ -156,6 +125,9 @@
[scope true]
(get node :bindings))]
(and (nth res 1) (body-closed? (get node :body) (nth res 0))))
;; leaves (:const/:var/:host/:the-var/:quote) fold to true; the rest AND
;; their children. Unsafe ops never reach here (body-size rejects them).
(safe-op? op) (reduce-ir-children (fn [ok c] (and ok (body-closed? c scope))) true node)
:else false)))
(defn- try-inline
@ -267,20 +239,13 @@
[node]
(let [op (get node :op)]
(cond
(= op :const) true
(= op :local) true
(= op :var) true
(= op :host) true
(= op :the-var) true
(= op :quote) true
(= op :if) (and (pure? (get node :test)) (pure? (get node :then)) (pure? (get node :else)))
(= op :do) (and (every? pure? (get node :statements)) (pure? (get node :ret)))
(= op :let) (and (every? (fn [b] (pure? (nth b 1))) (get node :bindings)) (pure? (get node :body)))
(= op :vector) (every? pure? (get node :items))
(= op :set) (every? pure? (get node :items))
(= op :map) (every? (fn [pr] (and (pure? (nth pr 0)) (pure? (nth pr 1)))) (get node :pairs))
;; :invoke is pure only for a known-pure fn / record ctor, and only its ARGS
;; are folded (not the :fn position) — so it can't go through the uniform fold.
(= op :invoke) (and (or (pure-fn? (get node :fn)) (ctor-shape node))
(every? pure? (get node :args)))
;; leaves (:const/:local/:var/:host/:the-var/:quote) fold to true; :if/:do/
;; :let/:vector/:set/:map AND their children's purity.
(safe-op? op) (reduce-ir-children (fn [ok c] (and ok (pure? c))) true node)
:else false)))
(defn- const-key-map? [node]
@ -340,7 +305,12 @@
"Does local nm escape in node — i.e. is it used anywhere other than as the
subject of a constant-keyword lookup? Precise over straight-line expression
ops; conservatively true for loop/fn/try/recur/def (and any rebinding of nm),
so scalar replacement only fires where the whole use region is simple."
so scalar replacement only fires where the whole use region is simple.
Stays an explicit per-op walk (not the shared reduce-ir-children fold): its
default is conservatively TRUE, and the lookup-subject and rebinding cases
inspect node shape beyond child purity — folding an unhandled op over its
children would under-report escape and is unsound for scalar replacement."
[node nm]
(let [op (get node :op)
k (lookup-key node nm)]