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

Dead-code elimination in jolt uberscript (jolt-atg) (#130)

Browse source 
A bundle is closed-world — everything it needs is inlined and nothing is
required afterward — so a user defn unreachable from the entry's reference
graph can be dropped. The bundler now computes reachability from main-ns/-main
plus every non-prunable form and drops dead defn/defn- by exact source span
(formatting and reader macros in the surviving code are untouched).

Conservative and sound: only plain defn/defn- are prunable; a defn is kept if
its bare or ns-qualified name appears in any kept form, the closure runs to a
fixpoint, and any use of resolve/ns-resolve/requiring-resolve/find-var/intern/
eval/load-string disables pruning entirely. A parse failure on any file also
falls back to verbatim bundling, so the command stays as robust as a plain
concatenation. defmethod/defrecord/extend bodies are non-prunable and scanned,
so a fn reached only via dynamic dispatch stays live.

New reader/parse-all-spans returns [form start end] byte offsets so the drop
is a verbatim slice, not a re-print.

30-fn library used by a 3-fn entry: bundle 1114 -> 437 bytes (61% smaller, 27
dead fns dropped), output byte-identical.

Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
Dmitri Sotnikov 2026-06-15 22:25:44 +00:00 • committed by GitHub
parent a029afc127
commit 04d3e192ed
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 211 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

92
src/jolt/main.janet
View file

@ -496,6 +496,45 @@
(load-string ctx (string "(apply " ns-name "/-main *command-line-args*)")))
([err fib] (report-error err fib) (os/exit 1))))
# --- uberscript dead-code elimination (jolt-atg) ---------------------------
# A bundle is closed-world: everything it needs is inlined and nothing is
# required afterward, so a user `defn` unreachable from the entry's reference
# graph can be dropped. Conservative + sound: only plain defn/defn- are
# prunable; a defn is kept if its (bare or ns-qualified) name appears in any
# kept form, the closure runs to a fixpoint, and any use of dynamic resolution
# disables pruning entirely. The drop is by exact source span, so formatting
# and reader macros in the surviving code are untouched.
(defn- dce-sym? [x] (and (struct? x) (= :symbol (get x :jolt/type))))
(def- dce-bailout-syms
{"resolve" true "ns-resolve" true "requiring-resolve" true "find-var" true
"intern" true "eval" true "load-string" true})
(defn- dce-collect-syms [form acc]
(cond
(dce-sym? form) (do (put acc (get form :name) true)
(when (get form :ns)
(put acc (string (get form :ns) "/" (get form :name)) true)))
(indexed? form) (each x form (dce-collect-syms x acc))
(or (struct? form) (table? form)) (each k (keys form)
(dce-collect-syms k acc)
(dce-collect-syms (get form k) acc)))
acc)
(defn- dce-defn-name [form]
(when (and (indexed? form) (>= (length form) 2) (dce-sym? (get form 0))
(let [nm (get (in form 0) :name)] (or (= nm "defn") (= nm "defn-")))
(dce-sym? (get form 1)))
(get (in form 1) :name)))
(defn- dce-strip-spans [src dead]
(if (empty? dead) src
(do
(sort dead (fn [a b] (< (a 0) (b 0))))
(def buf @"")
(var cur 0)
(each [s e] dead
(when (> s cur) (buffer/push-string buf (string/slice src cur s)))
(set cur (max cur e)))
(buffer/push-string buf (string/slice src cur))
(string buf))))
(defn- run-uberscript [out main-ns]
# Bundle main-ns and everything it requires (from JOLT_PATH roots) into one
# .clj that runs on a plain jolt — no deps, no jpm. We require the entry and
@ -510,15 +549,64 @@
(def files @[])
(each f (get (ctx :env) :loaded-files)
(unless (get seen f) (put seen f true) (array/push files f)))
# read every file's source and parse it into top-level forms with byte spans;
# if ANY file fails to parse, fall back to verbatim bundling (DCE off) so the
# uberscript stays exactly as robust as a plain concatenation.
(def srcs @{})
(def file-forms @{})
(def all-forms @[])
(var dce-ok true)
(each f files
(def src (slurp f))
(put srcs f src)
(def lst @[])
(try
(each [form s e] (parse-all-spans src f)
(def entry @{:start s :end e :dname (dce-defn-name form) :form form})
(array/push lst entry)
(array/push all-forms entry))
([_err _fib] (set dce-ok false)))
(put file-forms f lst))
# disable DCE if the bundle resolves names dynamically (a defn could be
# reached by a string/symbol the reference scan can't see).
(when dce-ok
(def allsyms @{})
(each e all-forms (dce-collect-syms (e :form) allsyms))
(each nm (keys allsyms) (when (get dce-bailout-syms nm) (set dce-ok false))))
# reachability: seed from the entry (-main) and every non-prunable form, then
# close over the bodies of defns that become live.
(def live @{})
(when dce-ok
(def referenced @{"-main" true})
(each e all-forms (unless (e :dname) (dce-collect-syms (e :form) referenced)))
(var changed true)
(while changed
(set changed false)
(each e all-forms
(when (and (e :dname) (not (get live e)) (get referenced (e :dname)))
(put live e true)
(dce-collect-syms (e :form) referenced)
(set changed true)))))
(var dropped 0)
(def buf @"")
(buffer/push-string buf (string ";; Generated by `jolt uberscript` — " (length files) " namespace(s)\n\n"))
(each f files
(buffer/push-string buf (string ";; --- " f " ---\n"))
(buffer/push-string buf (slurp f))
(def src (get srcs f))
(if-not dce-ok
(buffer/push-string buf src)
(do
(def dead @[])
(each e (get file-forms f)
(when (and (e :dname) (not (get live e)))
(++ dropped)
(array/push dead [(e :start) (e :end)])))
(buffer/push-string buf (dce-strip-spans src dead))))
(buffer/push-string buf "\n"))
(buffer/push-string buf (string "\n(apply " main-ns "/-main *command-line-args*)\n"))
(spit out (string buf))
(print "Wrote " out " (" (length files) " namespace(s))"))
(print "Wrote " out " (" (length files) " namespace(s)"
(if (and dce-ok (> dropped 0)) (string ", " dropped " dead fn(s) dropped") "") ")"))
(defn- print-help []
(print "Jolt — a Clojure interpreter on Janet\n")

35
src/jolt/reader.janet
View file

@ -792,3 +792,38 @@
(set s rest*)
(when (not (nil? form)) (array/push out [form form-line])))
out)
(defn parse-all-spans
"Parse every top-level form of source, returning an array of
[form abs-start abs-end] where abs-start is the byte offset of the form's
first non-trivia char and abs-end is just past it (leading whitespace/comment
trivia is excluded). Lets a caller reconstruct source by slicing verbatim —
used by `jolt uberscript`'s dead-code elimination to drop a defn's exact byte
span without re-printing (so formatting and reader macros survive)."
[source &opt file]
(def out @[])
(var s source)
(while (> (length (string/trim s)) 0)
(def base (- (length source) (length s)))
(var i 0)
(def n (length s))
(var scanning true)
(while (and scanning (< i n))
(def c (in s i))
(cond
(or (= c (chr "\n")) (= c (chr " ")) (= c (chr "\t")) (= c (chr "\r")) (= c (chr ","))) (++ i)
(= c (chr ";")) (while (and (< i n) (not= (in s i) (chr "\n"))) (++ i))
(set scanning false)))
(def [form rest*]
(try (parse-next s)
([err fib]
(if (reader-error? err)
(error (format-reader-error
{:jolt/type :jolt/reader-error :msg (err :msg)
:pos (+ base (err :pos))}
source file))
(propagate err fib)))))
(def consumed (- (length s) (length rest*)))
(set s rest*)
(when (not (nil? form)) (array/push out [form (+ base i) (+ base consumed)])))
out)

86
test/integration/uberscript-dce-test.janet Normal file
View file

@ -0,0 +1,86 @@
# Dead-code elimination in `jolt uberscript` (jolt-atg): a bundle is closed-
# world (everything it needs is inlined, nothing is required later), so a user
# `defn` that is unreachable from the entry point's reference graph can be
# dropped. Sound + conservative: only plain defn/defn- are prunable; a defn is
# kept if its (bare or ns-qualified) name appears anywhere in a kept form, the
# closure iterates to a fixpoint, and any use of dynamic resolution
# (resolve/eval/...) keeps everything. Drives the BUILT binary (uberscript is a
# CLI command); skips cleanly if build/jolt is absent.
(def jolt "build/jolt")
(defn- write-app [dir files]
(os/mkdir dir)
(each [name body] (partition 2 files) (spit (string dir "/" name) body)))
(defn- uber [dir main-ns]
(def out (string dir "/out.clj"))
(def jbin (string (os/cwd) "/" jolt))
(os/execute ["sh" "-c" (string "JOLT_PATH=" dir " " jbin " uberscript " out " -m " main-ns " 2>/dev/null")] :p)
(slurp out))
(defn- run-bundle [dir]
(def out2 (string dir "/run.txt"))
(def jbin (string (os/cwd) "/" jolt))
(os/execute ["sh" "-c" (string jbin " " dir "/out.clj > " out2 " 2>&1")] :p)
(string/trimr (slurp out2)))
(defn- has? [s needle] (not (nil? (string/find needle s))))
(if (not (os/stat jolt))
(print "uberscript-dce: SKIP (no build/jolt — run from source)")
(do
# --- basic: an unreachable defn is dropped; reachable ones survive --------
(def d1 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce1"))
(write-app d1
["lib.clj" (string "(ns lib)\n"
"(defn used-helper [x] (* x 2))\n"
"(defn dead-never-called [x] (+ x 99999))\n"
"(defn also-used [x] (used-helper (inc x)))\n")
"app.clj" (string "(ns app (:require [lib]))\n"
"(defn -main [& _] (println \"result\" (lib/also-used 10)))\n")])
(def b1 (uber d1 "app"))
(assert (not (has? b1 "dead-never-called")) "unreachable defn dropped from bundle")
(assert (has? b1 "used-helper") "transitively-reached defn kept")
(assert (has? b1 "also-used") "directly-reached defn kept")
(assert (= "result 22" (run-bundle d1)) "pruned bundle runs identically")
# --- soundness: a fn reached ONLY through a macro template is kept --------
(def d2 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce2"))
(write-app d2
["mlib.clj" (string "(ns mlib)\n"
"(defn via-macro [x] (* x 3))\n"
"(defmacro tri [n] (list 'mlib/via-macro n))\n")
"app2.clj" (string "(ns app2 (:require [mlib]))\n"
"(defn -main [& _] (println \"m\" (mlib/tri 7)))\n")])
(def b2 (uber d2 "app2"))
(assert (has? b2 "via-macro") "fn used only via a macro template is kept")
(assert (= "m 21" (run-bundle d2)) "macro-reached bundle runs identically")
# --- soundness: dynamic resolution disables DCE (keeps everything) --------
(def d3 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce3"))
(write-app d3
["dlib.clj" (string "(ns dlib)\n"
"(defn looks-dead [x] (* x 5))\n")
"app3.clj" (string "(ns app3 (:require [dlib]))\n"
"(defn -main [& _]\n"
" (println \"d\" ((deref (resolve 'dlib/looks-dead)) 4)))\n")])
(def b3 (uber d3 "app3"))
(assert (has? b3 "looks-dead") "resolve in bundle disables DCE (keeps all defns)")
(assert (= "d 20" (run-bundle d3)) "resolve bundle runs identically")
# --- soundness: a fn reached only through a defmethod body is kept --------
(def d4 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce4"))
(write-app d4
["mmlib.clj" (string "(ns mmlib)\n"
"(defmulti shape-area :kind)\n"
"(defn rect-helper [w h] (* w h))\n"
"(defmethod shape-area :rect [s] (rect-helper (:w s) (:h s)))\n"
"(defn really-dead [x] (+ x 1))\n")
"app4.clj" (string "(ns app4 (:require [mmlib]))\n"
"(defn -main [& _] (println \"area\" (mmlib/shape-area {:kind :rect :w 3 :h 4})))\n")])
(def b4 (uber d4 "app4"))
(assert (has? b4 "rect-helper") "fn reached only via a defmethod body is kept")
(assert (not (has? b4 "really-dead")) "truly-unreachable fn dropped alongside live multimethod code")
(assert (= "area 12" (run-bundle d4)) "multimethod bundle runs identically")
(print "uberscript-dce: all cases passed")))