Provide configurable tree shaking

CHANGELOG.md

@@ -7,6 +7,50 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+### Added
+
+- **A `deps.edn` can vouch for a runtime var lookup, so `--tree-shake` proceeds
+  past it.** The shake bails, and must, when reachable code resolves a var by
+  name: the static graph cannot follow a runtime name. But some of those sites
+  are dead in a built binary and the author can prove it, and one `s/def` was
+  enough to lose the whole shake — spec.alpha's `res` only qualifies a symbol
+  so a spec's form can be printed, and spec.gen's `dynaload` sits behind a
+  `delay` nothing forces. `:jolt/tree-shake {:allow-dynamic [ns/name …]}` in
+  the app's `deps.edn` or any library's names the defs the author vouches for,
+  read where `:jolt/native` is read and unioned, so a library ships its list
+  once for every app that uses it. Nothing is kept on an allowed def's behalf.
+  With no declaration the shake bails exactly as before.
+
+  An allowed def is skipped by the compiler-needed scan as well as the bail
+  scan, on purpose: a site vouched never to run needs no compiler, and skipping
+  only the bail scan would let an allowed `eval` caller shake without dropping
+  the compiler image, which breaks the "a shake that does not bail drops it"
+  invariant `make shakelocal` asserts.
+
+  The bail message lists each site once — the IR-walk-plus-text-scan ref union
+  had it printing every line twice — and ends with the paste-ready key for
+  every def it named:
+
+  ```
+  jolt build: tree-shake skipped (reachable code resolves vars at runtime):
+    clojure.spec.alpha/res -> clojure.core/resolve
+  to proceed, if these never run in the built binary, add to deps.edn:
+    :jolt/tree-shake {:allow-dynamic [clojure.spec.alpha/res]}
+  ```
+
+  The def to name is the one the lookup ended up in: the inline pass splices a
+  small helper into its callers, and the bail then names the caller. The hint
+  prints that name, so paste what it prints rather than the fn that wrote the
+  call.
+
+  `test/chez/allow-dynamic-app` is the build-level gate — the app's own `res`
+  and a `:local/root` library's `dynaload`, each vouched for by its own
+  `deps.edn`, must shake and prune `dead` — and `allow-dynamic-partial-app`
+  adds one caller nothing vouches for and must still bail with a hint naming
+  that caller alone. Verified by mutation: dropping either declaration bails
+  the shaking fixture. `run-dce-refs.ss` pins the semantics on a synthetic
+  graph, including that an unreachable allowed def is still pruned. (#890)
+
 ### Performance
 
 - **A hinted `(aset ^bytes a i v)` stores into the bytevector, and `(byte x)` is

README.md

@@ -440,6 +440,24 @@ library responsible — when reachable code resolves vars by name at runtime
 (`eval`/`resolve`/`ns-resolve`/…). See
 [RFC 0007](https://jolt-lang.github.io/docs/rfc/0007-compilation-modes-and-binary-output.html).
 
+When the site it names is dead in a built binary and you can say why — spec's
+`res` only qualifies a symbol for a description, spec.gen's `dynaload` sits
+behind a `delay` nothing forces — a `deps.edn` can vouch for it and the shake
+proceeds past it, keeping nothing extra:
+
+```clojure
+:jolt/tree-shake {:allow-dynamic [clojure.spec.alpha/res
+                                  clojure.spec.gen.alpha/dynaload]}
+```
+
+The key is read from the app's `deps.edn` and from every library's, and
+unioned, so a library ships its list once for every app that uses it. The bail
+message ends with the exact line to paste for the sites that remain; paste
+what it prints, because the def to name is the one the lookup ended up in
+after inlining, which may be the caller of the fn that wrote it. An allowed
+def is skipped by the compiler-image check too: a lookup vouched never to run
+needs no compiler.
+
 Built executables carry an optional startup profiler: launch one with
 `JOLT_STARTUP_PROFILE=1` to get per-stage wall time, process CPU time,
 collection counts, reclaimed bytes, and heap size on stderr, marked at the

host/chez/build.ss

@@ -1133,6 +1133,10 @@
 ;; natives: encoded :jolt/native libs to load at startup. embed-dirs: dirs whose
 ;; files bake into the binary (single-file). ext-roots: project-relative io/resource
 ;; roots resolved at runtime against JOLT_PWD (ship-alongside resources).
+;; allow-dynamic: "ns/name" strings the project and its deps vouch never resolve
+;; vars at runtime in the built binary (deps.edn :jolt/tree-shake {:allow-dynamic
+;; […]}); dce-shake skips them in its bail and compiler-needed scans (see
+;; dce-bail-scan). '() when nothing declared one.
 ;; direct-link?: closed-world direct-linking (app->app calls bind directly; a plain
 ;; def is frozen, ^:redef/^:dynamic stay var-routed). The caller (jolt.main) turns
 ;; this ON for release and optimized and OFF for --dev / --no-direct-link.
@@ -1343,7 +1347,7 @@
           (for-each (lambda (p) (put-string out (string-append "\n    " (car p) " " (cdr p)))) pairs)
           (put-string out "))\n"))))))
 
-(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots direct-link? tree-shake? library?)
+(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots direct-link? tree-shake? allow-dynamic library?)
   (ei-profile-init!)
   ;; Windows executables carry .exe; normalize here so the append-payload and
   ;; cc paths agree and the shell can run the result. A library keeps its own
@@ -1559,7 +1563,8 @@
                                           per-ns)))
                               (loopfe (cdr rest))))
                           (apply append (reverse per-ns))))
-                        (string-append entry-ns "/-main"))
+                        (string-append entry-ns "/-main")
+                        allow-dynamic)
                       (values
                         #f
                         ;; EAGER per-ns accumulation, NOT (apply append (map …)):
@@ -2330,26 +2335,36 @@
       "-o '" out-path "' " native-link " " (bld-link-libs))))
   (display (string-append "jolt build: wrote " out-path "\n")))
 
-;; optional trailing (target target-pack): a Chez machine string + a prepared
-;; target pack dir when cross-compiling (jolt build --target). Absent/nil = host.
+;; optional trailing (target target-pack allow-dynamic): a Chez machine string + a
+;; prepared target pack dir when cross-compiling (jolt build --target) — absent/nil
+;; = host — then the :allow-dynamic list (bld-opt-strs).
 (define (bld-opt-str opt i)
   (let loop ((o opt) (i i))
     (cond ((or (null? o) (< i 0)) #f)
           ((= i 0) (and (not (jolt-nil? (car o))) (jolt-str-render-one (car o))))
           (else (loop (cdr o) (- i 1))))))
+;; optional trailing (allow-dynamic), index 2: a vector of "ns/name" strings
+;; (see build-binary). Absent/nil = '().
+(define (bld-opt-strs opt i)
+  (let loop ((o opt) (i i))
+    (cond ((or (null? o) (< i 0)) '())
+          ((= i 0) (if (jolt-nil? (car o)) '() (bld-strs (car o))))
+          (else (loop (cdr o) (- i 1))))))
 (def-var! "jolt.host" "build-binary"
   (lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake? . opt)
     (parameterize ((bld-target (bld-opt-str opt 0)) (bld-target-pack (bld-opt-str opt 1)))
       (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?) (jolt-truthy? tree-shake?) #f))
+                    natives embed-dirs ext-roots (jolt-truthy? direct-link?) (jolt-truthy? tree-shake?)
+                    (bld-opt-strs opt 2) #f))
     jolt-nil))
 (def-var! "jolt.host" "build-library"
   (lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake? . opt)
     (parameterize ((bld-target (bld-opt-str opt 0)) (bld-target-pack (bld-opt-str opt 1)))
       (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?) (jolt-truthy? tree-shake?) #t))
+                    natives embed-dirs ext-roots (jolt-truthy? direct-link?) (jolt-truthy? tree-shake?)
+                    (bld-opt-strs opt 2) #t))
     jolt-nil))

host/chez/dce.ss

@@ -3,7 +3,8 @@
 ;; Build one call graph over the re-emitted app + libraries AND the clojure.core
 ;; prelude, keep -main + every side-effecting top-level form + everything reachable
 ;; from those, drop the rest. Bails (keeps everything) if reachable code resolves a
-;; var by name at runtime (eval/resolve/...), which a static graph can't follow. Per
+;; var by name at runtime (eval/resolve/...), which a static graph can't follow —
+;; unless a deps.edn vouches for that def (:jolt/tree-shake {:allow-dynamic […]}). Per
 ;; Stalin's rule, ANY reference — a call OR a value/#'x — keeps its target live, so a
 ;; fn passed to map or referenced as #'x is never dropped.
 ;;
@@ -312,28 +313,50 @@
   (or (dce-rec-keep? r) (hashtable-ref reached (dce-rec-fqn r) #f)))
 
 ;; Scan the KEPT records: does any resolve a var at runtime (bail), and does any need
-;; the compiler? Returns (values bail? bail-why needs-compiler?). bail-why is up to 6
-;; (def . bail-ref) pairs for the diagnostic. Uses hash sets for O(1) membership
-;; instead of O(n*m) linear scans over the bail/compile lists.
-(define (dce-bail-scan records reached)
-  (let ((bail #f) (why '()) (needs-compiler #f)
+;; the compiler? Returns (values bail? bail-why bail-hint needs-compiler?). bail-why
+;; is up to 6 DISTINCT (def . bail-ref) pairs for the diagnostic — distinct because
+;; dce-app-refs unions an IR walk with a text scan, so one call is usually two refs,
+;; and each line printed twice. bail-hint is every distinct def that bailed
+;; (uncapped, first-seen order) for the paste-ready key. Uses hash sets for O(1)
+;; membership instead of O(n*m) linear scans over the lists.
+;;
+;; allow: "ns/name" strings from deps.edn :jolt/tree-shake {:allow-dynamic […]} —
+;; callers pass the union of the app's and every library's; a list, '() when
+;; nothing is declared, never #f. A def in the set is skipped by BOTH scans: the
+;; author is asserting its lookup never runs in the built binary (or names only
+;; vars the graph keeps anyway), and a site that never runs needs no compiler
+;; either. Nothing is kept on an allowed def's behalf — it enters the graph
+;; exactly as before, and the scan is the only place the set is consulted. A
+;; top-level non-def form has no fqn and cannot be allowed by name. The fqn to
+;; allow is the def the ref ended up IN — after the inline pass that is the
+;; caller of a spliced helper, not the helper — which is why the hint prints the
+;; name rather than leaving it to the reader to derive.
+(define (dce-bail-scan records reached allow)
+  (let ((bail #f) (why '()) (hint '()) (needs-compiler #f)
         (bail-ht (make-hashtable string-hash string=?))
-        (compile-ht (make-hashtable string-hash string=?)))
+        (compile-ht (make-hashtable string-hash string=?))
+        (allow-ht (make-hashtable string-hash string=?)))
     (for-each (lambda (b) (hashtable-set! bail-ht b #t)) dce-bail-refs)
     (for-each (lambda (c) (hashtable-set! compile-ht c #t)) dce-compile-refs)
+    (for-each (lambda (a) (hashtable-set! allow-ht a #t)) allow)
     (for-each
       (lambda (r)
-        (when (dce-rec-reached? r reached)
-          (for-each (lambda (ref)
-                      (when (hashtable-ref bail-ht ref #f)
-                        (set! bail #t)
-                        (when (< (length why) 6)
-                          (set! why (cons (cons (or (dce-rec-fqn r) "<form>") ref) why)))))
-                    (dce-rec-refs r))
-          (when (ormap (lambda (ref) (and (hashtable-ref compile-ht ref #f) #t)) (dce-rec-refs r))
-            (set! needs-compiler #t))))
+        (let ((fqn (dce-rec-fqn r)))
+          (when (and (dce-rec-reached? r reached)
+                     (not (and fqn (hashtable-ref allow-ht fqn #f))))
+            (for-each (lambda (ref)
+                        (when (hashtable-ref bail-ht ref #f)
+                          (set! bail #t)
+                          (let ((pair (cons (or fqn "<form>") ref)))
+                            (when (and (< (length why) 6) (not (member pair why)))
+                              (set! why (cons pair why))))
+                          (when (and fqn (not (member fqn hint)))
+                            (set! hint (cons fqn hint)))))
+                      (dce-rec-refs r))
+            (when (ormap (lambda (ref) (and (hashtable-ref compile-ht ref #f) #t)) (dce-rec-refs r))
+              (set! needs-compiler #t)))))
       records)
-    (values bail (reverse why) needs-compiler)))
+    (values bail (reverse why) (reverse hint) needs-compiler)))
 
 ;; Kept records -> (values kept-strings n-defs n-kept-defs).
 (define (dce-partition records reached)
@@ -346,8 +369,10 @@
               (loop (cdr rs) acc (if isdef (+ n 1) n) k))))))
 
 ;; Returns (values core-strs app-strs drop-compiler?). core-strs is #f on a bail,
-;; signalling "inline prelude.ss unshaken" + keep the compiler.
-(define (dce-shake core-records app-records entry-main)
+;; signalling "inline prelude.ss unshaken" + keep the compiler. allow: see
+;; dce-bail-scan. On a bail the diagnostic ends with the deps.edn key that would
+;; allow every def it named, so the path from "skipped" to "kept" is one paste.
+(define (dce-shake core-records app-records entry-main allow)
   (let-values (((edges roots spliced)
                 (dce-build-graph (append core-records app-records) entry-main)))
     (let* ((reached (dce-reachable edges roots))
@@ -356,12 +381,16 @@
            (kept (if (null? spliced)
                      reached
                      (dce-reachable edges (append spliced roots)))))
-      (let-values (((bail why needs-compiler) (dce-bail-scan (append core-records app-records) reached)))
+      (let-values (((bail why hint needs-compiler)
+                    (dce-bail-scan (append core-records app-records) reached allow)))
         (let ((drop-compiler? (and (not bail) (not needs-compiler))))
           (if bail
               (begin
                 (display "jolt build: tree-shake skipped (reachable code resolves vars at runtime):\n")
                 (for-each (lambda (w) (display (string-append "  " (car w) " -> " (cdr w) "\n"))) why)
+                (unless (null? hint)
+                  (display "to proceed, if these never run in the built binary, add to deps.edn:\n")
+                  (display (string-append "  :jolt/tree-shake {:allow-dynamic [" (jolt-str-join hint) "]}\n")))
                 (values #f (map dce-rec-str app-records) drop-compiler?))
               (let-values (((core-strs cn ck) (dce-partition core-records kept))
                            ((app-strs an ak) (dce-partition app-records kept)))