Tree-shake the clojure.core prelude too (whole-program DCE)

--tree-shake now shakes the clojure.core/stdlib prelude in the same reachability
graph as the app + libraries — only core fns actually reached from -main ship.

dce-blob-records reads prelude.ss with Chez `read`, unwraps each
(guard ... (def-var! "ns" "name" V)) and builds the core->core call graph from the
(var-deref/jolt-var "ns" "name") refs in V — the real emitted edges, no
re-analysis. bld-shake-all merges core + app records into one BFS; roots are -main,
side-effecting forms, and the clojure.core fns the runtime .ss shims reference by
name (enumerated in dce-runtime-core-roots). The shaken core is spliced where the
prelude.ss blob was, in original (tier) order, so load-time deps are preserved.
Bail (reachable runtime resolve) keeps the prelude whole.

Soundness follows Stalin's rule (any reference, value or call, keeps a def live):
dce-collect-refs counts :var and :the-var; non-def registration forms are always
kept (covers protocol/multimethod dispatch). Validated by make shakesmoke: the four
deps.edn git-lib apps build byte-identical output shaken vs not.

Wins (binary): build-app 9.84MB -> 8.12MB (dropped 403/457 core defs); malli-app
10.0MB -> 8.1MB; markdown 9.9 -> 8.3; commonmark 9.8 -> 8.1 — all output-identical.
build-smoke asserts an unused core fn (group-by) is dropped; full make test green.

host/chez/build-smoke.sh

@@ -96,4 +96,8 @@ fi
 if grep -q 'def-var! "jolt.analyzer"' "$out.build/flat.ss"; then
   echo "  FAIL: --tree-shake kept the compiler image in a no-eval app"; exit 1
 fi
-echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler-drop)"
+# Core is shaken: a clojure.core overlay fn this app never uses is dropped.
+if grep -q 'def-var! "clojure.core" "group-by"' "$out.build/flat.ss"; then
+  echo "  FAIL: --tree-shake kept an unreachable clojure.core fn (group-by)"; exit 1
+fi
+echo "build smoke: passed (release + optimized + direct-link + tree-shake + compiler+core shake)"

host/chez/build.ss

@@ -140,11 +140,16 @@
 ;; Inline the runtime manifest. When drop-compiler? (a closed AOT app that never
 ;; compiles from source at runtime), omit the compiler image + compile-eval shim —
 ;; the analyzer/back end are dead weight in the binary (~0.8MB).
-(define (bld-emit-runtime out drop-compiler?)
+(define (bld-emit-runtime out drop-compiler? core-strs)
   (for-each (lambda (l)
-              (unless (and drop-compiler?
+              (cond
-                           (or (bld-contains? l "seed/image.ss") (bld-contains? l "compile-eval.ss")))
+                ;; core-shake: emit the shaken clojure.core defs in place of the blob.
-                (bld-inline-line l out 0)))
+                ((and core-strs (bld-contains? l "seed/prelude.ss"))
+                 (for-each (lambda (s) (put-string out s) (put-string out "\n")) core-strs))
+                ((and drop-compiler?
+                      (or (bld-contains? l "seed/image.ss") (bld-contains? l "compile-eval.ss")))
+                 #f)
+                (else (bld-inline-line l out 0))))
             bld-runtime-manifest))
 
 ;; --- app emission -----------------------------------------------------------
@@ -153,21 +158,24 @@
 ;; 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
+;; Tree-shake the whole closed program — the clojure.core prelude (read into records
-;; def reachable from -main and from those forms; drop the rest. Bails to keep-all
+;; by dce-blob-records) AND the re-emitted app + library namespaces — over one
-;; if any form resolves vars by name at runtime. `records` is the ei-emit-ns-records
+;; reachability graph: keep every non-def form (side effects), -main, the core fns the
-;; output across all app namespaces; returns the kept Scheme strings in order.
+;; runtime shims need, and every def reachable from those; drop the rest. Bails to
-(define (bld-tree-shake records entry-main)
+;; keep-all if reachable code resolves vars by name at runtime (closed-world
-  (let ((edges (make-hashtable string-hash string=?))
+;; violation). Returns (values core-strs app-strs drop-compiler?); core-strs is #f on
-        (roots '()))
+;; a bail, signalling "inline prelude.ss unshaken".
+(define (bld-shake-all core-records app-records entry-main)
+  (let ((all (append core-records app-records))
+        (edges (make-hashtable string-hash string=?))
+        (roots (cons entry-main dce-runtime-core-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)
+              all)
-    ;; reachability from -main + every side-effecting form's refs.
     (let ((reached (make-hashtable string-hash string=?)))
-      (let bfs ((work (cons entry-main roots)))
+      (let bfs ((work roots))
         (unless (null? work)
           (let ((fq (car work)))
             (if (hashtable-ref reached fq #f)
@@ -177,31 +185,31 @@
       (let ((kept? (lambda (r) (or (vector-ref r 0) (hashtable-ref reached (vector-ref r 1) #f))))
             (refs-any (lambda (r set) (ormap (lambda (b) (and (member b (vector-ref r 2)) #t)) set)))
             (bail #f) (needs-compiler #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. Track
-        ;; whether any reachable code needs the compiler at runtime (eval/load).
         (for-each (lambda (r)
                     (when (kept? r)
                       (when (refs-any r dce-bail-refs) (set! bail #t))
                       (when (refs-any r dce-compile-refs) (set! needs-compiler #t))))
-                  records)
+                  all)
-        ;; the compiler image can be dropped only when reachability is trustworthy
+        (let ((drop-compiler? (and (not bail) (not needs-compiler)))
-        ;; (no bail) and no reachable code compiles from source at runtime.
+              ;; -> (values strs n-defs n-kept)
-        (let ((drop-compiler? (and (not bail) (not needs-compiler))))
+              (pick (lambda (recs)
+                      (let loop ((rs recs) (acc '()) (n 0) (k 0))
+                        (if (null? rs)
+                            (values (reverse acc) n k)
+                            (let* ((r (car rs)) (isdef (and (vector-ref r 1) #t)))
+                              (if (kept? r)
+                                  (loop (cdr rs) (cons (vector-ref r 3) acc)
+                                        (if isdef (+ n 1) n) (if isdef (+ k 1) k))
+                                  (loop (cdr rs) acc (if isdef (+ n 1) n) k))))))))
           (if bail
               (begin (display "jolt build: tree-shake skipped (reachable code resolves vars at runtime)\n")
-                     (values (map (lambda (r) (vector-ref r 3)) records) drop-compiler?))
+                     (values #f (map (lambda (r) (vector-ref r 3)) app-records) drop-compiler?))
-              (let ((kept '()) (ndef 0) (nkeep 0))
+              (let-values (((core-strs cn ck) (pick core-records))
-                (for-each (lambda (r)
+                           ((app-strs an ak) (pick app-records)))
-                            (when (vector-ref r 1) (set! ndef (+ ndef 1)))
+                (display (string-append "jolt build: tree-shake kept " (number->string (+ ck ak))
-                            (when (kept? r)
+                                        " of " (number->string (+ cn an)) " defs (core "
-                              (when (vector-ref r 1) (set! nkeep (+ nkeep 1)))
+                                        (number->string ck) "/" (number->string cn) ")\n"))
-                              (set! kept (cons (vector-ref r 3) kept))))
+                (values core-strs app-strs drop-compiler?))))))))
-                          records)
-                (display (string-append "jolt build: tree-shake kept " (number->string nkeep)
-                                        " of " (number->string ndef) " defs\n"))
-                (values (reverse kept) drop-compiler?))))))))
 
 ;; --- bundling: native libs + resources --------------------------------------
 ;; A jolt seq of jolt strings -> a Scheme list of Scheme strings.
@@ -295,13 +303,15 @@
         ((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
         ((var-deref "jolt.backend-scheme" "direct-link-reset!")))
       (let*-values
-          (((app-strs drop-compiler?)
+          (((core-strs app-strs drop-compiler?)
             (if tree-shake?
-                (bld-tree-shake
+                (bld-shake-all
+                  (dce-blob-records "host/chez/seed/prelude.ss")
                   (apply append
                     (map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) ordered))
                   (string-append entry-ns "/-main"))
-                (values (apply append
+                (values #f
+                        (apply append
                           (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered))
                         #f))))
         (set-optimize! #f)
@@ -316,7 +326,7 @@
         (bld-system (string-append "mkdir -p '" builddir "'"))
         ;; 3. flat source = runtime + app + launcher.
         (let ((out (open-output-file flat-ss 'replace)))
-          (bld-emit-runtime out drop-compiler?)
+          (bld-emit-runtime out drop-compiler? core-strs)
           ;; Load native libs, bake embedded resources, and point source roots at
           ;; the build-time app roots — all BEFORE the app forms. The app's
           ;; top-level forms run at binary startup (Sbuild_heap), and they include

host/chez/emit-image.ss

@@ -122,6 +122,50 @@
     "clojure.core/load-string" "clojure.core/load-file" "clojure.core/load-reader"
     "clojure.core/load"))
 
+;; clojure.core fns the runtime .ss shims reference by name (via var-deref) — they
+;; aren't visible in the IR call graph, so seed them as roots. (Found by grepping the
+;; runtime shims; the smoke harness catches a miss as a diff/crash.)
+(define dce-runtime-core-roots
+  '("clojure.core/identity" "clojure.core/isa?" "clojure.core/line-seq"
+    "clojure.core/make-hierarchy" "clojure.core/read" "clojure.core/read-string"
+    "clojure.core/read+string" "clojure.core/realized?" "clojure.core/reset!"))
+
+;; --- reading a minted blob (prelude.ss) into DCE records --------------------
+;; The prelude is a flat list of (guard CLAUSE (def-var! "ns" "name" V)) forms (+ the
+;; occasional side-effecting init). Read each with Chez `read` so it joins the
+;; reachability graph instead of being baked wholesale: a def-var! is a prunable node
+;; whose core->core edges are the (var-deref/jolt-var "ns" "name") calls in V; any
+;; other form is non-prunable (kept, refs are roots).
+(define (dce-unwrap form)
+  (if (and (pair? form) (eq? (car form) 'guard) (pair? (cddr form))) (caddr form) form))
+
+(define (dce-sexp-refs form acc)
+  (cond
+    ((and (pair? form) (memq (car form) '(var-deref jolt-var))
+          (pair? (cdr form)) (string? (cadr form)) (pair? (cddr form)) (string? (caddr form)))
+     (cons (string-append (cadr form) "/" (caddr form)) acc))
+    ((pair? form) (dce-sexp-refs (cdr form) (dce-sexp-refs (car form) acc)))
+    (else acc)))
+
+;; Records (same shape as ei-emit-ns-records) for a minted blob file. str re-serializes
+;; the read form (compiled identically; comments/whitespace are irrelevant).
+(define (dce-blob-records path)
+  (call-with-input-file path
+    (lambda (p)
+      (let loop ((acc '()))
+        (let ((form (read p)))
+          (if (eof-object? form)
+              (reverse acc)
+              (let ((b (dce-unwrap form))
+                    (str (with-output-to-string (lambda () (write form))))
+                    (refs (dce-sexp-refs form '())))
+                (loop (cons
+                        (if (and (pair? b) (eq? (car b) 'def-var!) (pair? (cdr b)) (string? (cadr b))
+                                 (pair? (cddr b)) (string? (caddr b)))
+                            (vector #f (string-append (cadr b) "/" (caddr b)) refs str)
+                            (vector #t #f refs str))
+                        acc)))))))))
+
 ;; A reference that needs the analyzer/back end at runtime (compile-from-source). If
 ;; reachable code uses none of these, the compiler image can be dropped from the
 ;; binary — the AOT app is fully compiled. (resolve/require don't need it: resolve is