simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Chez Phase 3 inc8: prelude fixpoint + fully-Chez-emitted system

Browse source 
Extends the fixpoint beyond the compiler image to the whole emitted system.
emit-image.ss now handles macros (defmacro -> bare expander fn + def-var! +
mark-macro!) and re-emits the clojure.core prelude (all tiers + stdlib) on Chez
via jolt-emit-prelude; driver's emit-image-on-chez takes an emit-fn arg.

The prelude converges at pstage3==pstage4 (one stage later than the compiler's
stage2==stage3) because macro expanders bake an auto-gensym id at emit time, so a
Janet-emitted macro carries a different id than a Chez-emitted one — only once
both stages load a Chez-emitted prelude does it stabilize.

fixpoint-test now proves: compiler stage2==stage3, prelude pstage3==pstage4, and
the fully Chez-emitted system (Chez prelude + Chez image, no Janet artifact in the
loop) compiles+runs real cases. 10/10.
This commit is contained in:
Yogthos 2026-06-20 05:21:23 -04:00
parent 509c23f06d
commit 81e587b2d7
3 changed files with 176 additions and 89 deletions
Download patch file Download diff file Expand all files Collapse all files

17
host/chez/driver.janet
View file

@ -374,9 +374,11 @@
(defn program-emit-image
"A Chez program that loads the zero-Janet runtime + the compiler `image-path`,
then re-emits the compiler image ON CHEZ (jolt-emit-image) and writes it to
`out-path`. Running this with image = stageN produces stage(N+1)."
[prelude-path image-path out-path]
then re-emits the compiler image (or, with emit-fn \"jolt-emit-prelude\", the
clojure.core prelude) ON CHEZ and writes it to `out-path`. Running this with
image = stageN produces stage(N+1)."
[prelude-path image-path out-path &opt emit-fn]
(default emit-fn "jolt-emit-image")
(string
"(import (chezscheme))\n"
"(load \"host/chez/rt.ss\")\n"
@ -389,15 +391,16 @@
"(load \"host/chez/compile-eval.ss\")\n"
"(load \"host/chez/emit-image.ss\")\n"
"(let ((p (open-output-file " (string/format "%j" out-path) " 'replace)))\n"
" (put-string p (jolt-emit-image)) (close-port p))\n"))
" (put-string p (" emit-fn ")) (close-port p))\n"))
(defn emit-image-on-chez
"Re-emit the compiler image on Chez: load `image-path` (stageN) and write the
re-emitted image (stage N+1) to `out-path`. Each runs in a fresh chez process so
gensym/state start clean (essential for a byte-stable fixpoint). Returns
gensym/state start clean (essential for a byte-stable fixpoint). emit-fn selects
jolt-emit-image (the compiler) or jolt-emit-prelude (clojure.core). Returns
[code stderr]."
[prelude-path image-path out-path]
(def prog (program-emit-image prelude-path image-path out-path))
[prelude-path image-path out-path &opt emit-fn]
(def prog (program-emit-image prelude-path image-path out-path emit-fn))
(def path (string "/tmp/jolt-emit-image-" (os/getpid) "-" (hash out-path) ".ss"))
(spit path prog)
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))

117
host/chez/emit-image.ss
View file

@ -30,25 +30,71 @@
(and (pair? items) (symbol-t? (car items))
(string=? (symbol-t-name (car items)) "ns")))))
;; Is `f` a (defmacro ...) / (definline ...) form?
(define (ei-macro-form? f)
(and (cseq? f) (cseq-list? f)
(let ((items (seq->list f)))
(and (pair? items) (symbol-t? (car items))
(let ((h (symbol-t-name (car items))))
(or (string=? h "defmacro") (string=? h "definline")))))))
;; (defmacro NAME [docstring] [attr-map] params body...) -> (values "NAME" (fn ...)).
;; Mirrors driver.janet defmacro->fn: strip a leading docstring (native string) and
;; an attr-map (a pmap that isn't a symbol), then re-head the rest with `fn` so a
;; destructured macro arglist desugars before lowering. We emit the BARE fn (the
;; caller wraps it in def-var! + mark-macro!), never a (def NAME ...) — interning
;; NAME would make require skip the real macro (jolt-r9lm).
(define (ei-defmacro->fn f)
(let* ((items (seq->list f))
(name-sym (cadr items))
(after-name (cddr items))
(a1 (if (and (pair? after-name) (string? (car after-name)))
(cdr after-name) after-name))
(after-meta (if (and (pair? a1) (pmap? (car a1)))
(cdr a1) a1))
(fn-sym (jolt-symbol #f "fn")))
(values (symbol-t-name name-sym)
(apply jolt-list (cons fn-sym after-meta)))))
;; Cross-compile one namespace's source to a list of guard-wrapped Scheme strings.
;; Mirrors driver.janet emit-ns-forms-list + emit-form-scheme (the compiler
;; namespaces define no macros, so there is no defmacro branch). 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.
;; Mirrors driver.janet emit-ns-forms-list/emit-core-prelude + emit-form-scheme.
;; 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 (jolt-r9lm).
(define (ei-emit-ns ns-name src)
(let loop ((forms (ei-read-all src)) (acc '()))
(if (null? forms)
(reverse acc)
(let ((f (car forms)))
(ce-scan-requires! f ns-name)
(if (ei-ns-form? f)
(loop (cdr forms) acc)
(let* ((ctx (make-analyze-ctx ns-name))
(scm (guard (e (#t #f)) (jolt-ce-emit (jolt-ce-analyze ctx f)))))
(loop (cdr forms)
(if scm
(cons (string-append "(guard (e (#t #f))\n " scm ")") acc)
acc))))))))
(cond
((ei-ns-form? f) (loop (cdr forms) acc))
((ei-macro-form? f)
(let-values (((nm fn-form) (ei-defmacro->fn f)))
(let ((scm (guard (e (#t #f))
(let ((ctx (make-analyze-ctx ns-name)))
(jolt-ce-emit (jolt-ce-analyze ctx fn-form))))))
(loop (cdr forms)
(if scm
(cons (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) "))")
acc)
acc)))))
(else
(let* ((ctx (make-analyze-ctx ns-name))
(scm (guard (e (#t #f)) (jolt-ce-emit (jolt-ce-analyze ctx f)))))
(loop (cdr forms)
(if scm
(cons (string-append "(guard (e (#t #f))\n " scm ")") acc)
acc)))))))))
;; Scheme string literal for a ns/name — uses the runtime's own writer so it
;; matches the Janet driver's %j (printable ASCII identifiers only here).
(define (ei-str-lit s) (with-output-to-string (lambda () (write s))))
;; The compiler namespaces, in load order — same list as driver.janet
;; compiler-ns-files.
@ -57,16 +103,37 @@
(cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
(cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")))
;; Emit the whole compiler image as one Scheme string: every namespace's forms,
;; joined by newlines. Byte-identical layout to driver.janet emit-compiler-image
;; (forms joined with "\n", no trailing newline) so an image emitted here can be
;; diffed directly against the Janet-built one.
(define (jolt-emit-image)
(let ((forms (apply append
(map (lambda (nf) (ei-emit-ns (car nf) (read-file-string (cdr nf))))
ei-compiler-ns-files))))
(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))))))))
;; The clojure.core tiers + stdlib namespaces, in load order — same lists as
;; driver.janet core-tier-files / stdlib-ns-files. 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" "25-sorted" "30-macros" "40-lazy" "50-io"))
(list (cons "clojure.string" "src/jolt/clojure/string.clj")
(cons "clojure.walk" "src/jolt/clojure/walk.clj")
(cons "clojure.template" "src/jolt/clojure/template.clj")
(cons "clojure.edn" "src/jolt/clojure/edn.clj")
(cons "clojure.set" "src/jolt/clojure/set.clj")
(cons "clojure.pprint" "src/jolt/clojure/pprint.clj"))))
;; Join a list of form strings with "\n", no trailing newline — byte-identical
;; layout to the Janet driver's (string/join out "\n").
(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))