Chez Phase 3 inc6a: zero-Janet spine (analyzer + emitter on Chez), macro-free

Cross-compile jolt.ir + jolt.analyzer + jolt.backend-scheme to Scheme def-var!
forms via the existing Janet emit pipeline (driver/emit-compiler-image) and run
them ON CHEZ over a Scheme jolt.host impl. A macro-free Clojure expression now
compiles and runs with no Janet in the loop: read (reader.ss) -> analyze
(jolt.analyzer on Chez) -> IR -> emit (jolt.backend-scheme on Chez) -> eval.

host/chez/host-contract.ss is the jolt.host contract on Chez (the portable seam
the cross-compiled analyzer/emitter call): form-* over the Chez reader's forms,
resolve-global/compile-ns/host-intern!/late-bind? over the var-cell registry. ctx
is an opaque record carrying the compile ns. Native-op names are declare-var!'d
into clojure.core so +, *, <, ... classify as :var and the emitter's native-op
path lowers them. form-macro? is a #f stub and macro expansion / syntax-quote /
record hints are stubs for inc6b (runtime macros, jolt-r8ku).

host/chez/compile-eval.ss is the spine entry (read-string -> analyze -> emit ->
eval). driver gains emit-compiler-image / ensure-compiler-image (image caching)
and program-zero-janet / eval-zero-janet.

Two bugs fixed in the keeper, not reproduced:
- the Chez reader stores an unqualified symbol's ns as #f, but the analyzer tests
  (nil? ns); hc-sym-ns normalizes #f/'() -> jolt-nil. Without it every handled
  special (if/do/fn*) misanalyzed as a plain invoke.
- char (int->char) was missing from clojure.core on Chez; the emitter's
  chez-str-lit needs it for keyword/string consts. Added jolt-char to converters.ss.

Gate: test/chez/spine-test.janet 15/15 (Chez-hosted analyzer value == Janet-hosted
oracle through the same emitter/RT; only the analysis host differs). Full Janet
gate green (150 files). driver.janet is in the prelude fingerprint so the cache key
moved; prelude content is unchanged. jolt-chez fingerprint/ensure-prelude made
public for the test harness.
This commit is contained in:
Yogthos 2026-06-19 21:16:24 -04:00
parent c47ae7fd22
commit c2d977cadf
6 changed files with 398 additions and 2 deletions

28
host/chez/compile-eval.ss Normal file
View file

@ -0,0 +1,28 @@
;; compile-eval.ss (jolt-hs9n, Phase 3 inc6) — the zero-Janet compile spine.
;;
;; Ties together the cross-compiled compiler image (jolt.ir + jolt.analyzer +
;; jolt.backend-scheme, loaded as def-var! forms) and the host contract
;; (host-contract.ss) into a runtime entry: a Clojure source string is read by the
;; Chez data reader, analyzed by the ON-CHEZ analyzer to IR, emitted to Scheme by
;; the ON-CHEZ emitter, and eval'd — no Janet in the loop. This is the spine the
;; stage2==stage3 bootstrap fixpoint (later increments) closes over.
;;
;; Loaded after host-contract.ss + the compiler image.
(define jolt-ce-analyze (var-deref "jolt.analyzer" "analyze"))
(define jolt-ce-emit (var-deref "jolt.backend-scheme" "emit"))
(define jolt-ce-read (var-deref "clojure.core" "read-string"))
;; Source string -> Scheme source string (read -> analyze -> emit, all on Chez).
;; `ns` is the compile namespace unqualified symbols resolve against.
(define (jolt-analyze-emit src ns)
(let* ((form (jolt-ce-read src))
(ctx (make-analyze-ctx ns))
(ir (jolt-ce-analyze ctx form)))
(jolt-ce-emit ir)))
;; Source string -> value (compile on Chez, then eval the emitted Scheme in the
;; top-level environment where rt.ss's runtime procedures live).
(define (jolt-compile-eval src ns)
(eval (read (open-input-string (jolt-analyze-emit src ns)))
(interaction-environment)))

View file

@ -121,6 +121,11 @@
(def-var! "clojure.core" "symbol" jolt-symbol-new)
(def-var! "clojure.core" "gensym" jolt-gensym)
(def-var! "clojure.core" "int" jolt-int)
;; char: coerce a code point (jolt's all-flonum number) to a Chez char; pass a
;; char through. Inverse of int on chars. (Missing on Chez before jolt-hs9n — the
;; cross-compiled emitter's chez-str-lit needs it for printable-ASCII escaping.)
(define (jolt-char x) (if (char? x) x (integer->char (exact (round x)))))
(def-var! "clojure.core" "char" jolt-char)
;; long: same truncation as int in jolt's all-flonum model (seed core-long =
;; math/trunc; char -> code point). Distinct cell so (long ...) resolves.
(def-var! "clojure.core" "long" jolt-int)

View file

@ -229,6 +229,101 @@
(cset-prelude! ctx false)
[(string/join out "\n") emitted total])
# --- analyzer/emitter cross-compile (jolt-hs9n, the zero-Janet spine) ---------
# Phase 3 inc6: cross-compile the PORTABLE compiler (jolt.ir + jolt.analyzer +
# jolt.backend-scheme) to Scheme def-var! forms so analyze->IR->emit runs ON CHEZ.
# Same emit pipeline as the core prelude, but for jolt-core/jolt/* namespaces
# rather than clojure.core: jolt.* refs lower to var-deref (the prelude-mode gate
# only rejects clojure.* refs), clojure.core refs resolve from the loaded prelude,
# and the jolt.host form-*/resolve-global/... refs resolve from host-contract.ss.
(defn- emit-ns-forms-list
"Cross-compile one namespace's source to a list of guard-wrapped def-var! Scheme
strings (prelude mode must already be ON). Registers the ns' requires/aliases in
ctx first so cross-ns refs resolve at emit time; skips ns + macro forms (macros
are analyze-time only, already expanded at their use sites)."
[ctx ns-name src]
(tctx/create-ns ctx ns-name)
(tctx/ctx-set-current-ns ctx ns-name)
(def out @[])
(each f (parse-all src)
(def ns-form? (and (indexed? f) (> (length f) 0) (= "ns" (sym-name (in f 0)))))
(if ns-form? (protect (api/eval-one ctx f)) (scan-eval-requires! ctx f))
(unless (or ns-form? (macro-form? f))
(def res (protect (cemit ctx (backend/analyze-form ctx f))))
(when (res 0)
(array/push out (string "(guard (e (#t #f))\n " (res 1) ")")))))
out)
(def compiler-ns-files
[["jolt.ir" "jolt-core/jolt/ir.clj"]
["jolt.analyzer" "jolt-core/jolt/analyzer.clj"]
["jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj"]])
(defn emit-compiler-image
"Cross-compile the analyzer pipeline (jolt.ir + jolt.analyzer +
jolt.backend-scheme) to a Scheme string of prelude-mode def-var! forms — the
analyze->IR->emit spine running ON CHEZ (jolt-hs9n). Load AFTER rt.ss +
host-contract.ss + the core prelude. Returns [scheme total]."
[ctx]
(ensure-clj-emitter ctx)
# ensure-analyzer is lazy; a trivial analyze builds jolt.ir/jolt.analyzer/
# jolt.passes in the Janet ctx so their vars resolve while we emit their source.
(protect (backend/analyze-form ctx (in (r/parse-next "nil") 0)))
(cset-prelude! ctx true)
(def prev-ns (tctx/ctx-current-ns ctx))
(def out @[])
(each [ns-name path] compiler-ns-files
(array/concat out (emit-ns-forms-list ctx ns-name (slurp path))))
(tctx/ctx-set-current-ns ctx prev-ns)
(cset-prelude! ctx false)
[(string/join out "\n") (length out)])
(defn ensure-compiler-image
"Build (once) and return the path to the cross-compiled compiler image — the
jolt.ir/jolt.analyzer/jolt.backend-scheme def-var! forms (jolt-hs9n). Cached on
disk keyed by the same fingerprint scheme as the prelude; pass an explicit path
to control caching from the test harness."
[ctx path]
(unless (os/stat path)
(def [img _] (emit-compiler-image ctx))
(spit path img))
path)
(defn program-zero-janet
"Assemble a fully self-hosted Chez program: rt.ss + the core prelude +
host-contract.ss + the cross-compiled compiler image + compile-eval.ss, then
compile AND eval `src` ON CHEZ (read->analyze->emit->eval, no Janet). The
zero-Janet spine (jolt-hs9n)."
[prelude-path image-path src ns]
(string
"(import (chezscheme))\n"
"(load \"host/chez/rt.ss\")\n"
"(set-chez-ns! \"clojure.core\")\n"
"(load " (string/format "%j" prelude-path) ")\n"
"(load \"host/chez/post-prelude.ss\")\n"
"(set-chez-ns! \"user\")\n"
"(load \"host/chez/host-contract.ss\")\n"
"(load " (string/format "%j" image-path) ")\n"
"(load \"host/chez/compile-eval.ss\")\n"
"(printf \"~a\\n\" (jolt-final-str (jolt-compile-eval "
(string/format "%j" src) " " (string/format "%j" ns) ")))\n"))
(defn eval-zero-janet
"Compile+run `src` through the ON-CHEZ analyzer/emitter (zero Janet). Needs a
prebuilt core prelude (`prelude-path`) and compiler image (`image-path`).
Returns [code stdout stderr]."
[prelude-path image-path src &opt ns scheme-out]
(default ns "user")
(def prog (program-zero-janet prelude-path image-path src ns))
(def path (or scheme-out (string "/tmp/jolt-zero-janet-" (os/getpid) ".ss")))
(spit path prog)
(def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe}))
(def out (drain (proc :out)))
(def err (drain (proc :err)))
(def code (os/proc-wait proc))
[code (string/trim out) (string/trim err)])
(defn program-with-prelude
"Assemble a runnable Chez program that loads rt.ss, loads the assembled core
prelude from `prelude-path` (a file written once), then prints `final-scm`."

197
host/chez/host-contract.ss Normal file
View file

@ -0,0 +1,197 @@
;; host-contract.ss (jolt-hs9n, Phase 3 inc6) — the jolt.host contract on Chez.
;;
;; The portable seam between jolt-core (analyzer/IR/emitter, cross-compiled to
;; Scheme) and the host. Mirrors src/jolt/host_iface.janet's `exports`: every
;; contract fn is def-var!'d into the "jolt.host" namespace so the cross-compiled
;; jolt.analyzer / jolt.backend-scheme — whose unqualified form-*/resolve-global/
;; ... refs lower to (var-deref "jolt.host" ...) — resolve here at runtime.
;;
;; This is what puts analyze->IR->emit ON CHEZ (the zero-Janet spine). It runs
;; over the Chez data reader's forms (reader.ss): symbols are symbol-t, lists are
;; cseq (list?), () is empty-list-t, vectors/maps are pvec/pmap, sets and #tag/
;; regex/inst/uuid are pmaps tagged :jolt/type, chars are NATIVE Chez chars.
;;
;; Loaded after rt.ss + reader.ss + the core prelude; before the compiler image.
;; --- the analyze ctx --------------------------------------------------------
;; ctx is opaque to the analyzer (only ever threaded to these contract fns); we
;; make it a box carrying the compile namespace. The var/ns registry it consults
;; is the global var-table (rt.ss).
(define-record-type chez-actx (fields (mutable cns)) (nongenerative chez-actx-v1))
(define (make-analyze-ctx ns) (make-chez-actx ns))
;; Interned keywords reused for form tags + resolve-global's result map.
(define hc-kw-jolt-type (keyword "jolt" "type"))
(define hc-kw-jolt-set (keyword "jolt" "set"))
(define hc-kw-jolt-tagged (keyword "jolt" "tagged"))
(define hc-kw-value (keyword #f "value"))
(define hc-kw-tag (keyword #f "tag"))
(define hc-kw-form (keyword #f "form"))
(define hc-kw-kind (keyword #f "kind"))
(define hc-kw-ns (keyword #f "ns"))
(define hc-kw-name (keyword #f "name"))
(define hc-kw-var (keyword #f "var"))
(define hc-kw-unresolved (keyword #f "unresolved"))
(define hc-kw-regex (keyword #f "regex"))
(define hc-kw-inst (keyword #f "#inst"))
(define hc-kw-uuid (keyword #f "#uuid"))
;; --- form predicates --------------------------------------------------------
(define (hc-sym? x) (symbol-t? x))
(define (hc-list? x) (or (empty-list-t? x) (and (cseq? x) (cseq-list? x))))
(define (hc-vec? x) (pvec? x))
(define (hc-map? x) (and (pmap? x) (jolt-nil? (jolt-get x hc-kw-jolt-type))))
(define (hc-set? x) (and (pmap? x) (eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-set)))
(define (hc-char? x) (char? x))
(define (hc-literal? x)
(or (jolt-nil? x) (boolean? x) (number? x) (string? x) (keyword-t? x) (char? x)))
(define (hc-tagged-of x tag)
(and (pmap? x)
(eq? (jolt-get x hc-kw-jolt-type) hc-kw-jolt-tagged)
(eq? (jolt-get x hc-kw-tag) tag)))
(define (hc-regex? x) (hc-tagged-of x hc-kw-regex))
(define (hc-inst? x) (hc-tagged-of x hc-kw-inst))
(define (hc-uuid? x) (hc-tagged-of x hc-kw-uuid))
;; --- form accessors ---------------------------------------------------------
(define (hc-sym-name x) (symbol-t-name x))
;; The reader stores an unqualified symbol's ns inconsistently (#f, '(), or
;; jolt-nil — see converters.ss). The contract is jolt-nil for unqualified (the
;; analyzer tests (nil? ns)), so normalize; a real ns string passes through.
(define (hc-sym-ns x)
(let ((ns (symbol-t-ns x)))
(if (and ns (not (jolt-nil? ns)) (not (null? ns))) ns jolt-nil)))
(define (hc-sym-meta x)
(let ((m (symbol-t-meta x)))
(if (and m (not (jolt-nil? m)) (not (null? m))) m jolt-nil)))
;; list items -> jolt vector (pvec); the analyzer mapv's over the result.
(define (hc-elements x)
(cond ((empty-list-t? x) empty-pvec)
((cseq? x) (make-pvec (list->vector (seq->list x))))
(else empty-pvec)))
(define (hc-vec-items x) x) ; already a pvec
(define (hc-set-items x) (jolt-get x hc-kw-value))
(define (hc-map-pairs x)
(let loop ((ks (if (jolt-nil? (jolt-seq (jolt-keys x))) '()
(seq->list (jolt-seq (jolt-keys x))))) (acc '()))
(if (null? ks) (apply jolt-vector (reverse acc))
(loop (cdr ks) (cons (jolt-vector (car ks) (jolt-get x (car ks))) acc)))))
(define (hc-regex-source x) (jolt-get x hc-kw-form))
(define (hc-inst-source x) (jolt-get x hc-kw-form))
(define (hc-uuid-source x) (jolt-get x hc-kw-form))
;; The Chez reader does not record source offsets yet (jolt-q2kg).
(define (hc-form-position x) jolt-nil)
;; --- special forms ----------------------------------------------------------
;; Mirrors host_iface special-names + interop-head? — forms the analyzer marks
;; uncompilable (the handled specials are dispatched in analyze-list BEFORE this).
(define hc-special-names
'("quote" "syntax-quote" "unquote" "unquote-splicing" "do" "if" "def"
"defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "eval" "new"
"." "gen-class" "monitor-enter" "monitor-exit" "letfn"))
(define (hc-interop-head? name)
(let ((n (string-length name)))
(and (> n 1)
(or (char=? (string-ref name 0) #\.)
(char=? (string-ref name (- n 1)) #\.)))))
(define (hc-special? name)
(if (or (member name hc-special-names) (hc-interop-head? name)) #t #f))
;; --- compile-time environment -----------------------------------------------
(define (hc-current-ns ctx) (chez-actx-cns ctx))
(define (hc-late-bind? ctx) #t) ; Chez has no interpreter to punt to
;; Runtime macros land in inc6b (jolt-r8ku): no macro is emitted as a runtime
;; value yet, so nothing is a macro. form-macro? is only ever asked about a
;; non-handled, non-special head (e.g. +, a user fn) — all non-macros today.
(define (hc-macro? ctx sym) #f)
(define (hc-expand-1 ctx form)
(jolt-throw (jolt-ex-info "form-expand-1: runtime macros not on Chez yet (jolt-r8ku)"
(jolt-hash-map))))
;; Classify a global (non-local) symbol reference against the var registry:
;; {:kind :var :ns NS :name NAME} — a defined var (compile ns / clojure.core)
;; {:kind :unresolved :name NAME} — not found (late-bind -> var-ref @ compile ns;
;; a qualified one -> host-static in the analyzer)
;; No :host branch: there is no Janet-style native-op env on Chez — the hot
;; clojure.core primitives (+,-,map,...) are declared in clojure.core below so
;; they classify as :var and the emitter's native-op path lowers them.
(define (hc-resolve-global ctx sym)
(let* ((nm (symbol-t-name sym))
(sns (symbol-t-ns sym))
(qualified (and (not (jolt-nil? sns)) sns))
(cell (if qualified
(var-cell-lookup qualified nm)
(or (var-cell-lookup (chez-actx-cns ctx) nm)
(var-cell-lookup "clojure.core" nm)))))
(if (and cell (var-cell-defined? cell))
(jolt-hash-map hc-kw-kind hc-kw-var
hc-kw-ns (var-cell-ns cell)
hc-kw-name (var-cell-name cell))
(jolt-hash-map hc-kw-kind hc-kw-unresolved hc-kw-name nm))))
(define (hc-intern! ctx ns-name nm) (declare-var! ns-name nm) jolt-nil)
;; syntax-quote lowering + record hints land in later increments (6b+); stub so
;; the contract is complete (not on the macro-free spine).
(define (hc-syntax-quote-lower ctx inner)
(jolt-throw (jolt-ex-info "form-syntax-quote-lower: not on Chez yet (jolt-r8ku)"
(jolt-hash-map))))
(define (hc-record-type? ctx name) #f)
(define (hc-record-ctor-key ctx name) jolt-nil)
(define (hc-record-shapes ctx) (jolt-hash-map))
(define (hc-inline-enabled? ctx) #f)
(define (hc-inline-ir ctx ns-name nm) jolt-nil)
;; --- declare the hot clojure.core primitives so resolve-global sees them ------
;; (mirrors backend_scheme.clj native-ops keys — the emitter lowers these inline,
;; so the declared cell's unbound root is never deref'd.)
(for-each (lambda (nm) (declare-var! "clojure.core" nm))
'("+" "-" "*" "/" "<" ">" "<=" ">=" "=" "inc" "dec" "not" "min" "max"
"mod" "rem" "quot" "vector" "hash-map" "hash-set" "conj" "get" "nth" "count"
"assoc" "dissoc" "contains?" "empty?" "peek" "pop" "first" "rest" "next" "seq"
"cons" "list" "reverse" "last" "map" "filter" "remove" "reduce" "into" "concat"
"apply" "range" "take" "drop" "keys" "vals" "even?" "odd?" "pos?" "neg?"
"zero?" "identity" "ex-info"))
;; --- install: bind the contract into the jolt.host namespace -----------------
(define (hc-install!)
(def-var! "jolt.host" "form-sym?" hc-sym?)
(def-var! "jolt.host" "form-sym-name" hc-sym-name)
(def-var! "jolt.host" "form-sym-ns" hc-sym-ns)
(def-var! "jolt.host" "form-sym-meta" hc-sym-meta)
(def-var! "jolt.host" "form-list?" hc-list?)
(def-var! "jolt.host" "form-vec?" hc-vec?)
(def-var! "jolt.host" "form-map?" hc-map?)
(def-var! "jolt.host" "form-set?" hc-set?)
(def-var! "jolt.host" "form-char?" hc-char?)
(def-var! "jolt.host" "form-literal?" hc-literal?)
(def-var! "jolt.host" "form-regex?" hc-regex?)
(def-var! "jolt.host" "form-inst?" hc-inst?)
(def-var! "jolt.host" "form-uuid?" hc-uuid?)
(def-var! "jolt.host" "form-elements" hc-elements)
(def-var! "jolt.host" "form-vec-items" hc-vec-items)
(def-var! "jolt.host" "form-set-items" hc-set-items)
(def-var! "jolt.host" "form-map-pairs" hc-map-pairs)
(def-var! "jolt.host" "form-regex-source" hc-regex-source)
(def-var! "jolt.host" "form-inst-source" hc-inst-source)
(def-var! "jolt.host" "form-uuid-source" hc-uuid-source)
(def-var! "jolt.host" "form-position" hc-form-position)
(def-var! "jolt.host" "form-special?" hc-special?)
(def-var! "jolt.host" "compile-ns" hc-current-ns)
(def-var! "jolt.host" "late-bind?" hc-late-bind?)
(def-var! "jolt.host" "form-macro?" hc-macro?)
(def-var! "jolt.host" "form-expand-1" hc-expand-1)
(def-var! "jolt.host" "resolve-global" hc-resolve-global)
(def-var! "jolt.host" "host-intern!" hc-intern!)
(def-var! "jolt.host" "form-syntax-quote-lower" hc-syntax-quote-lower)
(def-var! "jolt.host" "record-type?" hc-record-type?)
(def-var! "jolt.host" "record-ctor-key" hc-record-ctor-key)
(def-var! "jolt.host" "record-shapes" hc-record-shapes)
(def-var! "jolt.host" "inline-enabled?" hc-inline-enabled?)
(def-var! "jolt.host" "inline-ir" hc-inline-ir))
(hc-install!)

View file

@ -11,7 +11,7 @@
(import ../../src/jolt/api :as api)
(import ./driver :as d)
(defn- fingerprint []
(defn fingerprint []
# Hash the inputs that shape the prelude: the core tiers + the emitter + the
# Chez RT shims. Any change invalidates the cached prelude.
(def parts @[])
@ -32,7 +32,7 @@
(array/push parts (slurp f)))
(string/slice (string (hash (string/join parts))) 0))
(defn- ensure-prelude [ctx]
(defn ensure-prelude [ctx]
(def dir (or (os/getenv "JOLT_IMAGE_CACHE_DIR") (os/getenv "TMPDIR") "/tmp"))
(def path (string dir "/jolt-chez-prelude-" (fingerprint) ".ss"))
(unless (os/stat path)