From 3afd1c61422fba61e674cc1e10b5b91c63b80204 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 6 Jun 2026 10:25:05 -0400 Subject: [PATCH] self-host: analyzer compiles to fast bytecode (fib(30) 0.52s) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- jolt-core/jolt/analyzer.clj | 119 ++++++++++++++++++------------------ src/jolt/backend.janet | 40 ++++++++++-- src/jolt/compiler.janet | 14 +++-- 3 files changed, 104 insertions(+), 69 deletions(-) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 3e305f7..529be58 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -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 diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index de49c29..a798269 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -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] diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index d13536a..5e02452 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -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)