From 874e3c7cf2310cb09dd780e96531d45c89e88c00 Mon Sep 17 00:00:00 2001
From: Yogthos <yogthos@gmail.com>
Date: Wed, 17 Jun 2026 13:15:57 -0400
Subject: [PATCH] Chez Phase 1 (increment 1): IR -> Scheme emitter, real IR
 shapes

New back end half: host/chez/emit.janet consumes the host-neutral jolt IR
(ir.clj shapes) and emits Scheme, reusing the existing front-end (Option-2
backend swap). Covers the pure-functional subset: const/local/var/rt/if/do/let/
fn/invoke/def/loop/recur. Tested by hand-built IR run on Chez: (+ 1 2)=3,
fib(30)=832040, loop/recur sum=15 (4/4).

Finding: correct emit wraps every if-test in jolt-truthy?, costing ~3x on fib
(15.8ms vs hand-Scheme 5ms). Eliding the wrapper for known-boolean tests
recovers the ceiling (Phase-4 type-driven opt).

Remaining Phase 1: wire the live analyzer, var-cell late binding, RT module,
broader op coverage for mandelbrot.
---
 host/chez/emit.janet      | 106 ++++++++++++++++++++++++++++++++++++++
 test/chez/emit-test.janet |  73 ++++++++++++++++++++++++++
 2 files changed, 179 insertions(+)
 create mode 100644 host/chez/emit.janet
 create mode 100644 test/chez/emit-test.janet

diff --git a/host/chez/emit.janet b/host/chez/emit.janet
new file mode 100644
index 0000000..18698b4
--- /dev/null
+++ b/host/chez/emit.janet
@@ -0,0 +1,106 @@
+# Phase 1 — jolt IR -> Chez Scheme emitter (jolt-cf1q.2).
+#
+# The new back end: consumes the SAME host-neutral IR (jolt.ir, see
+# jolt-core/jolt/ir.clj) the analyzer produces and the Janet backend consumes,
+# but emits Scheme source text instead of Janet. `host/compile` (Chez `eval`)
+# turns that into a procedure. This increment covers the pure-functional subset
+# (const/local/var/rt/if/do/let/fn/invoke/def/loop/recur) — enough to run
+# fib/mandelbrot-shaped code through the REAL IR. Globals are early-bound here;
+# var-cell late binding is the next increment.
+#
+# IR nodes are plain :op-tagged structs/tables (keyword keys), matching ir.clj.
+
+(def rt-map
+  # jolt RT primitive name -> Scheme. = is the exactness-aware jolt= from
+  # values.ss; inc/dec/quot get preamble shims. Arithmetic/compare are native.
+  {"+" "+" "-" "-" "*" "*" "/" "/"
+   "<" "<" ">" ">" "<=" "<=" ">=" ">="
+   "=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec"
+   "mod" "modulo" "quot" "quotient" "rem" "remainder"})
+
+(var- recur-target nil)
+(var- gensym-n 0)
+(defn- fresh-label [prefix] (string prefix (++ gensym-n)))
+
+# MVP: jolt local/var names are valid Scheme identifiers (inc, even?, + all are).
+(defn- munge [name] name)
+
+(var emit nil)   # forward declaration (mutual recursion with the helpers below)
+
+(defn- emit-const [v]
+  (cond
+    (nil? v) "jolt-nil"
+    (boolean? v) (if v "#t" "#f")
+    (number? v) (string v)
+    (string? v) (string/format "%j" v)   # quoted+escaped string literal
+    (errorf "emit-const: unsupported literal %p" v)))
+
+(defn- emit-binding [b]
+  (string "(" (munge (get b 0)) " " (emit (get b 1)) ")"))
+
+(defn- emit-let [node]
+  (string "(let* (" (string/join (map emit-binding (get node :bindings)) " ") ") "
+          (emit (get node :body)) ")"))
+
+(defn- emit-loop [node]
+  (def label (fresh-label "loop"))
+  (def bs (string/join (map emit-binding (get node :bindings)) " "))
+  (def prev recur-target)
+  (set recur-target label)
+  (def body (emit (get node :body)))
+  (set recur-target prev)
+  (string "(let " label " (" bs ") " body ")"))
+
+(defn- emit-recur [node]
+  (unless recur-target (error "emit: recur outside a loop/fn target"))
+  (string "(" recur-target " " (string/join (map emit (get node :args)) " ") ")"))
+
+(defn- emit-fn [node]
+  (def arities (get node :arities))
+  (when (not= 1 (length arities)) (error "emit: multi-arity fn not in this increment"))
+  (def a (first arities))
+  (when (get a :rest) (error "emit: variadic fn not in this increment"))
+  (def params (map munge (get a :params)))
+  # wrap the body in a named let so fn-level `recur` rebinds the params
+  (def label (fresh-label "fnrec"))
+  (def prev recur-target)
+  (set recur-target label)
+  (def body (emit (get a :body)))
+  (set recur-target prev)
+  (string "(lambda (" (string/join params " ") ") "
+          "(let " label " (" (string/join (map (fn [p] (string "(" p " " p ")")) params) " ") ") "
+          body "))"))
+
+(set emit (fn emit [node]
+  (case (get node :op)
+    :const (emit-const (get node :val))
+    :local (munge (get node :name))
+    :var   (munge (get node :name))           # early-bound (MVP)
+    :rt    (or (get rt-map (get node :name))
+               (errorf "emit: unmapped rt primitive %s" (get node :name)))
+    :host  (get node :name)
+    :if    (string "(if (jolt-truthy? " (emit (get node :test)) ") "
+                   (emit (get node :then)) " " (emit (get node :else)) ")")
+    :do    (string "(begin "
+                   (string/join (map emit (get node :statements)) " ")
+                   (if (empty? (get node :statements)) "" " ")
+                   (emit (get node :ret)) ")")
+    :invoke (string "(" (emit (get node :fn)) " "
+                    (string/join (map emit (get node :args)) " ") ")")
+    :let   (emit-let node)
+    :loop  (emit-loop node)
+    :recur (emit-recur node)
+    :fn    (emit-fn node)
+    :def   (string "(define " (munge (get node :name)) " " (emit (get node :init)) ")")
+    (errorf "emit: unhandled op %p" (get node :op)))))
+
+# Wrap emitted top-level forms into a runnable Chez program: preamble (value
+# model + rt shims) then the forms, then print `final` (a Scheme expr string).
+(defn program [forms-scheme final]
+  (string
+    "(import (chezscheme))\n"
+    "(load \"host/chez/values.ss\")\n"
+    "(define (jolt-inc x) (+ x 1))\n"
+    "(define (jolt-dec x) (- x 1))\n"
+    (string/join forms-scheme "\n") "\n"
+    "(printf \"~a\\n\" " final ")\n"))
diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet
new file mode 100644
index 0000000..a737a8b
--- /dev/null
+++ b/test/chez/emit-test.janet
@@ -0,0 +1,73 @@
+# Phase 1 — IR -> Scheme emitter tests. Hand-built IR in the real ir.clj shapes,
+# emitted to Scheme, compiled+run on Chez, results + fib speed checked.
+#   janet test/chez/emit-test.janet      (from repo root)
+(import ../../host/chez/emit :as e)
+
+(defn run-chez [src]
+  (spit "/tmp/emit-prog.ss" src)
+  (def proc (os/spawn ["chez" "--script" "/tmp/emit-prog.ss"] :p {:out :pipe :err :pipe}))
+  (def out (ev/read (proc :out) 0x100000))
+  (def err (ev/read (proc :err) 0x100000))
+  (def code (os/proc-wait proc))
+  [code (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))])
+
+(var total 0) (var fails 0)
+(defn ok [name pred] (++ total) (unless pred (++ fails) (printf "FAIL: %s" name)))
+
+# --- IR builders (ir.clj shapes) ---
+(defn rt [name & args] {:op :invoke :fn {:op :rt :name name} :args args})
+(defn lcl [n] {:op :local :name n})
+(defn k [v] {:op :const :val v})
+
+# 1) (+ 1 2)
+(def add-ir (rt "+" (k 1) (k 2)))
+(let [[code out err] (run-chez (e/program [] (e/emit add-ir)))]
+  (ok "(+ 1 2) = 3" (and (= code 0) (= out "3")))
+  (when (not= code 0) (printf "  err: %s" err)))
+
+# 2) fib def + (fib 30)
+(defn fib-call [arg] {:op :invoke :fn {:op :var :ns "user" :name "fib"} :args [arg]})
+(def fib-def
+  {:op :def :ns "user" :name "fib"
+   :init {:op :fn :name "fib"
+          :arities [{:params ["n"]
+                     :body {:op :if
+                            :test (rt "<" (lcl "n") (k 2))
+                            :then (lcl "n")
+                            :else (rt "+" (fib-call (rt "-" (lcl "n") (k 1)))
+                                          (fib-call (rt "-" (lcl "n") (k 2))))}}]}})
+(let [prog (e/program [(e/emit fib-def)] (e/emit (fib-call (k 30))))
+      [code out err] (run-chez prog)]
+  (ok "(fib 30) = 832040" (and (= code 0) (= out "832040")))
+  (when (not= code 0) (printf "  err: %s" err)))
+
+# 3) loop/recur sum 1..5 = 15
+(def loop-ir
+  {:op :loop
+   :bindings [["i" (k 1)] ["acc" (k 0)]]
+   :body {:op :if
+          :test (rt ">" (lcl "i") (k 5))
+          :then (lcl "acc")
+          :else {:op :recur :args [(rt "inc" (lcl "i")) (rt "+" (lcl "acc") (lcl "i"))]}}})
+(let [[code out err] (run-chez (e/program [] (e/emit loop-ir)))]
+  (ok "loop/recur sum = 15" (and (= code 0) (= out "15")))
+  (when (not= code 0) (printf "  err: %s" err)))
+
+# 4) speed: emitted fib(30) should hit ~the spike ceiling (hand-Scheme ~5ms),
+#    proving the IR->Scheme path adds no overhead vs hand-written Scheme.
+(def timed-fib
+  (string (e/emit fib-def) "\n"
+          "(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
+          "(fib 24)(fib 24)\n"
+          "(let* ((t0 (now-ns)) (r (fib 30)) (ms (/ (- (now-ns) t0) 1000000.0)))\n"
+          "  (printf \"~a ~a\\n\" r (exact->inexact ms)))"))
+(let [[code out err] (run-chez (string "(import (chezscheme))\n(load \"host/chez/values.ss\")\n(define (jolt-inc x) (+ x 1))\n" timed-fib))]
+  (def parts (string/split " " out))
+  (def result (get parts 0))
+  (def ms (scan-number (or (get parts 1) "999")))
+  (ok "emitted fib(30) correct + fast" (and (= code 0) (= result "832040") (< ms 40)))
+  (printf "  emitted fib(30): %s in %.2f ms (hand-Scheme spike ~5ms)" result ms)
+  (when (not= code 0) (printf "  err: %s" err)))
+
+(printf "\nemit-test: %d/%d passed" (- total fails) total)
+(os/exit (if (> fails 0) 1 0))