simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #183 from jolt-lang/spike/compiler-drop

Browse source 
Drop the compiler image from no-eval binaries (footprint)
This commit is contained in:
Dmitri Sotnikov 2026-06-24 00:08:03 +00:00 • committed by GitHub
commit 709d152a1e
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
3 changed files with 61 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

6
host/chez/build-smoke.sh
View file

@ -92,4 +92,8 @@ fi
if grep -q 'def-var! "app.util" "twice"' "$out.build/flat.ss"; then 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 echo " FAIL: --tree-shake did not drop the unreachable twice macro"; exit 1
fi fi
echo "build smoke: passed (release + optimized + direct-link + tree-shake)" # The app never evals, so the compiler image (analyzer/back end) is dropped.
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)"

82
host/chez/build.ss
View file

@ -137,8 +137,15 @@
(for-each (lambda (l) (bld-inline-line l out (+ depth 1))) (bld-file-lines p)) (for-each (lambda (l) (bld-inline-line l out (+ depth 1))) (bld-file-lines p))
(begin (put-string out line) (put-string out "\n"))))) (begin (put-string out line) (put-string out "\n")))))
(define (bld-emit-runtime out) ;; Inline the runtime manifest. When drop-compiler? (a closed AOT app that never
(for-each (lambda (l) (bld-inline-line l out 0)) bld-runtime-manifest)) ;; 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?)
(for-each (lambda (l)
(unless (and drop-compiler?
(or (bld-contains? l "seed/image.ss") (bld-contains? l "compile-eval.ss")))
(bld-inline-line l out 0)))
bld-runtime-manifest))
;; --- app emission ----------------------------------------------------------- ;; --- app emission -----------------------------------------------------------
;; Re-emit one app namespace to a list of Scheme strings: optimize (run-passes) ;; Re-emit one app namespace to a list of Scheme strings: optimize (run-passes)
@ -168,28 +175,33 @@
(begin (hashtable-set! reached fq #t) (begin (hashtable-set! reached fq #t)
(bfs (append (or (hashtable-ref edges fq #f) '()) (cdr work)))))))) (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)))) (let ((kept? (lambda (r) (or (vector-ref r 0) (hashtable-ref reached (vector-ref r 1) #f))))
(bail #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 ;; bail only if REACHABLE code resolves vars by name — then the static call
;; graph is incomplete and dropping anything is unsound. Unreached eval-using ;; graph is incomplete and dropping anything is unsound. Unreached eval-using
;; library code is simply shaken away and never triggers the bail. ;; 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) (for-each (lambda (r)
(when (and (kept? r) (when (kept? r)
(ormap (lambda (b) (and (member b (vector-ref r 2)) #t)) dce-bail-refs)) (when (refs-any r dce-bail-refs) (set! bail #t))
(set! bail #t))) (when (refs-any r dce-compile-refs) (set! needs-compiler #t))))
records) records)
(if bail ;; the compiler image can be dropped only when reachability is trustworthy
(begin (display "jolt build: tree-shake skipped (reachable code resolves vars at runtime)\n") ;; (no bail) and no reachable code compiles from source at runtime.
(map (lambda (r) (vector-ref r 3)) records)) (let ((drop-compiler? (and (not bail) (not needs-compiler))))
(let ((kept '()) (ndef 0) (nkeep 0)) (if bail
(for-each (lambda (r) (begin (display "jolt build: tree-shake skipped (reachable code resolves vars at runtime)\n")
(when (vector-ref r 1) (set! ndef (+ ndef 1))) (values (map (lambda (r) (vector-ref r 3)) records) drop-compiler?))
(when (kept? r) (let ((kept '()) (ndef 0) (nkeep 0))
(when (vector-ref r 1) (set! nkeep (+ nkeep 1))) (for-each (lambda (r)
(set! kept (cons (vector-ref r 3) kept)))) (when (vector-ref r 1) (set! ndef (+ ndef 1)))
records) (when (kept? r)
(display (string-append "jolt build: tree-shake kept " (number->string nkeep) (when (vector-ref r 1) (set! nkeep (+ nkeep 1)))
" of " (number->string ndef) " defs\n")) (set! kept (cons (vector-ref r 3) kept))))
(reverse kept))))))) 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 -------------------------------------- ;; --- bundling: native libs + resources --------------------------------------
;; A jolt seq of jolt strings -> a Scheme list of Scheme strings. ;; A jolt seq of jolt strings -> a Scheme list of Scheme strings.
@ -282,18 +294,20 @@
(when direct-link? (when direct-link?
((var-deref "jolt.backend-scheme" "set-direct-link!") #t) ((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
((var-deref "jolt.backend-scheme" "direct-link-reset!"))) ((var-deref "jolt.backend-scheme" "direct-link-reset!")))
(let* ((app-strs (if tree-shake? (let*-values
(bld-tree-shake (((app-strs drop-compiler?)
(apply append (if tree-shake?
(map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) (bld-tree-shake
ordered)) (apply append
(string-append entry-ns "/-main")) (map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) ordered))
(apply append (string-append entry-ns "/-main"))
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) (values (apply append
ordered)))) (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered))
(_ (set-optimize! #f)) #f))))
(_ ((var-deref "jolt.backend-scheme" "set-direct-link!") #f)) (set-optimize! #f)
(builddir (string-append out-path ".build")) ((var-deref "jolt.backend-scheme" "set-direct-link!") #f)
(when drop-compiler? (display "jolt build: dropping compiler image (no runtime eval)\n"))
(let* ((builddir (string-append out-path ".build"))
(flat-ss (string-append builddir "/flat.ss")) (flat-ss (string-append builddir "/flat.ss"))
(flat-so (string-append builddir "/flat.so")) (flat-so (string-append builddir "/flat.so"))
(boot (string-append builddir "/jolt.boot")) (boot (string-append builddir "/jolt.boot"))
@ -302,7 +316,7 @@
(bld-system (string-append "mkdir -p '" builddir "'")) (bld-system (string-append "mkdir -p '" builddir "'"))
;; 3. flat source = runtime + app + launcher. ;; 3. flat source = runtime + app + launcher.
(let ((out (open-output-file flat-ss 'replace))) (let ((out (open-output-file flat-ss 'replace)))
(bld-emit-runtime out) (bld-emit-runtime out drop-compiler?)
;; Load native libs, bake embedded resources, and point source roots at ;; Load native libs, bake embedded resources, and point source roots at
;; the build-time app roots — all BEFORE the app forms. The app's ;; 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 ;; top-level forms run at binary startup (Sbuild_heap), and they include
@ -377,7 +391,7 @@
(bld-system (string-append (bld-system (string-append
"cc -O2 -I'" bld-csv-dir "' '" main-c "' '" bld-csv-dir "/libkernel.a' " "cc -O2 -I'" bld-csv-dir "' '" main-c "' '" bld-csv-dir "/libkernel.a' "
"-o '" out-path "' " (bld-link-libs))) "-o '" out-path "' " (bld-link-libs)))
(display (string-append "jolt build: wrote " out-path "\n")))))) (display (string-append "jolt build: wrote " out-path "\n")))))))
(def-var! "jolt.host" "build-binary" (def-var! "jolt.host" "build-binary"
(lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake?) (lambda (entry out mode natives embed-dirs ext-roots direct-link? tree-shake?)

8
host/chez/emit-image.ss
View file

@ -117,6 +117,14 @@
"clojure.core/load-string" "clojure.core/load-file" "clojure.core/load-reader" "clojure.core/load-string" "clojure.core/load-file" "clojure.core/load-reader"
"clojure.core/load")) "clojure.core/load"))
;; 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
;; a var-table lookup; a require of a baked ns no-ops.)
(define dce-compile-refs
'("clojure.core/eval" "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, ;; 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 ;; 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 ;; if fqn is reached. A macro is a prunable def (its expander isn't called at runtime