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

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

View file

@ -257,12 +257,19 @@
;; 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!/set-direct-link! are process-global flags in the back end;
;; dynamic-wind guarantees they revert even if a strict form errors mid-emit
;; (a failing form errors the build by design), so the compiler isn't left in
;; optimize/direct-link mode for a later caller.
(let*-values
(((core-strs app-strs drop-compiler?)
(dynamic-wind
(lambda ()
(set-optimize! (string=? mode "optimized")) (set-optimize! (string=? mode "optimized"))
(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*-values (lambda ()
(((core-strs app-strs drop-compiler?)
(if tree-shake? (if tree-shake?
(dce-shake (dce-shake
(dce-blob-records "host/chez/seed/prelude.ss") (dce-blob-records "host/chez/seed/prelude.ss")
@ -272,9 +279,10 @@
(values #f (values #f
(apply append (apply append
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered)) (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered))
#f)))) #f)))
(lambda ()
(set-optimize! #f) (set-optimize! #f)
((var-deref "jolt.backend-scheme" "set-direct-link!") #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"))