a3e2365217
On the eval path nothing registers a source map, so jolt-backtrace-string dropped every walkable frame and printed no trace at all. Keep any named, non-plumbing continuation frame (rendered as a bare name when unmapped) so a runtime error shows the surviving non-tail spine — "print what is available". Add an opt-in tail-frame history behind JOLT_TRACE for the frames TCO erases. Each compiled fn records itself on entry into a bounded ring-of-rings, MIT Scheme's "history" shape: the outer ring holds one rib per non-tail subproblem, each rib a small inner ring of the tail-calls made at that level. A tight tail loop churns one rib instead of flushing the spine, so the non-tail caller context survives and total space stays bounded. The reporter prefers this history over the continuation when it's present, and resets it per top-level form so an error's trace isn't padded with earlier REPL frames. The emitter marks a tail call with (jolt-trace-mark! #t) so the runtime routes the callee into the current rib vs a fresh one; a *tail?* dynamic var tracks tail position (cleared by default, passed through if/do/let/loop/fn-body). It's all gated on trace-frames?, which compile-eval turns on for JOLT_TRACE and emit-image/`jolt build` force off — so non-trace emitted output is byte-identical (prelude unchanged, seed re-minted), and a built binary carries no per-call cost.
191 lines
10 KiB
Scheme
191 lines
10 KiB
Scheme
;; emit-image.ss — the on-Chez compiler-image emitter.
|
|
;;
|
|
;; This is the stage2/stage3 half of the self-hosting fixpoint. The
|
|
;; analyze->emit runs ON CHEZ (jolt-ce-analyze / jolt-ce-emit, loaded from a
|
|
;; previously-built image): feed it stage1's image and it produces stage2; feed it
|
|
;; stage2 and it produces stage3. stage2 == stage3 byte-for-byte proves the
|
|
;; on-Chez compiler reproduces itself (self-hosting-bootstrap-research §4).
|
|
;;
|
|
;; Loaded after compile-eval.ss (needs jolt-ce-analyze/jolt-ce-emit/ce-scan-requires!,
|
|
;; make-analyze-ctx) and rt.ss (read-file-string, the reader's rdr-read-form).
|
|
|
|
;; Read every top-level form from a source string (a Chez read-all).
|
|
;; Uses the same reader the spine reads single forms with.
|
|
(define (ei-read-all src)
|
|
(let ((end (string-length src)))
|
|
(let loop ((i 0) (acc '()))
|
|
(let-values (((form j) (rdr-read-form src i end)))
|
|
(if (rdr-eof? form)
|
|
(reverse acc)
|
|
(loop j (cons form acc)))))))
|
|
|
|
;; Is `f` an (ns ...) form? (Its only role in the image is alias registration; we
|
|
;; never emit it — the def-var!s carry explicit ns names.)
|
|
(define (ei-ns-form? f)
|
|
(and (cseq? f) (cseq-list? f)
|
|
(let ((items (seq->list f)))
|
|
(and (pair? items) (symbol-t? (car items))
|
|
(string=? (symbol-t-name (car items)) "ns")))))
|
|
|
|
;; ei-macro-form? / ei-defmacro->fn moved to compile-eval.ss (ce-macro-form? /
|
|
;; ce-defmacro->fn, loaded before this) — shared with the runtime defmacro spine.
|
|
|
|
;; Cross-compile one namespace's source to a list of guard-wrapped Scheme strings.
|
|
;; Each form is analyzed with a fresh ctx — resolution is via the runtime var-table
|
|
;; + 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>) +
|
|
;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
|
|
;; 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). emit-top-form is the
|
|
;; top-level entry: in direct-link mode it binds jv$<fqn> for a top-level def; off
|
|
;; that mode (the minter, runtime eval) it is exactly emit, so output is unchanged.
|
|
(define jolt-ce-emit-top (var-deref "jolt.backend-scheme" "emit-top-form"))
|
|
;; Seed mint and AOT build must stay byte-deterministic, so emit the image with var
|
|
;; cell-caching OFF (compile-eval.ss turned it on for runtime eval; this file loads
|
|
;; after it). Guarded for the first re-mint pass off an older seed.
|
|
(let ((scv (var-deref "jolt.backend-scheme" "set-var-cache!")))
|
|
(when (procedure? scv) (scv #f)))
|
|
;; Tail-frame tracing off for the mint + `jolt build`: the seed must stay a
|
|
;; byte-fixpoint, and a built app should carry no per-call trace overhead.
|
|
(let ((stf (var-deref "jolt.backend-scheme" "set-trace-frames!")))
|
|
(when (procedure? stf) (stf #f)))
|
|
(define (ei-compile-form ctx f optimize?)
|
|
(let ((ir (jolt-ce-analyze ctx f)))
|
|
(jolt-ce-emit-top (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).
|
|
;; A per-form transform applied to each read form before emit — the build sets it
|
|
;; to the data-reader rewrite (loader.ss ldr-apply-readers) so a registered #tag
|
|
;; literal compiles in a `jolt build` the same as it does in an interpreted load.
|
|
;; #f (the default, and during the seed mint where loader.ss isn't loaded) is no
|
|
;; transform, so emit-image.ss carries no loader dependency.
|
|
(define ei-emit-form-hook (make-parameter #f))
|
|
|
|
(define (ei-emit-ns* ns-name src optimize? guard?)
|
|
;; set the ns before reading so ::kw auto-resolves against this ns (the runtime
|
|
;; loader reads form-by-form after the ns form sets it; the cross-compile reads
|
|
;; all forms up front, so set it here).
|
|
(set-chez-ns! ns-name)
|
|
(let ((hook (ei-emit-form-hook)))
|
|
(let loop ((forms (ei-read-all src)) (acc '()))
|
|
(if (null? forms)
|
|
(reverse acc)
|
|
(let ((f (let ((f0 (car forms))) (if hook (hook f0) f0))))
|
|
(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 (if guard?
|
|
(guard (e (#t #f)) (ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))
|
|
(ei-compile-form (make-analyze-ctx ns-name) fn-form optimize?))))
|
|
(loop (cdr forms)
|
|
(if (and guard? (not scm)) acc
|
|
(cons (ei-macro-string ns-name nm scm guard?) acc))))))
|
|
(else
|
|
(let ((scm (if guard?
|
|
(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)
|
|
(if (and guard? (not scm)) acc
|
|
(cons (if guard? (string-append "(guard (e (#t #f))\n " scm ")") scm) acc)))))))))))
|
|
|
|
(define (ei-emit-ns ns-name src) (ei-emit-ns* ns-name src #f #t))
|
|
|
|
;; --- DCE record producer ----------------------------------------------------
|
|
;; Cross-compile a namespace's source to tree-shaking records — the app/library
|
|
;; counterpart to dce-blob-records (the prelude). The shake itself and all dce-*
|
|
;; helpers live in dce.ss; this stays here because it drives the ei-* compiler. A
|
|
;; top-level def becomes a prunable record; any other form a kept (side-effecting)
|
|
;; record whose refs are roots. A macro is prunable — its expander isn't called at
|
|
;; runtime in an AOT build.
|
|
(define (ei-emit-ns-records ns-name src)
|
|
(set-chez-ns! ns-name) ; ::kw resolves against this ns (see ei-emit-ns*)
|
|
(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* ((ctx (make-analyze-ctx ns-name))
|
|
(ir (jolt-ce-run-passes (jolt-ce-analyze ctx fn-form) ctx))
|
|
(str (ei-macro-string ns-name nm (jolt-ce-emit-top ir) #f))
|
|
(refs (dce-collect-refs '() ir)))
|
|
(loop (cdr forms) (cons (dce-rec #f (string-append ns-name "/" nm) refs str) acc)))))
|
|
(else
|
|
(let* ((ctx (make-analyze-ctx ns-name))
|
|
(ir (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx))
|
|
(str (jolt-ce-emit-top ir))
|
|
(fqn (dce-def-fqn ir))
|
|
(refs (dce-collect-refs '() ir)))
|
|
(loop (cdr forms)
|
|
(cons (if fqn (dce-rec #f fqn refs str) (dce-rec #t #f refs str)) acc)))))))))
|
|
|
|
;; Scheme string literal for a ns/name — uses the runtime's own writer
|
|
;; (printable ASCII identifiers only here).
|
|
(define (ei-str-lit s) (with-output-to-string (lambda () (write s))))
|
|
|
|
;; The compiler namespaces, in load order. The passes (fold/inline/types + the
|
|
;; jolt.passes façade) load after ir so run-passes is available to the back end;
|
|
;; fold/inline/types come before the façade that :refers them.
|
|
(define ei-compiler-ns-files
|
|
(list (cons "jolt.ir" "jolt-core/jolt/ir.clj")
|
|
(cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
|
|
(cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")
|
|
(cons "jolt.passes.fold" "jolt-core/jolt/passes/fold.clj")
|
|
(cons "jolt.passes.numeric" "jolt-core/jolt/passes/numeric.clj")
|
|
(cons "jolt.passes.inline" "jolt-core/jolt/passes/inline.clj")
|
|
(cons "jolt.passes.types.lattice" "jolt-core/jolt/passes/types/lattice.clj")
|
|
(cons "jolt.passes.types.check" "jolt-core/jolt/passes/types/check.clj")
|
|
(cons "jolt.passes.types" "jolt-core/jolt/passes/types.clj")
|
|
(cons "jolt.passes" "jolt-core/jolt/passes.clj")))
|
|
|
|
;; The clojure.core tiers + stdlib namespaces, in load order.
|
|
;; Re-emitting these on Chez is the
|
|
;; prelude half of the fixpoint (the whole emitted system reproducing itself).
|
|
(define ei-prelude-ns-files
|
|
(append
|
|
(map (lambda (tf) (cons "clojure.core" (string-append "jolt-core/clojure/core/" tf ".clj")))
|
|
'("00-syntax" "00-kernel" "10-seq" "20-coll" "21-coll" "22-coll" "25-sorted" "30-macros" "40-lazy" "50-io"))
|
|
(list (cons "clojure.string" "stdlib/clojure/string.clj")
|
|
(cons "clojure.walk" "stdlib/clojure/walk.clj")
|
|
(cons "clojure.template" "stdlib/clojure/template.clj")
|
|
(cons "clojure.edn" "stdlib/clojure/edn.clj")
|
|
(cons "clojure.set" "stdlib/clojure/set.clj")
|
|
(cons "clojure.pprint" "stdlib/clojure/pprint.clj"))))
|
|
|
|
;; Join a list of form strings with "\n", no trailing newline.
|
|
(define (ei-join forms)
|
|
(let join ((fs forms) (out ""))
|
|
(cond
|
|
((null? fs) out)
|
|
((string=? out "") (join (cdr fs) (car fs)))
|
|
(else (join (cdr fs) (string-append out "\n" (car fs)))))))
|
|
|
|
;; Re-emit the whole list of (ns . file) pairs ON CHEZ as one Scheme string.
|
|
(define (ei-emit-ns-files nfs)
|
|
(ei-join (apply append
|
|
(map (lambda (nf) (ei-emit-ns (car nf) (read-file-string (cdr nf)))) nfs))))
|
|
|
|
;; Emit the compiler image (jolt.ir + jolt.analyzer + jolt.backend-scheme) on Chez.
|
|
(define (jolt-emit-image) (ei-emit-ns-files ei-compiler-ns-files))
|
|
|
|
;; Emit the clojure.core prelude (all tiers + stdlib) on Chez — the prelude half of
|
|
;; the self-hosting fixpoint.
|
|
(define (jolt-emit-prelude) (ei-emit-ns-files ei-prelude-ns-files))
|