compiler: compile defmacro expanders (native-speed macro expansion)

A defmacro now compiles its expander to a native Janet fn — built as
(fn* args body...) and run through the self-hosted pipeline (its backtick body is
now compilable, prior commit) — instead of an interpreted closure. Macro
expansion happens at compile time with zero runtime cost, the proper Lisp model.

Wiring: evaluator exposes a macro-compile-hook the api sets to backend/
try-compile-fn; the defmacro handler uses the compiled expander when available,
falling back to the interpreted closure when the analyzer isn't built yet (early
tiers) or the body uses &env/&form (no such params on the compiled fn).

conformance 228/228 x3 (incl. REPL defmacro + gensym hygiene), full suite green.
This commit is contained in:
Yogthos 2026-06-07 09:41:51 -04:00
parent b438835cf6
commit 56a746bb73
3 changed files with 48 additions and 1 deletions

View file

@ -14,6 +14,15 @@
(import ./stdlib_embed :as stdlib-embed) (import ./stdlib_embed :as stdlib-embed)
(import ./host_iface :as host) (import ./host_iface :as host)
# A defmacro expander compiles to a native fn (built as (fn* args body...) and run
# through the self-hosted pipeline) so macro expansion is compiled, zero runtime
# cost — instead of an interpreted closure. Returns nil (interpreted fallback) when
# the analyzer isn't built yet or the body isn't compilable.
(set macro-compile-hook
(fn [ctx args-form body]
(backend/try-compile-fn ctx
(array/concat @[{:jolt/type :symbol :ns nil :name "fn*"} args-form] body))))
(defn normalize-pvecs (defn normalize-pvecs
"Deep-convert any sequential (pvec/tuple/array) to a Janet tuple. Test helper "Deep-convert any sequential (pvec/tuple/array) to a Janet tuple. Test helper
so Janet-level `=`/deep= can compare jolt collection results against Janet so Janet-level `=`/deep= can compare jolt collection results against Janet

View file

@ -341,3 +341,17 @@
(if (compiled 0) (if (compiled 0)
(eval (compiled 1) (comp/ctx-janet-env ctx)) (eval (compiled 1) (comp/ctx-janet-env ctx))
(eval-form ctx @{} form))) (eval-form ctx @{} form)))
(defn analyzer-built? [ctx]
(> (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)) 0))
(defn try-compile-fn
"Compile a fn* form to a native Janet fn via the self-hosted pipeline, or nil if
it can't be compiled (analyzer not yet built, or the body isn't compilable).
Used to compile macro expanders for native-speed expansion."
[ctx fn-form]
(when (analyzer-built? ctx)
(def compiled (protect (emit-ir ctx (analyze-form ctx fn-form))))
(when (compiled 0)
(def r (protect (eval (compiled 1) (comp/ctx-janet-env ctx))))
(when (r 0) (r 1)))))

View file

@ -34,6 +34,22 @@
(var eval-form nil) (var eval-form nil)
# Compile hook for macro expanders: set by the api to (fn [ctx args-form body] ->
# compiled-janet-fn | nil). When set and the body is compilable (no &env/&form,
# analyzer available), defmacro uses the compiled expander instead of the
# interpreted closure — macro expansion at native speed, zero runtime cost.
(var macro-compile-hook nil)
(defn- form-uses-sym? [form nm]
(cond
(and (struct? form) (= :symbol (form :jolt/type))) (= nm (form :name))
(or (array? form) (tuple? form))
(do (var found false) (each x form (when (form-uses-sym? x nm) (set found true) (break))) found)
(and (struct? form) (nil? (form :jolt/type)))
(do (var found false) (each k (keys form)
(when (or (form-uses-sym? k nm) (form-uses-sym? (get form k) nm)) (set found true) (break))) found)
false))
# A transient is a tagged mutable table @{:jolt/type :jolt/transient :kind ...}. # A transient is a tagged mutable table @{:jolt/type :jolt/transient :kind ...}.
(defn- jolt-transient? [x] (defn- jolt-transient? [x]
(and (table? x) (= :jolt/transient (get x :jolt/type)))) (and (table? x) (= :jolt/transient (get x :jolt/type))))
@ -737,7 +753,7 @@
fixed-pats (param-info :fixed) fixed-pats (param-info :fixed)
rest-pat (param-info :rest) rest-pat (param-info :rest)
defining-ns (ctx-current-ns ctx)] defining-ns (ctx-current-ns ctx)]
(def macro-fn (fn [& macro-args] (def interp-fn (fn [& macro-args]
(var new-bindings @{}) (var new-bindings @{})
(table/setproto new-bindings bindings) (table/setproto new-bindings bindings)
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe) (put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
@ -757,6 +773,14 @@
(set result (eval-form ctx new-bindings bf))) (set result (eval-form ctx new-bindings bf)))
(ctx-set-current-ns ctx saved-ns) (ctx-set-current-ns ctx saved-ns)
result)) result))
# Prefer a COMPILED expander (native-speed expansion, zero runtime
# cost). Skip when the body uses &env/&form (the compiled fn has no
# such params) — those fall back to the interpreted closure.
(def uses-env (or (form-uses-sym? body "&env") (form-uses-sym? body "&form")))
(def compiled-fn
(when (and macro-compile-hook (not uses-env))
(macro-compile-hook ctx args-form body)))
(def macro-fn (or compiled-fn interp-fn))
(let [ns-name (ctx-current-ns ctx) (let [ns-name (ctx-current-ns ctx)
ns (ctx-find-ns ctx ns-name)] ns (ctx-find-ns ctx ns-name)]
(def v (ns-intern ns (name-sym :name) macro-fn)) (def v (ns-intern ns (name-sym :name) macro-fn))