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:
parent
e313e02c9d
commit
0e7257ba2b
1 changed files with 24 additions and 16 deletions
|
|
@ -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"))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue