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).
This commit is contained in:
Yogthos
parent
b1ac427bdd
commit
849449aada
6 changed files with 438 additions and 0 deletions
141
jolt-core/jolt/analyzer.clj
Normal file
141
jolt-core/jolt/analyzer.clj
Normal file
|
|
@ -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))))
|
||||
|
|
@ -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})
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue