From 04d3e192ed859aa55d8e4412c796a953242d8ad5 Mon Sep 17 00:00:00 2001 From: Dmitri Sotnikov Date: Mon, 15 Jun 2026 22:25:44 +0000 Subject: [PATCH] Dead-code elimination in `jolt uberscript` (jolt-atg) (#130) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- src/jolt/main.janet | 92 +++++++++++++++++++++- src/jolt/reader.janet | 35 ++++++++ test/integration/uberscript-dce-test.janet | 86 ++++++++++++++++++++ 3 files changed, 211 insertions(+), 2 deletions(-) create mode 100644 test/integration/uberscript-dce-test.janet diff --git a/src/jolt/main.janet b/src/jolt/main.janet index 44d2b2a..536f66d 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -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") diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index 3b61731..4769f1d 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -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) diff --git a/test/integration/uberscript-dce-test.janet b/test/integration/uberscript-dce-test.janet new file mode 100644 index 0000000..04a3a3b --- /dev/null +++ b/test/integration/uberscript-dce-test.janet @@ -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")))