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,24 +257,32 @@
|
|||
;; 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
|
||||
;; calls them is emitted.
|
||||
(set-optimize! (string=? mode "optimized"))
|
||||
(when direct-link?
|
||||
((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
|
||||
((var-deref "jolt.backend-scheme" "direct-link-reset!")))
|
||||
;; 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?)
|
||||
(if tree-shake?
|
||||
(dce-shake
|
||||
(dce-blob-records "host/chez/seed/prelude.ss")
|
||||
(apply append
|
||||
(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))))
|
||||
(set-optimize! #f)
|
||||
((var-deref "jolt.backend-scheme" "set-direct-link!") #f)
|
||||
(dynamic-wind
|
||||
(lambda ()
|
||||
(set-optimize! (string=? mode "optimized"))
|
||||
(when direct-link?
|
||||
((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
|
||||
((var-deref "jolt.backend-scheme" "direct-link-reset!"))))
|
||||
(lambda ()
|
||||
(if tree-shake?
|
||||
(dce-shake
|
||||
(dce-blob-records "host/chez/seed/prelude.ss")
|
||||
(apply append
|
||||
(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"))
|
||||
(let* ((builddir (string-append out-path ".build"))
|
||||
(flat-ss (string-append builddir "/flat.ss"))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue