Merge pull request #182 from jolt-lang/spike/tree-shaking
Tree-shaking: drop unreachable library code (footprint, opt-in)
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
20c5b92ea8
4 changed files with 139 additions and 10 deletions
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(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)))
|
||||
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))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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 <command> [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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue