simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

self-host: analyzer compiles to fast bytecode (fib(30) 0.52s)

Browse source 
The self-hosted compiler now genuinely compiles to native Janet bytecode rather
than falling back to the interpreter:
- bootstrap fixes that let it compile the analyzer: (def x) with no init, and an
  empty (do) (declare expands to one) no longer error;
- analyzer reordered so only the mutually-recursive  is forward declared
  (a deeply-nested forward ref to analyze-fn/analyze-try miscompiled to nil);
- back end emits native Janet ops for hot primitives (+,-,*,<,>,<=,>=,inc,dec)
  on clojure.core refs, like the bootstrap's core-renames.

Result: self-hosted fib(30) runs in 0.52s (was ~50s interpreted). Full
clojure-test-suite via JOLT_SELFHOST runs compiled at 3869 pass (some compiled-
vs-interpreted divergences remain to chase toward full parity — jolt-4xc).
Default suite green; conformance 218/218; jank-conformance up to 135.
This commit is contained in:
Yogthos 2026-06-06 10:25:05 -04:00
parent 06d5f51d4a
commit 3afd1c6142
3 changed files with 104 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

119
jolt-core/jolt/analyzer.clj
View file

@ -10,7 +10,10 @@
Coverage grows toward compiler.janet; unsupported forms throw :jolt/uncompilable
so the caller falls back to the interpreter (the hybrid contract).
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}."
`env` carries lexical state: {:locals #{names} :recur recur-target-name|nil}.
Definitions are ordered so only `analyze` (mutually recursive) is forward
declared — the bootstrap compiles forward refs through var cells, but keeping
them to one keeps the compiled namespace simple."
(:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke
def-node let-node fn-node vector-node map-node
quote-node throw-node]]
@ -21,7 +24,7 @@
form-macro? form-expand-1 resolve-global
host-intern!]]))
(declare analyze analyze-fn analyze-try)
(declare analyze)
(def ^:private handled
#{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"})
@ -58,62 +61,6 @@
(recur (+ i 2) (add-locals env [nm]) (conj pairs [nm init]))))
[pairs env])))
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
"if" (if-node (analyze ctx (nth items 1) env)
(analyze ctx (nth items 2) env)
(if (> (count items) 3)
(analyze ctx (nth items 3) env)
(const nil)))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)
nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env)))
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
r (analyze-bindings ctx bvec env)]
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
"loop*" (let [bvec (vec (form-vec-items (nth items 1)))
rname (gen-name "loop")
r (analyze-bindings ctx bvec env)
env** (with-recur (second r) rname)]
{:op :loop :recur-name rname :bindings (first r)
:body (analyze-seq ctx (drop 2 items) env**)})
"recur" (let [rt (:recur env)]
(when-not rt (uncompilable "recur outside loop/fn"))
{:op :recur :recur-name rt
:args (mapv #(analyze ctx % env) (rest items))})
"try" (analyze-try ctx items env)
"fn*" (analyze-fn ctx items env)
(uncompilable (str "special form " op))))
(defn- analyze-try [ctx items env]
(let [clauses (rest items)
body (atom [])
catch-sym (atom nil)
catch-body (atom nil)
finally-body (atom nil)]
(doseq [c clauses]
(let [head (when (form-list? c) (first (vec (form-elements c))))
hname (when (and head (form-sym? head)) (form-sym-name head))]
(cond
(= hname "catch")
(let [cl (vec (form-elements c))]
(reset! catch-sym (form-sym-name (nth cl 2)))
(reset! catch-body (drop 3 cl)))
(= hname "finally")
(reset! finally-body (rest (vec (form-elements c))))
:else (swap! body conj c))))
{:op :try
:body (analyze-seq ctx @body env)
:catch-sym @catch-sym
:catch-body (when @catch-body
(analyze-seq ctx @catch-body (add-locals env [@catch-sym])))
:finally (when @finally-body (analyze-seq ctx @finally-body env))}))
(defn- parse-params [pvec]
(loop [i 0 fixed [] rest-name nil]
(if (< i (count pvec))
@ -152,6 +99,62 @@
rest-items))
:else (uncompilable "fn: bad params"))))
(defn- analyze-try [ctx items env]
(let [clauses (rest items)
body (atom [])
catch-sym (atom nil)
catch-body (atom nil)
finally-body (atom nil)]
(doseq [c clauses]
(let [head (when (form-list? c) (first (vec (form-elements c))))
hname (when (and head (form-sym? head)) (form-sym-name head))]
(cond
(= hname "catch")
(let [cl (vec (form-elements c))]
(reset! catch-sym (form-sym-name (nth cl 2)))
(reset! catch-body (drop 3 cl)))
(= hname "finally")
(reset! finally-body (rest (vec (form-elements c))))
:else (swap! body conj c))))
{:op :try
:body (analyze-seq ctx @body env)
:catch-sym @catch-sym
:catch-body (when @catch-body
(analyze-seq ctx @catch-body (add-locals env [@catch-sym])))
:finally (when @finally-body (analyze-seq ctx @finally-body env))}))
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
"if" (if-node (analyze ctx (nth items 1) env)
(analyze ctx (nth items 2) env)
(if (> (count items) 3)
(analyze ctx (nth items 3) env)
(const nil)))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)
nm (form-sym-name name-sym)
cur (compile-ns ctx)]
(host-intern! ctx cur nm)
(def-node cur nm (analyze ctx (nth items 2) env)))
"let*" (let [bvec (vec (form-vec-items (nth items 1)))
r (analyze-bindings ctx bvec env)]
(let-node (first r) (analyze-seq ctx (drop 2 items) (second r))))
"loop*" (let [bvec (vec (form-vec-items (nth items 1)))
rname (gen-name "loop")
r (analyze-bindings ctx bvec env)
env** (with-recur (second r) rname)]
{:op :loop :recur-name rname :bindings (first r)
:body (analyze-seq ctx (drop 2 items) env**)})
"recur" (let [rt (:recur env)]
(when-not rt (uncompilable "recur outside loop/fn"))
{:op :recur :recur-name rt
:args (mapv #(analyze ctx % env) (rest items))})
"try" (analyze-try ctx items env)
"fn*" (analyze-fn ctx items env)
(uncompilable (str "special form " op))))
(defn- analyze-symbol [ctx form env]
(let [nm (form-sym-name form) ns (form-sym-ns form)]
(cond

40
src/jolt/backend.janet
View file

@ -107,12 +107,37 @@
(defn- direct-call? [fnode]
(case (fnode :op) :var true :local true :fn true :host true false))
# Hot primitives emitted as native Janet ops (host-specific optimization): a
# call to clojure.core/+ etc. becomes (+ …) rather than a var deref + variadic
# core fn. Matches numeric semantics; relaxes the non-number checks (a documented
# perf-mode divergence, same as the bootstrap's core-renames).
(def- native-ops
{"+" '+ "-" '- "*" '* "<" '< ">" '> "<=" '<= ">=" '>= "inc" '++ "dec" '--})
(defn- native-op
"If fnode is a clojure.core ref (or host ref) to a native-op primitive, return
the Janet op symbol, else nil. inc/dec are unary so only at arity 1."
[fnode nargs]
(def nm (case (fnode :op)
:var (when (= "clojure.core" (fnode :ns)) (fnode :name))
:host (fnode :name)
nil))
(def op (and nm (get native-ops nm)))
(cond
(nil? op) nil
(and (or (= op '++) (= op '--)) (not= nargs 1)) nil
op))
(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)))
(def nop (native-op (node :fn) (length args)))
(cond
nop (case nop
'++ ['+ (in args 0) 1]
'-- ['- (in args 0) 1]
(tuple nop ;args))
(direct-call? (node :fn)) (tuple (emit ctx (node :fn)) ;args)
(tuple jolt-call (emit ctx (node :fn)) ;args)))
(defn- emit-vector [ctx node]
(def items (map |(emit ctx $) (vview (node :items))))
@ -170,8 +195,11 @@
(set s (in parsed 1))
(def f (in parsed 0))
(when (not (nil? f))
(def c (protect (comp/compile-ast f ctx)))
(if (c 0) (comp/eval-compiled (c 1) ctx) (eval-form ctx @{} f))))
# Guard BOTH compile and the Janet-compile-of-emitted step: a form whose
# emitted Janet is invalid (e.g. a bad splice) falls back to interpreted
# definition rather than killing the whole load.
(def r (protect (comp/eval-compiled (comp/compile-ast f ctx) ctx)))
(unless (r 0) (eval-form ctx @{} f))))
(ctx-set-current-ns ctx saved)))
(defn- ensure-analyzer [ctx]

14
src/jolt/compiler.janet
View file

@ -421,9 +421,11 @@
"do" (let [all-statements (array/slice form 1)
n (length all-statements)
analyzed (map |(analyze-form $ bindings ctx) all-statements)]
{:op :do
:statements (array/slice analyzed 0 (- n 1))
:ret (in analyzed (- n 1))})
(if (= n 0)
{:op :const :val nil} # (do) -> nil
{:op :do
:statements (array/slice analyzed 0 (- n 1))
:ret (in analyzed (- n 1))}))
"if" {:op :if
:test (analyze-form (in form 1) bindings ctx)
:then (analyze-form (in form 2) bindings ctx)
@ -434,9 +436,11 @@
nm (if (struct? name-sym) (name-sym :name) (string name-sym))
# Create/find the var cell first so a recursive init body
# self-references the same cell.
cell (when ctx (ns-intern (ctx-find-ns ctx (ctx-current-ns ctx)) nm))]
cell (when ctx (ns-intern (ctx-find-ns ctx (ctx-current-ns ctx)) nm))
# (def x) with no init (declare) -> nil.
init-form (if (> (length form) 2) (in form 2) nil)]
{:op :def :name name-sym :var cell
:init (analyze-form (in form 2) bindings ctx)})
:init (analyze-form init-form bindings ctx)})
"fn*" (analyze-fn form bindings ctx)
"let*" (let [bind-vec (in form 1)
body-exprs (tuple/slice form 2)