Share one ns cross-compile loop between the seed minter and jolt build

ei-emit-ns (emit-image) and bld-emit-ns (build) were near-verbatim copies that had
drifted: the minter guard-wraps and skips failing forms, the build is strict, and
since the passes were wired the build also runs run-passes. Fold both into
ei-emit-ns* with optimize?/guard? flags; ei-emit-ns and bld-emit-ns become one-line
callers. Output is byte-identical (selfhost fixpoint and build smoke stay green).
This commit is contained in:
Yogthos 2026-06-23 01:48:40 -04:00
parent 1dcd4678e8
commit b8492ad81a
2 changed files with 37 additions and 42 deletions

View file

@ -141,31 +141,10 @@
(for-each (lambda (l) (bld-inline-line l out 0)) bld-runtime-manifest)) (for-each (lambda (l) (bld-inline-line l out 0)) bld-runtime-manifest))
;; --- app emission ----------------------------------------------------------- ;; --- app emission -----------------------------------------------------------
;; Re-emit one app namespace to a list of Scheme strings. Like emit-image's ;; Re-emit one app namespace to a list of Scheme strings: optimize (run-passes)
;; ei-emit-ns but WITHOUT the silent (guard ...) wrapper — a form that fails to ;; and stay strict — a form that fails to emit must fail the build, not vanish.
;; emit must fail the build, not vanish. ;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f).
(define (bld-emit-ns ns-name src) (define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f))
(let loop ((forms (ei-read-all src)) (acc '()))
(if (null? forms)
(reverse acc)
(let ((f (car forms)))
(ce-scan-requires! f ns-name)
(cond
((ei-ns-form? f) (loop (cdr forms) acc))
((ce-macro-form? f)
(let-values (((nm fn-form) (ce-defmacro->fn f)))
(let ((scm (let ((ctx (make-analyze-ctx ns-name)))
(jolt-ce-emit (jolt-ce-run-passes (jolt-ce-analyze ctx fn-form) ctx)))))
(loop (cdr forms)
(cons (string-append
"(def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm) "\n "
scm ")\n(mark-macro! "
(ei-str-lit ns-name) " " (ei-str-lit nm) ")")
acc)))))
(else
(let* ((ctx (make-analyze-ctx ns-name))
(scm (jolt-ce-emit (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx))))
(loop (cdr forms) (cons scm acc)))))))))
;; --- the build -------------------------------------------------------------- ;; --- the build --------------------------------------------------------------
;; entry-ns: the app's main namespace (a string). out-path: the binary to write. ;; entry-ns: the app's main namespace (a string). out-path: the binary to write.

View file

@ -35,7 +35,27 @@
;; + alias tables, not ctx-accumulated state, so this matches the spine's per-form ;; + alias tables, not ctx-accumulated state, so this matches the spine's per-form
;; analyze. A defmacro emits its expander fn as (def-var! ns name <fn>) + ;; analyze. A defmacro emits its expander fn as (def-var! ns name <fn>) +
;; (mark-macro! ns name) so the on-Chez analyzer can expand it. ;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
(define (ei-emit-ns ns-name src) ;; Analyze -> (optionally run passes) -> emit one form. optimize? runs
;; jolt.passes/run-passes (build optimizes; the seed minter stays un-optimized so
;; the self-host fixpoint is independent of the passes).
(define (ei-compile-form ctx f optimize?)
(let ((ir (jolt-ce-analyze ctx f)))
(jolt-ce-emit (if optimize? (jolt-ce-run-passes ir ctx) ir))))
;; The emitted `(def-var! …)(mark-macro! …)` pair for a defmacro, guard-wrapped
;; (tolerant) or bare (strict) to match guard?.
(define (ei-macro-string ns-name nm scm guard?)
(if guard?
(string-append "(guard (e (#t #f))\n (def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm)
"\n " scm ")\n (mark-macro! " (ei-str-lit ns-name) " " (ei-str-lit nm) "))")
(string-append "(def-var! " (ei-str-lit ns-name) " " (ei-str-lit nm) "\n " scm
")\n(mark-macro! " (ei-str-lit ns-name) " " (ei-str-lit nm) ")")))
;; Cross-compile one namespace's source to a list of Scheme strings — shared by
;; the seed minter (ei-emit-ns: optimize? #f, guard? #t — tolerant, skips a form
;; that fails to emit) and `jolt build` (bld-emit-ns: optimize? #t, guard? #f —
;; strict, a failing form errors the build).
(define (ei-emit-ns* ns-name src optimize? guard?)
(let loop ((forms (ei-read-all src)) (acc '())) (let loop ((forms (ei-read-all src)) (acc '()))
(if (null? forms) (if (null? forms)
(reverse acc) (reverse acc)
@ -45,25 +65,21 @@
((ei-ns-form? f) (loop (cdr forms) acc)) ((ei-ns-form? f) (loop (cdr forms) acc))
((ce-macro-form? f) ((ce-macro-form? f)
(let-values (((nm fn-form) (ce-defmacro->fn f))) (let-values (((nm fn-form) (ce-defmacro->fn f)))
(let ((scm (guard (e (#t #f)) (let ((scm (if guard?
(let ((ctx (make-analyze-ctx ns-name))) (guard (e (#t #f)) (ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))
(jolt-ce-emit (jolt-ce-analyze ctx fn-form)))))) (ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))))
(loop (cdr forms) (loop (cdr forms)
(if scm (if (and guard? (not scm)) acc
(cons (string-append (cons (ei-macro-string ns-name nm scm guard?) acc))))))
"(guard (e (#t #f))\n (def-var! "
(ei-str-lit ns-name) " " (ei-str-lit nm) "\n "
scm ")\n (mark-macro! "
(ei-str-lit ns-name) " " (ei-str-lit nm) "))")
acc)
acc)))))
(else (else
(let* ((ctx (make-analyze-ctx ns-name)) (let ((scm (if guard?
(scm (guard (e (#t #f)) (jolt-ce-emit (jolt-ce-analyze ctx f))))) (guard (e (#t #f)) (ei-compile-form (make-analyze-ctx ns-name) f optimize?))
(ei-compile-form (make-analyze-ctx ns-name) f optimize?))))
(loop (cdr forms) (loop (cdr forms)
(if scm (if (and guard? (not scm)) acc
(cons (string-append "(guard (e (#t #f))\n " scm ")") acc) (cons (if guard? (string-append "(guard (e (#t #f))\n " scm ")") scm) acc))))))))))
acc)))))))))
(define (ei-emit-ns ns-name src) (ei-emit-ns* ns-name src #f #t))
;; Scheme string literal for a ns/name — uses the runtime's own writer ;; Scheme string literal for a ns/name — uses the runtime's own writer
;; (printable ASCII identifiers only here). ;; (printable ASCII identifiers only here).