From c2d977cadfb2db6041d6c77b61f837eb512cfdde Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 19 Jun 2026 21:16:24 -0400 Subject: [PATCH] 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. --- host/chez/compile-eval.ss | 28 ++++++ host/chez/converters.ss | 5 + host/chez/driver.janet | 95 ++++++++++++++++++ host/chez/host-contract.ss | 197 +++++++++++++++++++++++++++++++++++++ host/chez/jolt-chez.janet | 4 +- test/chez/spine-test.janet | 71 +++++++++++++ 6 files changed, 398 insertions(+), 2 deletions(-) create mode 100644 host/chez/compile-eval.ss create mode 100644 host/chez/host-contract.ss create mode 100644 test/chez/spine-test.janet diff --git a/host/chez/compile-eval.ss b/host/chez/compile-eval.ss new file mode 100644 index 0000000..c68cd87 --- /dev/null +++ b/host/chez/compile-eval.ss @@ -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))) diff --git a/host/chez/converters.ss b/host/chez/converters.ss index 44ad8fb..5a42b89 100644 --- a/host/chez/converters.ss +++ b/host/chez/converters.ss @@ -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) diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 6526ccd..f075071 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -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`." diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss new file mode 100644 index 0000000..f08bc94 --- /dev/null +++ b/host/chez/host-contract.ss @@ -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!) diff --git a/host/chez/jolt-chez.janet b/host/chez/jolt-chez.janet index 4dc0d3f..fafcefa 100644 --- a/host/chez/jolt-chez.janet +++ b/host/chez/jolt-chez.janet @@ -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) diff --git a/test/chez/spine-test.janet b/test/chez/spine-test.janet new file mode 100644 index 0000000..789656a --- /dev/null +++ b/test/chez/spine-test.janet @@ -0,0 +1,71 @@ +# Chez Phase 3 inc6 (jolt-hs9n) — the zero-Janet spine. +# +# Validates that the analyzer + emitter, cross-compiled to Scheme and run ON CHEZ +# over the host contract (host-contract.ss), compile and run macro-free Clojure +# from source with NO Janet in the loop: read (reader.ss) -> analyze (jolt.analyzer +# on Chez) -> IR -> emit (jolt.backend-scheme on Chez) -> eval. +# +# Oracle = the Janet-hosted analyzer through the SAME Chez emitter/RT/printer +# (d/eval-e-with-prelude): the only difference under test is WHERE analysis runs +# (Janet vs Chez), so equal stdout means moving analysis onto Chez is behavior- +# preserving. Macros (let/when/->/defn) are inc6b (jolt-r8ku, runtime macros). +# +# janet test/chez/spine-test.janet +(import ../../src/jolt/api :as api) +(import ../../host/chez/driver :as d) +(import ../../host/chez/jolt-chez :as jc) + +(var total 0) (var fails 0) +(defn ok [name pred &opt extra] + (++ total) + (if pred (printf "ok: %s" name) + (do (++ fails) (printf "FAIL: %s %s" name (or extra ""))))) + +(unless (d/chez-available?) + (print "chez not on PATH — skipping spine-test") + (os/exit 0)) + +(def ctx (d/make-ctx)) +(def prelude-path (jc/ensure-prelude ctx)) + +# compiler image cache, keyed by the cross-compiled sources + the host contract. +(defn- image-fingerprint [] + (string/slice (string (hash (string/join + (map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj" + "jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss" + "host/chez/compile-eval.ss"])))) 0)) +(def image-path + (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss")) +(d/ensure-compiler-image ctx image-path) + +# Each case: the Chez-hosted spine value must equal the Janet-hosted oracle value +# (both printed via jolt-final-str on Chez). +(defn check [src] + (def [ocode oout oerr] (d/eval-e-with-prelude ctx src prelude-path)) + (def [acode aout aerr] (d/eval-zero-janet prelude-path image-path src)) + (cond + (= ocode :emit-err) (ok src false (string "oracle emit-err: " oout)) + (not (zero? acode)) (ok src false (string "zero-janet exit " acode ": " aerr " | out=" aout)) + (ok src (= oout aout) (string "chez=" aout " oracle=" oout)))) + +# macro-free forms: handled specials (if/do/fn*), native ops, consts, invoke. +(each src + ["(if true 10 20)" + "(if false 10 20)" + "(do 1 2 3)" + "(+ 1 2)" + "(- 10 3 2)" + "((fn* [x] (* x x)) 7)" + "((fn* [x] (+ x 1)) 5)" + "((fn* [a b] (+ a b)) 3 4)" + "(if (< 3 5) :yes :no)" + "(if (> 3 5) :yes :no)" + "((fn* [x] (if x :t :f)) true)" + "(do (if true 1 2) (* 6 7))" + "((fn* [n] (* n n n)) 4)" + "(< 1 2)" + "(= 5 5)"] + (check src)) + +(printf "\n%d/%d ok" (- total fails) total) +(when (> fails 0) (os/exit 1))