From 75ac93689b983735bdf9cb9bb0fedf9fa6a3e84b Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 19:45:13 -0400 Subject: [PATCH] Tree-shaking: drop library code unreachable from -main (lever 3/4) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `jolt build --tree-shake` (or deps.edn :jolt/build {:tree-shake true}) does reachability DCE over the re-emitted app + library namespaces: keep -main, every side-effecting (non-def) top-level form, and every def reachable from those; drop the rest. A macro (expanded at AOT, never called at runtime) is prunable too. Sound: bails (keeps everything) if REACHABLE code resolves vars by name at runtime (eval/resolve/ns-resolve/requiring-resolve/find-var/intern/load-string/...), which a static call graph can't follow. Unreached eval-using library code is simply shaken away and never triggers the bail. clojure.core and the compiler image stay baked (prelude + image blobs), so only re-emitted namespaces are shaken for now. The reachability machinery is in emit-image.ss (records: keep?/fqn/refs/str via reduce-ir-children) + build.ss (BFS + bail check). build-smoke covers it (drops the unreachable `twice` macro, output unchanged). Opt-in; default builds are untouched. full make test green. Scope note: this shakes the re-emitted app/lib code only. Measurement shows jolt's compiled code is ~5.8MB of a ~9.8MB binary, dominated by the clojure.core prelude (~1.5-2MB) and the compiler image (~0.8MB) — both baked blobs this pass doesn't touch. Those (shake-core, drop-compiler-when-no-eval) are the larger footprint wins, filed as follow-ups. --- host/chez/build-smoke.sh | 16 +++++++++- host/chez/build.ss | 63 ++++++++++++++++++++++++++++++++++++---- host/chez/emit-image.ss | 61 ++++++++++++++++++++++++++++++++++++++ jolt-core/jolt/main.clj | 9 ++++-- 4 files changed, 139 insertions(+), 10 deletions(-) diff --git a/host/chez/build-smoke.sh b/host/chez/build-smoke.sh index eca8402..5686462 100755 --- a/host/chez/build-smoke.sh +++ b/host/chez/build-smoke.sh @@ -78,4 +78,18 @@ fi if ! grep -q '(jv\$app.util\$shout' "$out.build/flat.ss"; then echo " FAIL: --direct-link did not emit a direct app->app call"; exit 1 fi -echo "build smoke: passed (release + optimized + direct-link)" +# Tree-shaking (opt-in): same result, and an unreachable def (the `twice` macro, +# expanded at AOT and never called at runtime) is dropped. +if ! JOLT_PWD="$app" bin/joltc build -m app.core -o "$out" --tree-shake >/dev/null 2>&1; then + echo " FAIL: jolt build --tree-shake exited non-zero"; exit 1 +fi +got_ts="$(cd / && "$out" alpha bb ccc 2>&1)" +if [ "$got_ts" != "$want" ]; then + echo " FAIL: --tree-shake binary output mismatch" + echo "--- got ----"; echo "$got_ts" + exit 1 +fi +if grep -q 'def-var! "app.util" "twice"' "$out.build/flat.ss"; then + echo " FAIL: --tree-shake did not drop the unreachable twice macro"; exit 1 +fi +echo "build smoke: passed (release + optimized + direct-link + tree-shake)" diff --git a/host/chez/build.ss b/host/chez/build.ss index fc8e8da..07d6109 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -146,6 +146,51 @@ ;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f). (define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f)) +;; Tree-shake the re-emitted forms: keep every non-def form (side effects) + every +;; def reachable from -main and from those forms; drop the rest. Bails to keep-all +;; if any form resolves vars by name at runtime. `records` is the ei-emit-ns-records +;; output across all app namespaces; returns the kept Scheme strings in order. +(define (bld-tree-shake records entry-main) + (let ((edges (make-hashtable string-hash string=?)) + (roots '())) + (for-each (lambda (r) + (if (vector-ref r 0) + (set! roots (append (vector-ref r 2) roots)) + (hashtable-set! edges (vector-ref r 1) (vector-ref r 2)))) + records) + ;; reachability from -main + every side-effecting form's refs. + (let ((reached (make-hashtable string-hash string=?))) + (let bfs ((work (cons entry-main roots))) + (unless (null? work) + (let ((fq (car work))) + (if (hashtable-ref reached fq #f) + (bfs (cdr work)) + (begin (hashtable-set! reached fq #t) + (bfs (append (or (hashtable-ref edges fq #f) '()) (cdr work)))))))) + (let ((kept? (lambda (r) (or (vector-ref r 0) (hashtable-ref reached (vector-ref r 1) #f)))) + (bail #f)) + ;; bail only if REACHABLE code resolves vars by name — then the static call + ;; graph is incomplete and dropping anything is unsound. Unreached eval-using + ;; library code is simply shaken away and never triggers the bail. + (for-each (lambda (r) + (when (and (kept? r) + (ormap (lambda (b) (and (member b (vector-ref r 2)) #t)) dce-bail-refs)) + (set! bail #t))) + records) + (if bail + (begin (display "jolt build: tree-shake skipped (reachable code resolves vars at runtime)\n") + (map (lambda (r) (vector-ref r 3)) records)) + (let ((kept '()) (ndef 0) (nkeep 0)) + (for-each (lambda (r) + (when (vector-ref r 1) (set! ndef (+ ndef 1))) + (when (kept? r) + (when (vector-ref r 1) (set! nkeep (+ nkeep 1))) + (set! kept (cons (vector-ref r 3) kept)))) + records) + (display (string-append "jolt build: tree-shake kept " (number->string nkeep) + " of " (number->string ndef) " defs\n")) + (reverse kept))))))) + ;; --- bundling: native libs + resources -------------------------------------- ;; A jolt seq of jolt strings -> a Scheme list of Scheme strings. (define (bld-strs x) (map jolt-str-render-one (seq->list x))) @@ -214,7 +259,7 @@ ;; direct-link?: opt-in closed-world direct-linking (app->app calls bind directly, ;; no runtime redefinition). Off by default in every mode — release stays ;; dynamically linked. -(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots direct-link?) +(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots direct-link? tree-shake?) (bld-check-toolchain) ;; 1. record app namespaces in dependency order as they finish loading. (let ((app-order '())) @@ -237,9 +282,15 @@ (when direct-link? ((var-deref "jolt.backend-scheme" "set-direct-link!") #t) ((var-deref "jolt.backend-scheme" "direct-link-reset!"))) - (let* ((app-strs (apply append - (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) - ordered))) + (let* ((app-strs (if tree-shake? + (bld-tree-shake + (apply append + (map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) + ordered)) + (string-append entry-ns "/-main")) + (apply append + (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) + ordered)))) (_ (set-optimize! #f)) (_ ((var-deref "jolt.backend-scheme" "set-direct-link!") #f)) (builddir (string-append out-path ".build")) @@ -329,9 +380,9 @@ (display (string-append "jolt build: wrote " out-path "\n")))))) (def-var! "jolt.host" "build-binary" - (lambda (entry out mode natives embed-dirs ext-roots direct-link?) + (lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake?) (build-binary (jolt-str-render-one entry) (jolt-str-render-one out) (jolt-str-render-one mode) - natives embed-dirs ext-roots (jolt-truthy? direct-link?)) + natives embed-dirs ext-roots (jolt-truthy? direct-link?) (jolt-truthy? tree-shake?)) jolt-nil)) diff --git a/host/chez/emit-image.ss b/host/chez/emit-image.ss index 03ef0ac..e754499 100644 --- a/host/chez/emit-image.ss +++ b/host/chez/emit-image.ss @@ -84,6 +84,67 @@ (define (ei-emit-ns ns-name src) (ei-emit-ns* ns-name src #f #t)) +;; --- tree-shaking (jolt build --tree-shake) --------------------------------- +;; Reachability DCE over the re-emitted app + library forms: keep -main, every +;; side-effecting (non-def) top-level form, and every def reachable from those; +;; drop the rest (unused library code). Bails (keeps everything) if the app resolves +;; vars by name at runtime (eval/resolve/...), which static reachability can't +;; follow. clojure.core / the compiler stay baked (the prelude + image blobs), so +;; only the re-emitted namespaces are shaken. +(define dce-kw-op (keyword #f "op")) +(define dce-kw-var (keyword #f "var")) +(define dce-kw-def (keyword #f "def")) +(define dce-kw-ns (keyword #f "ns")) +(define dce-kw-name (keyword #f "name")) +(define dce-reduce-children (var-deref "jolt.ir" "reduce-ir-children")) + +;; "ns/name" of every :var reference anywhere in node, prepended to acc. Arg order +;; (acc node) matches reduce-ir-children's fold fn, so it nests directly. +(define (dce-collect-refs acc node) + (if (eq? (jolt-get node dce-kw-op) dce-kw-var) + (cons (string-append (jolt-get node dce-kw-ns) "/" (jolt-get node dce-kw-name)) acc) + (dce-reduce-children dce-collect-refs acc node))) + +;; The fqn of a bare top-level def (the only prunable form), else #f. +(define (dce-def-fqn node) + (and (eq? (jolt-get node dce-kw-op) dce-kw-def) + (string-append (jolt-get node dce-kw-ns) "/" (jolt-get node dce-kw-name)))) + +;; A reference whose presence forces keep-everything (runtime name resolution). +(define dce-bail-refs + '("clojure.core/eval" "clojure.core/resolve" "clojure.core/ns-resolve" + "clojure.core/requiring-resolve" "clojure.core/find-var" "clojure.core/intern" + "clojure.core/load-string" "clojure.core/load-file" "clojure.core/load-reader" + "clojure.core/load")) + +;; One record per form: (vector keep? fqn refs str). keep? #t = a non-def form, +;; always emitted, its refs are reachability roots; #f = a prunable def emitted only +;; if fqn is reached. A macro is a prunable def (its expander isn't called at runtime +;; in an AOT build). Strict (no guard) like the build's ei-emit-ns* path. +(define (ei-emit-ns-records ns-name src) + (let loop ((forms (ei-read-all src)) (acc '())) + (if (null? forms) + (reverse acc) + (let ((f (car forms))) + (ce-scan-requires! f ns-name) + (cond + ((ei-ns-form? f) (loop (cdr forms) acc)) + ((ce-macro-form? f) + (let-values (((nm fn-form) (ce-defmacro->fn f))) + (let* ((ctx (make-analyze-ctx ns-name)) + (ir (jolt-ce-run-passes (jolt-ce-analyze ctx fn-form) ctx)) + (str (ei-macro-string ns-name nm (jolt-ce-emit-top ir) #f)) + (refs (dce-collect-refs '() ir))) + (loop (cdr forms) (cons (vector #f (string-append ns-name "/" nm) refs str) acc))))) + (else + (let* ((ctx (make-analyze-ctx ns-name)) + (ir (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx)) + (str (jolt-ce-emit-top ir)) + (fqn (dce-def-fqn ir)) + (refs (dce-collect-refs '() ir))) + (loop (cdr forms) + (cons (if fqn (vector #f fqn refs str) (vector #t #f refs str)) acc))))))))) + ;; Scheme string literal for a ns/name — uses the runtime's own writer ;; (printable ASCII identifiers only here). (define (ei-str-lit s) (with-output-to-string (lambda () (write s)))) diff --git a/jolt-core/jolt/main.clj b/jolt-core/jolt/main.clj index 090a495..d0f5d59 100644 --- a/jolt-core/jolt/main.clj +++ b/jolt-core/jolt/main.clj @@ -170,10 +170,13 @@ natives (encode-natives (:natives resolved)) ;; closed-world direct-linking is opt-in: the --direct-link flag or a ;; deps.edn :jolt/build {:direct-link true}. Off otherwise. - direct-link? (boolean (or (some #{"--direct-link"} more) (:direct-link build)))] + direct-link? (boolean (or (some #{"--direct-link"} more) (:direct-link build))) + ;; tree-shaking (drop library code not reachable from -main): --tree-shake + ;; or deps.edn :jolt/build {:tree-shake true}. + tree-shake? (boolean (or (some #{"--tree-shake"} more) (:tree-shake build)))] ;; embed-dirs (absolute) are walked + baked into the binary by the driver; ;; project-paths (relative) become runtime io/resource roots (ship-alongside). - (jolt.host/build-binary entry out mode natives embed-dirs project-paths direct-link?))))) + (jolt.host/build-binary entry out mode natives embed-dirs project-paths direct-link? tree-shake?))))) (defn- nrepl [more] ;; resolve the project (deps on the roots, native libs loaded), then start the @@ -191,7 +194,7 @@ (println "usage: jolt [args]") (println " run -m NS [args] resolve deps.edn, load NS, call its -main") (println " run FILE load a Clojure file") - (println " build -m NS [-o OUT] [--opt|--dev] [--direct-link] compile a standalone binary") + (println " build -m NS [-o OUT] [--opt|--dev] [--direct-link] [--tree-shake] compile a standalone binary") (println " -M:alias [args] run the alias's :main-opts") (println " -A:alias [args] add the alias's paths/deps") (println " repl start a line REPL")