From 86e77b322f3c56733f8ba3ea239cbc0ab6ab7e2c Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 21:11:47 -0400 Subject: [PATCH] tree-shake: report which reachable defs force the resolve bail When --tree-shake keeps everything because reachable code resolves vars at runtime, list the offending def -> bail-ref pairs (up to 6) instead of just saying it skipped. Makes it actionable: e.g. ring-app shows clojure.tools.logging/call-str -> ns-resolve and selmer.filters/generate-json -> resolve, so you know which library (not your code) blocks shaking. --- host/chez/build.ss | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/host/chez/build.ss b/host/chez/build.ss index ca57ed1..f2d68fc 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -184,10 +184,15 @@ (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)))) (refs-any (lambda (r set) (ormap (lambda (b) (and (member b (vector-ref r 2)) #t)) set))) - (bail #f) (needs-compiler #f)) + (bail #f) (bail-why '()) (needs-compiler #f)) (for-each (lambda (r) (when (kept? r) - (when (refs-any r dce-bail-refs) (set! bail #t)) + (for-each (lambda (b) + (when (member b (vector-ref r 2)) + (set! bail #t) + (when (< (length bail-why) 6) + (set! bail-why (cons (cons (or (vector-ref r 1) "
") b) bail-why))))) + dce-bail-refs) (when (refs-any r dce-compile-refs) (set! needs-compiler #t)))) all) (let ((drop-compiler? (and (not bail) (not needs-compiler))) @@ -202,7 +207,9 @@ (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") + (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"))) + (reverse bail-why)) (values #f (map (lambda (r) (vector-ref r 3)) app-records) drop-compiler?)) (let-values (((core-strs cn ck) (pick core-records)) ((app-strs an ak) (pick app-records)))