diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 682db73..f1c45e9 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -364,6 +364,48 @@ (def code (os/proc-wait proc)) [code (string/trim out) (string/trim err)]) +# --- self-hosting fixpoint (jolt-cf1q.4 inc8) --------------------------------- +# emit-compiler-image (above) builds stage1: the Janet analyzer/emitter +# cross-compiles the compiler sources to a Scheme def-var! image. To prove the +# ON-CHEZ compiler reproduces itself we recompile the SAME sources WITH the loaded +# image (emit-image.ss's jolt-emit-image runs analyze->emit on Chez): feeding it +# stage1 yields stage2, feeding it stage2 yields stage3, and stage2 == stage3 +# byte-for-byte is the fixpoint (self-hosting-bootstrap-research §4). + +(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] + (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" + "(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")) + +(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 + [code stderr]." + [prelude-path image-path out-path] + (def prog (program-emit-image prelude-path image-path out-path)) + (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})) + (def out (drain (proc :out))) + (def err (drain (proc :err))) + (def code (os/proc-wait proc)) + [code (string/trim (string out err))]) + # --- batched zero-Janet corpus runner (jolt-qjr0, inc7) ----------------------- # eval-zero-janet spawns a fresh chez per case, each reloading rt.ss + the prelude # (~282KB) + the compiler image (~89KB) from source — ~0.5s of pure reload per diff --git a/host/chez/emit-image.ss b/host/chez/emit-image.ss new file mode 100644 index 0000000..3da6b90 --- /dev/null +++ b/host/chez/emit-image.ss @@ -0,0 +1,72 @@ +;; emit-image.ss (jolt-cf1q.4 inc8) — the on-Chez compiler-image emitter. +;; +;; This is the stage2/stage3 half of the self-hosting fixpoint. driver.janet's +;; emit-compiler-image cross-compiles the compiler sources (jolt.ir + +;; jolt.analyzer + jolt.backend-scheme) to a Scheme def-var! image USING THE JANET +;; analyzer/emitter — that is stage1. This file does the SAME job but 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). Mirrors the +;; Janet driver's parse-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. Matches driver.janet.) +(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"))))) + +;; 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. +(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)))))))) + +;; The compiler namespaces, in load order — same list as driver.janet +;; compiler-ns-files. +(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"))) + +;; 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)))))))) diff --git a/test/chez/fixpoint-test.janet b/test/chez/fixpoint-test.janet new file mode 100644 index 0000000..f86eae2 --- /dev/null +++ b/test/chez/fixpoint-test.janet @@ -0,0 +1,109 @@ +# Chez Phase 3 inc8 (jolt-bzni) — the stage2==stage3 self-hosting fixpoint. +# +# The zero-Janet spine (spine-test / run-corpus-zero-janet) proves the ON-CHEZ +# analyzer+emitter compile arbitrary Clojure faithfully. This proves the stronger +# property from self-hosting-bootstrap-research §4: the on-Chez compiler reproduces +# ITSELF. The compiler image (jolt.ir + jolt.analyzer + jolt.backend-scheme cross- +# compiled to Scheme def-var! forms) is built three ways: +# +# stage1 = Janet analyzer/emitter cross-compiles the compiler sources +# (driver/emit-compiler-image — the current bootstrap input) +# stage2 = the ON-CHEZ compiler loaded from stage1 re-emits the same sources +# (driver/emit-image-on-chez, host/chez/emit-image.ss) +# stage3 = the ON-CHEZ compiler loaded from stage2 re-emits them again +# +# stage1 differs from stage2 only in gensym numbering (the Janet build allocates +# more gensyms before reaching the compiler emit), so the fixpoint is stage2 vs +# stage3: both are produced by Chez from a fresh process, so a byte-for-byte match +# means the compiler has converged — it compiles its own source to itself. We also +# run real compile+eval cases THROUGH stage2 to prove it's a working compiler, not +# a degenerate one that just happens to be stable. +# +# janet test/chez/fixpoint-test.janet +(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 fixpoint-test") + (os/exit 0)) + +(def ctx (d/make-ctx)) +(def prelude-path (jc/ensure-prelude ctx)) + +# stage1: the Janet cross-compiled image, cached by source fingerprint (same scheme +# as spine-test / run-corpus-zero-janet). +(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 tmp (or (os/getenv "TMPDIR") "/tmp")) +(def stage1 (string tmp "/jolt-compiler-image-" (image-fingerprint) ".ss")) +(def t0 (os/clock)) +(d/ensure-compiler-image ctx stage1) +(printf "stage1 (Janet cross-compile): %d bytes (%.1fs)" (length (slurp stage1)) (- (os/clock) t0)) +(flush) + +# stage2 = on-Chez compiler (from stage1) re-emits the compiler. Fresh temp path so +# it always regenerates. +(def stage2 (string tmp "/jolt-fixpoint-stage2-" (os/getpid) ".ss")) +(def stage3 (string tmp "/jolt-fixpoint-stage3-" (os/getpid) ".ss")) +(def t1 (os/clock)) +(def [c2 e2] (d/emit-image-on-chez prelude-path stage1 stage2)) +(ok "stage2 emits cleanly on Chez" (and (= c2 0) (os/stat stage2)) + (string "exit " c2 " " (string/slice e2 0 (min 300 (length e2))))) +(when (os/stat stage2) + (printf "stage2 (on-Chez, from stage1): %d bytes (%.1fs)" (length (slurp stage2)) (- (os/clock) t1))) +(flush) + +# stage3 = on-Chez compiler (from stage2) re-emits the compiler. +(def t2 (os/clock)) +(def [c3 e3] (d/emit-image-on-chez prelude-path stage2 stage3)) +(ok "stage3 emits cleanly on Chez" (and (= c3 0) (os/stat stage3)) + (string "exit " c3 " " (string/slice e3 0 (min 300 (length e3))))) +(when (os/stat stage3) + (printf "stage3 (on-Chez, from stage2): %d bytes (%.1fs)" (length (slurp stage3)) (- (os/clock) t2))) +(flush) + +# THE FIXPOINT: stage2 and stage3 must be byte-for-byte identical. +(when (and (os/stat stage2) (os/stat stage3)) + # slurp returns a buffer; Janet = on buffers is identity, so compare as strings. + (def s2 (string (slurp stage2))) (def s3 (string (slurp stage3))) + (ok "stage2 == stage3 (byte-for-byte fixpoint)" (= s2 s3) + (if (= s2 s3) "" + (string "sizes " (length s2) " vs " (length s3) + "; first diff at " + (let [n (min (length s2) (length s3))] + (var i 0) (while (and (< i n) (= (s2 i) (s3 i))) (++ i)) i)))) + # A degenerate emitter (emits nothing) would also be "stable" — guard against it. + (ok "stage2 image is substantial (> 80KB)" (> (length s2) 80000) + (string "only " (length s2) " bytes"))) + +# stage2 must be a WORKING compiler: drive real compile+eval through it. +(def verify-cases + [["(let [x 1 y 2] (+ x y))" "3"] + ["(when (> 5 3) (-> 10 (- 1) (* 2)))" "18"] + ["(defn f [a b] (* a b)) (f 6 7)" "42"] + ["(map inc [1 2 3])" "(2 3 4)"] + ["(reduce + 0 (range 5))" "10"] + ["(filter even? (range 10))" "(0 2 4 6 8)"]]) +(when (os/stat stage2) + (var vpass 0) + (each [src want] verify-cases + (def [code out _] (d/eval-zero-janet prelude-path stage2 (string "(do " src ")"))) + (when (and (= code 0) (= out want)) (++ vpass))) + (ok "stage2 is a working compiler (real cases compile+run)" + (= vpass (length verify-cases)) + (string vpass "/" (length verify-cases) " cases passed"))) + +# cleanup temp stages +(each p [stage2 stage3] (when (os/stat p) (os/rm p))) + +(printf "\nfixpoint-test: %d/%d checks passed" (- total fails) total) +(os/exit (if (zero? fails) 0 1))