self-host: working portable analyzer -> IR -> Janet back end pipeline

The Clojure-in-Clojure front end now compiles and runs a real subset end to end:
arithmetic, if/do/let, vector/map literals, def + name-based global refs, fn,
defn (via macroexpand), recursion through the var cell, multi-arity, variadic,
and higher-order calls. Proven by test/integration/self-host-test.janet.

Pieces:
- jolt-core/jolt/analyzer.clj — PORTABLE Clojure analyzer: reader form -> IR,
  depending only on the host contract (jolt.host), never on Janet.
- src/jolt/host_iface.janet — Janet impl of the jolt.host contract (form
  introspection + resolve/macro/current-ns), installed into each ctx.
- src/jolt/backend.janet — Janet back end: IR -> Janet form -> eval; resolves
  name-based :var nodes to cells and reuses runtime helpers.

Host Janet code lives in src/jolt/ (not a host/janet/ dir): Janet resolves
relative imports per file, so cross-dir ../../src/jolt/* imports load second
instances of compiler/types/core and corrupt state. The portability boundary is
the jolt.host namespace contract + jolt-core/, not the directory.

Notes: gensym in the back end must not be Janet's (shadowed by Jolt's via use);
a jolt bug — (into #{} coll) doesn't add elements — was worked around with reduce
conj in the analyzer (filed separately).

jolt-core/jolt/analyzer.clj

@@ -0,0 +1,141 @@
+(ns jolt.analyzer
+  "Portable Clojure analyzer: reader form -> host-neutral IR (see jolt.ir).
+
+  Pure jolt-core — depends only on the host contract (jolt.host) for form
+  introspection and symbol/macro resolution, never on Janet. ctx is an opaque
+  host handle threaded to the contract fns; the analyzer never inspects it.
+
+  Coverage grows toward compiler.janet; unsupported forms throw :jolt/uncompilable
+  so the caller falls back to the interpreter (the hybrid contract)."
+  (:require [jolt.ir :as ir]
+            [jolt.host :as h]))
+
+(declare analyze analyze-fn)
+
+;; Special forms the analyzer compiles itself. Anything else with a special head
+;; (ns, deftype, defmacro, …) is left to the interpreter via uncompilable.
+(def ^:private handled
+  #{"quote" "if" "do" "def" "fn*" "let*" "throw"})
+
+(defn- uncompilable [why]
+  (throw (str "jolt/uncompilable: " why)))
+
+(defn- analyze-seq
+  "Analyze a body of forms into IR statements+ret (a :do, or the single node)."
+  [ctx forms locals]
+  (let [v (mapv #(analyze ctx % locals) forms)
+        n (count v)]
+    (cond
+      (zero? n) (ir/const nil)
+      (= 1 n) (first v)
+      :else (ir/do-node (subvec v 0 (dec n)) (peek v)))))
+
+(defn- analyze-special [ctx op items locals]
+  (case op
+    "quote" (ir/quote-node (second items))
+    "if" (ir/if-node (analyze ctx (nth items 1) locals)
+                     (analyze ctx (nth items 2) locals)
+                     (if (> (count items) 3)
+                       (analyze ctx (nth items 3) locals)
+                       (ir/const nil)))
+    "do" (analyze-seq ctx (rest items) locals)
+    "throw" (ir/throw-node (analyze ctx (nth items 1) locals))
+    "def" (let [name-sym (nth items 1)
+                nm (h/sym-name name-sym)
+                cur (h/current-ns ctx)]
+            (h/intern! ctx cur nm)
+            (ir/def-node cur nm (analyze ctx (nth items 2) locals)))
+    "let*" (let [bvec (vec (h/vector-items (nth items 1)))
+                 locals* (atom locals)
+                 pairs (loop [i 0 acc []]
+                         (if (< i (count bvec))
+                           (let [bsym (nth bvec i)
+                                 _ (when-not (h/sym? bsym)
+                                     (uncompilable "destructuring let binding"))
+                                 nm (h/sym-name bsym)
+                                 init (analyze ctx (nth bvec (inc i)) @locals*)]
+                             (swap! locals* conj nm)
+                             (recur (+ i 2) (conj acc [nm init])))
+                           acc))]
+             (ir/let-node pairs (analyze-seq ctx (drop 2 items) @locals*)))
+    "fn*" (analyze-fn ctx items locals)
+    (uncompilable (str "special form " op))))
+
+(defn- parse-params [pvec]
+  "Plain-symbol params only; & rest. Destructuring -> uncompilable."
+  (loop [i 0 fixed [] rest-name nil]
+    (if (< i (count pvec))
+      (let [p (nth pvec i)]
+        (when-not (h/sym? p) (uncompilable "destructuring fn param"))
+        (if (= "&" (h/sym-name p))
+          (let [r (nth pvec (inc i))]
+            (when-not (h/sym? r) (uncompilable "destructuring fn rest"))
+            (recur (+ i 2) fixed (h/sym-name r)))
+          (recur (inc i) (conj fixed (h/sym-name p)) rest-name)))
+      {:fixed fixed :rest rest-name})))
+
+(defn- analyze-arity [ctx pvec body locals fn-name]
+  (let [{:keys [fixed rest]} (parse-params (vec (h/vector-items pvec)))
+        locals* (cond-> (reduce conj locals fixed)
+                  rest (conj rest)
+                  fn-name (conj fn-name))]
+    {:params fixed :rest rest :body (analyze-seq ctx body locals*)}))
+
+(defn- analyze-fn [ctx items locals]
+  ;; (fn* name? params body...) | (fn* name? ([params] body...) ...)
+  (let [named (h/sym? (nth items 1))
+        fn-name (when named (h/sym-name (nth items 1)))
+        rest-items (if named (drop 2 items) (drop 1 items))
+        first* (first rest-items)]
+    (cond
+      (h/vector? first*)
+        (ir/fn-node fn-name [(analyze-arity ctx first* (rest rest-items) locals fn-name)])
+      (h/list? first*)
+        (ir/fn-node fn-name
+                    (mapv (fn [clause]
+                            (let [cl (vec (h/elements clause))]
+                              (analyze-arity ctx (first cl) (rest cl) locals fn-name)))
+                          rest-items))
+      :else (uncompilable "fn: bad params"))))
+
+(defn- analyze-symbol [ctx form locals]
+  (let [nm (h/sym-name form) ns (h/sym-ns form)]
+    (if (and (nil? ns) (contains? locals nm))
+      (ir/local nm)
+      (let [r (h/resolve-global ctx form)]
+        (case (:kind r)
+          :var (ir/var-ref (:ns r) (:name r))
+          :host (ir/host-ref (:name r))
+          ;; unresolved: a forward reference in the current ns; resolved at call time
+          (ir/var-ref (h/current-ns ctx) nm))))))
+
+(defn- analyze-list [ctx form locals]
+  (let [items (vec (h/elements form))]
+    (if (zero? (count items))
+      (ir/quote-node form)
+      (let [head (first items)
+            hname (when (and (h/sym? head) (nil? (h/sym-ns head))) (h/sym-name head))
+            shadowed (and hname (contains? locals hname))]
+        (cond
+          (and hname (not shadowed) (contains? handled hname))
+            (analyze-special ctx hname items locals)
+          (and (h/sym? head) (not shadowed) (h/macro? ctx head))
+            (analyze ctx (h/expand-1 ctx form) locals)
+          :else
+            (ir/invoke (analyze ctx head locals)
+                       (mapv #(analyze ctx % locals) (rest items))))))))
+
+(defn analyze
+  "Analyze form to IR in context ctx with the given set of local names in scope."
+  ([ctx form] (analyze ctx form #{}))
+  ([ctx form locals]
+   (cond
+     (h/literal? form) (ir/const form)
+     (h/sym? form) (analyze-symbol ctx form locals)
+     (h/vector? form) (ir/vector-node (mapv #(analyze ctx % locals) (h/vector-items form)))
+     (h/map? form) (ir/map-node (mapv (fn [p] [(analyze ctx (first p) locals)
+                                               (analyze ctx (second p) locals)])
+                                      (h/map-pairs form)))
+     (h/set? form) (ir/set-node (mapv #(analyze ctx % locals) (h/set-items form)))
+     (h/list? form) (analyze-list ctx form locals)
+     :else (ir/const form))))

jolt-core/jolt/ir.clj

@@ -19,6 +19,10 @@
 ;; A runtime primitive (cons, +, get, apply, …) the back end maps to the host RT.
 (defn rt [name] {:op :rt :name name})
 
+;; A name that resolves only via the host's own environment (e.g. + or int? on
+;; Janet) — the back end emits a host-appropriate reference.
+(defn host-ref [name] {:op :host :name name})
+
 (defn if-node [test then else] {:op :if :test test :then then :else else})
 
 (defn do-node [statements ret] {:op :do :statements statements :ret ret})

src/jolt/api.janet

@@ -11,6 +11,7 @@
 (use ./loader)
 (use ./async)
 (import ./stdlib_embed :as stdlib-embed)
+(import ./host_iface :as host)
 
 (defn normalize-pvecs
   "Deep-convert any sequential (pvec/tuple/array) to a Janet tuple. Test helper
@@ -53,6 +54,8 @@
     # clojure.core.async (channels + go blocks on Janet fibers); pre-populated
     # so (require '[clojure.core.async ...]) finds it and applies :as/:refer.
     (install-async! ctx)
+    # Host contract (ns jolt.host): the seam the portable jolt-core compiler calls.
+    (host/install! ctx)
     ctx))
 
 (defn eval-one

src/jolt/backend.janet

@@ -0,0 +1,141 @@
+# Janet back end: host-neutral IR (from jolt.analyzer) -> Janet form -> bytecode.
+#
+# Host-specific by definition (it targets Janet). It resolves name-based :var
+# nodes to Janet var cells and reuses runtime helpers (jolt-call, make-vec,
+# build-map-literal). The portable front end (jolt.analyzer) never sees any of
+# this; a different runtime provides its own back end against the same IR.
+#
+# In src/jolt/ (not host/janet/) for the same module-resolution reason as
+# host_iface — see that file's header.
+
+(use ./types)
+(use ./core)
+(import ./compiler :as comp)
+(use ./evaluator)
+(import ./reader :as r)
+
+# Var late-binding: deref/set through the cell via a memoized closure so compiled
+# code sees redefinition (Janet early-binds plain symbols). Same scheme as the
+# bootstrap compiler.
+(defn- var-getter [cell]
+  (or (get cell :jolt/getter)
+      (let [g (fn [] (var-get cell))] (put cell :jolt/getter g) g)))
+(defn- var-setter [cell]
+  (or (get cell :jolt/setter)
+      (let [s (fn [v] (bind-root cell v) cell)] (put cell :jolt/setter s) s)))
+
+(defn- cell-for [ctx ns-name nm]
+  (ns-intern (ctx-find-ns ctx ns-name) nm))
+
+# Fresh Janet symbol for back-end-introduced bindings (arity dispatch). NOT
+# Janet's `gensym` — `(use ./core)` shadows it with Jolt's, which returns a jolt
+# symbol struct (invalid in a Janet param position).
+(var- gsym-counter 0)
+(defn- gsym [] (def s (symbol "_be$" gsym-counter)) (++ gsym-counter) s)
+
+(var emit nil)
+
+(defn- emit-seq [ctx node]
+  (def out @['do])
+  (each s (vview (node :statements)) (array/push out (emit ctx s)))
+  (array/push out (emit ctx (node :ret)))
+  (tuple/slice out))
+
+(defn- emit-let [ctx node]
+  (def binds @[])
+  (each pair (vview (node :bindings))
+    (def p (vview pair))
+    (array/push binds (symbol (in p 0)))
+    (array/push binds (emit ctx (in p 1))))
+  ['let (tuple/slice binds) (emit ctx (node :body))])
+
+(defn- emit-arity-fn [ctx ar]
+  (def ps @[])
+  (each pn (vview (ar :params)) (array/push ps (symbol pn)))
+  (when (ar :rest) (array/push ps '&) (array/push ps (symbol (ar :rest))))
+  ['fn (tuple/slice ps) (emit ctx (ar :body))])
+
+(defn- emit-fn [ctx node]
+  (def arities (vview (node :arities)))
+  (if (= 1 (length arities))
+    (emit-arity-fn ctx (first arities))
+    # Multi-arity: dispatch on arg count; fixed arities match exactly, the
+    # variadic one matches >= its fixed count. apply spreads the captured args
+    # into the chosen arity fn (whose own & collects any rest).
+    (let [jargs (gsym)
+          nsym (gsym)
+          cf @['cond]]
+      (each ar arities
+        (def nfixed (length (vview (ar :params))))
+        (array/push cf (if (ar :rest) [>= nsym nfixed] [= nsym nfixed]))
+        (array/push cf [apply (emit-arity-fn ctx ar) jargs]))
+      (array/push cf ['error "wrong number of args passed to fn"])
+      ['fn ['& jargs]
+       ['do ['def nsym ['length jargs]] (tuple/slice cf)]])))
+
+(defn- direct-call? [fnode]
+  (case (fnode :op) :var true :local true :fn true :host true false))
+
+(defn- emit-invoke [ctx node]
+  (def f (emit ctx (node :fn)))
+  (def args (map |(emit ctx $) (vview (node :args))))
+  (if (direct-call? (node :fn))
+    (tuple f ;args)
+    (tuple jolt-call f ;args)))
+
+(defn- emit-vector [ctx node]
+  (def items (map |(emit ctx $) (vview (node :items))))
+  (tuple make-vec (tuple/slice (array/concat @['tuple] items))))
+
+(defn- emit-map [ctx node]
+  (def args @[comp/build-map-literal])
+  (each pair (vview (node :pairs))
+    (def p (vview pair))
+    (array/push args (emit ctx (in p 0)))
+    (array/push args (emit ctx (in p 1))))
+  (tuple/slice args))
+
+(set emit
+  (fn emit [ctx node]
+    (case (node :op)
+      :const (node :val)
+      :local (symbol (node :name))
+      :host (symbol (node :name))
+      :var (tuple (var-getter (cell-for ctx (node :ns) (node :name))))
+      :if ['if (emit ctx (node :test)) (emit ctx (node :then)) (emit ctx (node :else))]
+      :do (emit-seq ctx node)
+      :throw ['error (emit ctx (node :expr))]
+      :def (tuple (var-setter (cell-for ctx (node :ns) (node :name))) (emit ctx (node :init)))
+      :let (emit-let ctx node)
+      :fn (emit-fn ctx node)
+      :invoke (emit-invoke ctx node)
+      :vector (emit-vector ctx node)
+      :map (emit-map ctx node)
+      :quote ['quote (node :form)]
+      (error (string "backend: unhandled op " (node :op))))))
+
+(defn emit-ir
+  "IR node -> Janet form (public entry for the back end)."
+  [ctx node]
+  (emit ctx node))
+
+# --- pipeline wiring (the self-hosted compile path) ---
+
+(defn- ensure-analyzer [ctx]
+  # Load jolt.analyzer (and transitively jolt.ir) once; jolt.host is pre-installed
+  # by host/install! so its require is a no-op.
+  (when (= 0 (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)))
+    (eval-form ctx @{} (r/parse-string "(require '[jolt.analyzer])"))))
+
+(defn analyze-form
+  "Run the portable Clojure analyzer (jolt.analyzer/analyze) on a reader form,
+  returning host-neutral IR."
+  [ctx form]
+  (ensure-analyzer ctx)
+  (def av (ns-find (ctx-find-ns ctx "jolt.analyzer") "analyze"))
+  ((var-get av) ctx form))
+
+(defn compile-and-eval
+  "Self-hosted compile path: analyze (portable Clojure) -> IR -> Janet -> eval."
+  [ctx form]
+  (eval (emit-ir ctx (analyze-form ctx form)) (comp/ctx-janet-env ctx)))

src/jolt/host_iface.janet

@@ -0,0 +1,101 @@
+# Janet implementation of the Jolt host contract (ns `jolt.host`).
+#
+# This is the seam between the portable jolt-core (analyzer/IR/core, pure Clojure
+# under jolt-core/) and the Janet runtime. jolt-core calls ONLY these functions —
+# never Janet directly. Re-hosting Jolt to another runtime means reimplementing
+# this contract (+ the back end and RT) for that runtime.
+#
+# Lives in src/jolt/ (with the rest of the Janet host) rather than a separate
+# host/janet/ dir: Janet resolves relative imports per-file, so a host/janet
+# module importing ../../src/jolt/* loads SECOND instances of compiler/types/core
+# (inconsistent state). The portability boundary is the `jolt.host` namespace
+# contract + jolt-core/, not the directory.
+#
+# Two groups:
+#   1. Form introspection — reader forms are host-specific (the reader is the
+#      host's), so shape predicates/accessors live here. Returns jolt values the
+#      analyzer walks with ordinary Clojure.
+#   2. Compile-time environment — resolve symbols to vars/macros, expand macros,
+#      the current namespace. These take ctx (an opaque host handle).
+
+(use ./types)
+(use ./evaluator)
+(use ./core)
+
+# ---------------------------------------------------------------------------
+# Form introspection
+# ---------------------------------------------------------------------------
+
+(defn h-sym? [form] (and (struct? form) (= :symbol (form :jolt/type))))
+(defn h-sym-name [form] (form :name))
+(defn h-sym-ns [form] (form :ns))
+
+(defn h-list? [form] (array? form))          # a call / list (reader: array)
+(defn h-vector? [form] (tuple? form))        # a vector literal (reader: tuple)
+(defn h-map? [form] (and (struct? form) (nil? (form :jolt/type))))
+(defn h-set? [form] (and (struct? form) (= :jolt/set (form :jolt/type))))
+(defn h-char? [form] (and (struct? form) (= :jolt/char (form :jolt/type))))
+
+(defn h-literal? [form]
+  (or (nil? form) (boolean? form) (number? form) (string? form)
+      (keyword? form) (h-char? form)))
+
+# Items of a list/vector as a jolt vector, so the analyzer walks them with Clojure.
+(defn h-elements [form] (make-vec form))
+(defn h-vector-items [form] (make-vec form))
+(defn h-map-pairs [form]
+  (make-vec (map (fn [k] (make-vec [k (get form k)])) (keys form))))
+(defn h-set-items [form] (make-vec (form :value)))
+
+# ---------------------------------------------------------------------------
+# Compile-time environment
+# ---------------------------------------------------------------------------
+
+(defn h-current-ns [ctx] (ctx-current-ns ctx))
+
+(defn h-macro? [ctx sym]
+  (let [v (resolve-var ctx @{} sym)]
+    (if (and v (var-macro? v)) true false)))
+
+(defn h-expand-1 [ctx form]
+  (let [head (in form 0)
+        v (resolve-var ctx @{} head)
+        macro-fn (var-get v)]
+    (apply macro-fn (tuple/slice form 1))))
+
+# Classify a global (non-local) symbol reference:
+#   {:kind :var  :ns NS :name NAME}  — a Jolt var (current ns / clojure.core)
+#   {:kind :host :name NAME}         — resolves only via the host env (+, int?, …),
+#                                      same fallback the interpreter's resolve-sym uses
+#   {:kind :unresolved :name NAME}   — not yet defined (forward reference)
+(defn h-resolve-global [ctx sym]
+  (let [v (resolve-var ctx @{} sym)]
+    (if v
+      {:kind :var :ns (var-ns v) :name (var-name v)}
+      (let [nm (sym :name)
+            entry (in (fiber/getenv (fiber/current)) (symbol nm))]
+        (if (not (nil? entry))
+          {:kind :host :name nm}
+          {:kind :unresolved :name nm})))))
+
+(defn h-intern! [ctx ns-name nm]
+  (ns-intern (ctx-find-ns ctx ns-name) nm)
+  nil)
+
+# ---------------------------------------------------------------------------
+# Installation: bind these fns as vars in the `jolt.host` namespace so jolt-core
+# can call them. Idempotent per context.
+# ---------------------------------------------------------------------------
+
+(def- exports
+  {"sym?" h-sym? "sym-name" h-sym-name "sym-ns" h-sym-ns
+   "list?" h-list? "vector?" h-vector? "map?" h-map? "set?" h-set? "char?" h-char?
+   "literal?" h-literal? "elements" h-elements "vector-items" h-vector-items
+   "map-pairs" h-map-pairs "set-items" h-set-items
+   "current-ns" h-current-ns "macro?" h-macro? "expand-1" h-expand-1
+   "resolve-global" h-resolve-global "intern!" h-intern!})
+
+(defn install! [ctx]
+  (def ns (ctx-find-ns ctx "jolt.host"))
+  (eachp [nm f] exports (ns-intern ns nm f))
+  ns)

test/integration/self-host-test.janet

@@ -0,0 +1,48 @@
+# End-to-end proof of the self-hosting pipeline: a reader form is analyzed by the
+# PORTABLE Clojure analyzer (jolt.analyzer, in jolt-core) into host-neutral IR,
+# then the Janet back end lowers the IR to a Janet form and evaluates it. No use
+# of compiler.janet's analyzer — this is the Clojure-in-Clojure front end.
+(import ../../src/jolt/backend :as backend)
+(use ../../src/jolt/api)
+(use ../../src/jolt/reader)
+
+(defn ce [ctx s] (normalize-pvecs (backend/compile-and-eval ctx (parse-string s))))
+
+(print "self-host pipeline (Clojure analyzer -> IR -> Janet)...")
+(let [ctx (init)]
+  # primitives + control flow
+  (assert (= 3 (ce ctx "(+ 1 2)")) "+")
+  (assert (= 6 (ce ctx "(* 2 3)")) "*")
+  (assert (= :a (ce ctx "(if true :a :b)")) "if true")
+  (assert (= :b (ce ctx "(if false :a :b)")) "if false")
+  (assert (= 10 (ce ctx "(let [x 4 y 6] (+ x y))")) "let")
+  (assert (= 6 (ce ctx "(do 1 2 6)")) "do")
+
+  # literals
+  (assert (= [2 3 4] (ce ctx "(map inc [1 2 3])")) "vector literal + core fn")
+  (assert (= 1 (ce ctx "(get {:a 1 :b 2} :a)")) "map literal")
+  (assert (= 42 (ce ctx "(quote 42)")) "quote literal")
+
+  # def + global reference (name-based var resolution)
+  (ce ctx "(def base 100)")
+  (assert (= 142 (ce ctx "(+ base 42)")) "def + later ref")
+
+  # fn / defn (defn is a macro -> expand -> def of fn*)
+  (ce ctx "(defn add [a b] (+ a b))")
+  (assert (= 7 (ce ctx "(add 3 4)")) "defn")
+  (assert (= 49 (ce ctx "((fn [x] (* x x)) 7)")) "anon fn")
+
+  # recursion through the var cell (no recur needed)
+  (ce ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
+  (assert (= 55 (ce ctx "(fib 10)")) "recursive fib via var")
+
+  # multi-arity + variadic
+  (ce ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
+  (assert (= 5 (ce ctx "(arity 5)")) "multi-arity 1")
+  (assert (= 7 (ce ctx "(arity 3 4)")) "multi-arity 2")
+  (assert (= 15 (ce ctx "(arity 1 2 3 4 5)")) "multi-arity variadic")
+
+  # higher-order + nesting
+  (assert (= 15 (ce ctx "(reduce + (map inc [0 1 2 3 4]))")) "reduce+map"))
+
+(print "self-host pipeline passed!")