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

refactor: dynamic-wind the build's compiler-global flags (tier 1)

Browse source 
set-optimize!/set-direct-link! are process-global flags in the back end, set then
reset around the emit. A strict-form build error (failing forms error the build by
design) skipped the reset, leaving the compiler in optimize/direct-link mode for any
later in-process caller. dynamic-wind guarantees the revert. Behaviour unchanged on
the success path; both --tree-shake and --opt --direct-link build + run identically.
This commit is contained in:
Yogthos 2026-06-23 22:22:43 -04:00
parent e313e02c9d
commit 0e7257ba2b
1 changed files with 24 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

40
host/chez/build.ss
View file

@ -257,24 +257,32 @@
;; every mode. The defined-set accumulates across the dependency-ordered ;; every mode. The defined-set accumulates across the dependency-ordered
;; namespaces, so a dep's defs are direct-linkable by the time the entry that ;; namespaces, so a dep's defs are direct-linkable by the time the entry that
;; calls them is emitted. ;; calls them is emitted.
(set-optimize! (string=? mode "optimized")) ;; set-optimize!/set-direct-link! are process-global flags in the back end;
(when direct-link? ;; dynamic-wind guarantees they revert even if a strict form errors mid-emit
((var-deref "jolt.backend-scheme" "set-direct-link!") #t) ;; (a failing form errors the build by design), so the compiler isn't left in
((var-deref "jolt.backend-scheme" "direct-link-reset!"))) ;; optimize/direct-link mode for a later caller.
(let*-values (let*-values
(((core-strs app-strs drop-compiler?) (((core-strs app-strs drop-compiler?)
(if tree-shake? (dynamic-wind
(dce-shake (lambda ()
(dce-blob-records "host/chez/seed/prelude.ss") (set-optimize! (string=? mode "optimized"))
(apply append (when direct-link?
(map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) ordered)) ((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
(string-append entry-ns "/-main")) ((var-deref "jolt.backend-scheme" "direct-link-reset!"))))
(values #f (lambda ()
(apply append (if tree-shake?
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered)) (dce-shake
#f)))) (dce-blob-records "host/chez/seed/prelude.ss")
(set-optimize! #f) (apply append
((var-deref "jolt.backend-scheme" "set-direct-link!") #f) (map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) ordered))
(string-append entry-ns "/-main"))
(values #f
(apply append
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered))
#f)))
(lambda ()
(set-optimize! #f)
((var-deref "jolt.backend-scheme" "set-direct-link!") #f)))))
(when drop-compiler? (display "jolt build: dropping compiler image (no runtime eval)\n")) (when drop-compiler? (display "jolt build: dropping compiler image (no runtime eval)\n"))
(let* ((builddir (string-append out-path ".build")) (let* ((builddir (string-append out-path ".build"))
(flat-ss (string-append builddir "/flat.ss")) (flat-ss (string-append builddir "/flat.ss"))