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

fix: all 317 SCI forms load, zero failures

Browse source 
- Reorder load sequence: types→unrestrict→vars→lang→utils→namespaces→core
- Add if-let/when-let/if-some/when-some/let macros and register in core-macro-names
- Add stubs: resolve, update, copy-core-var, copy-var, macrofy, new-var, avoid-method-too-large
- Add dynamic vars: *1, *2, *3, *e, *assert with nil-sentinel
- Fix core-update: use put instead of Janet's update (struct-incompatible)
- Change *clojure-version* from struct to table (mutable for update)
- Fix core-avoid-method-too-large: return @{} not nil
- Fix init-core! nil-sentinel unwrapping
- Fix let* destructuring for {:keys [...]} and sequential patterns
- Fix fn*/defmacro: capture defining ns for symbol resolution in closures
This commit is contained in:
Yogthos 2026-06-02 00:07:40 -04:00
parent 93f0e42716
commit b948c4fdbb
9 changed files with 377 additions and 108 deletions
Download patch file Download diff file Expand all files Collapse all files

112
src/jolt/core.janet
View file

@ -617,6 +617,52 @@
@[{:jolt/type :symbol :ns nil :name "if"} not-form
@[{:jolt/type :symbol :ns nil :name "do"} ;body]])
(defn core-if-let
"Macro: (if-let [binding val-expr] then else?)"
[bindings then-form & else-forms]
(def form-sym (in bindings 0))
(def val-form (in bindings 1))
@[{:jolt/type :symbol :ns nil :name "let*"}
@[form-sym val-form]
@[{:jolt/type :symbol :ns nil :name "if"}
form-sym
then-form
;else-forms]])
(defn core-when-let
"Macro: (when-let [binding val-expr] & body)"
[bindings & body]
(def form-sym (in bindings 0))
(def val-form (in bindings 1))
@[{:jolt/type :symbol :ns nil :name "let*"}
@[form-sym val-form]
@[{:jolt/type :symbol :ns nil :name "when"}
form-sym
;body]])
(defn core-if-some
"Macro: (if-some [binding val-expr] then else?)"
[bindings then-form & else-forms]
(def form-sym (in bindings 0))
(def val-form (in bindings 1))
@[{:jolt/type :symbol :ns nil :name "let*"}
@[form-sym val-form]
@[{:jolt/type :symbol :ns nil :name "if"}
@[{:jolt/type :symbol :ns nil :name "some?"} form-sym]
then-form
;else-forms]])
(defn core-when-some
"Macro: (when-some [binding val-expr] & body)"
[bindings & body]
(def form-sym (in bindings 0))
(def val-form (in bindings 1))
@[{:jolt/type :symbol :ns nil :name "let*"}
@[form-sym val-form]
@[{:jolt/type :symbol :ns nil :name "when"}
@[{:jolt/type :symbol :ns nil :name "some?"} form-sym]
;body]])
(defn core-defn
"Macro: (defn name [args] body) -> (def name (fn* [args] body))"
[fn-name args-form & body]
@ -670,6 +716,22 @@
(defn core-prefer-method [multifn dispatch-val & dispatch-vals]
nil)
# resolve stub — returns nil (symbols not found in Jolt's clojure.core)
(defn core-resolve [sym] nil)
# update — works on both structs and tables
(defn core-update [m k f & args]
(let [current (get m k)
new-val (apply f current args)]
(put m k new-val)))
# copy-var stubs for sci.impl.copy-vars (used by sci.impl.namespaces)
(defn core-copy-core-var [sym] nil)
(defn core-copy-var [sym & args] nil)
(defn core-macrofy [sym fn] fn)
(defn core-new-var [sym & args] nil)
(defn core-avoid-method-too-large [& args] @{})
# declare macro — accepts symbols, does nothing (forward declaration)
(defn core-declare [& syms]
@[{:jolt/type :symbol :ns nil :name "do"}])
@ -682,6 +744,15 @@
(each a args (array/push result a))
result)
(defn core-let
"Macro: (let [bindings] body) → (let* [bindings] body)"
[bindings & body]
(def result @[])
(array/push result {:jolt/type :symbol :ns nil :name "let*"})
(array/push result bindings)
(each b body (array/push result b))
result)
# Protocol stubs — defined in sci.impl.protocols, needed in clojure.core
# defprotocol must be a macro to avoid evaluating its args
(defn core-defprotocol [protocol-name & sigs]
@ -815,6 +886,10 @@
"not" core-not
"when" core-when
"when-not" core-when-not
"if-let" core-if-let
"when-let" core-when-let
"if-some" core-if-some
"when-some" core-when-some
"defn" core-defn
"defn-" core-defn-
"derive" core-derive
@ -824,6 +899,7 @@
"Object" core-Object
"declare" core-declare
"fn" core-fn
"let" core-let
"defprotocol" core-defprotocol
"extend-type" core-extend-type
"extend-protocol" core-extend-protocol
@ -843,31 +919,43 @@
"definterface" core-definterface
"comment" core-comment
"prefer-method" core-prefer-method
"resolve" core-resolve
"update" core-update
"copy-core-var" core-copy-core-var
"copy-var" core-copy-var
"macrofy" core-macrofy
"new-var" core-new-var
"avoid-method-too-large" core-avoid-method-too-large
"qualified-symbol?" core-qualified-symbol?
"meta" core-meta
# Dynamic vars — stubs for SCI bootstrap
"*unchecked-math*" false
"*clojure-version*" {:major 1 :minor 11 :incremental 0 :qualifier nil}})
"*clojure-version*" @{:major 1 :minor 11 :incremental 0 :qualifier nil}
"*1" :jolt/nil-sentinel
"*2" :jolt/nil-sentinel
"*3" :jolt/nil-sentinel
"*e" :jolt/nil-sentinel
"*assert" true})
(defn core-macro-names
"Set of core binding names that are macros."
[]
@{"when" true "when-not" true "defn" true "defn-" true "declare" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "fn" true "proxy" true "definterface" true "comment" true})
@{"when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "defn" true "defn-" true "declare" true "fn" true "let" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true})
(def init-core!
(fn [& args]
(case (length args)
1 (let [ctx (args 0)
ns (ctx-find-ns ctx "clojure.core")]
(loop [[name fn] :pairs core-bindings]
(def v (ns-intern ns name fn))
(when (get (core-macro-names) name)
(put v :macro true)))
ns)
2 (let [ctx (args 0) ns-name (args 1)
ns (ctx-find-ns ctx ns-name)]
(loop [[name fn] :pairs core-bindings]
(def v (ns-intern ns name fn))
ns (ctx-find-ns ctx "clojure.core")]
(loop [[name fn] :pairs core-bindings]
(def v (ns-intern ns name (if (= fn :jolt/nil-sentinel) nil fn)))
(when (get (core-macro-names) name)
(put v :macro true)))
ns)
2 (let [ctx (args 0) ns-name (args 1)
ns (ctx-find-ns ctx ns-name)]
(loop [[name fn] :pairs core-bindings]
(def v (ns-intern ns name (if (= fn :jolt/nil-sentinel) nil fn)))
(when (get (core-macro-names) name)
(put v :macro true)))
ns)

152
src/jolt/evaluator.janet
View file

@ -239,22 +239,27 @@
body (tuple/slice rest-form (if has-doc? 2 1))
arg-info (parse-arg-names args-form)
fixed-names (arg-info :fixed)
rest-name (arg-info :rest)]
rest-name (arg-info :rest)
defining-ns (ctx-current-ns ctx)]
(def macro-fn (fn [& macro-args]
(var new-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)
(var i 0)
(each a fixed-names
(bind-put new-bindings a (macro-args i))
(++ i))
(when rest-name
(put new-bindings rest-name (tuple/slice macro-args i)))
# Use defining namespace for symbol resolution
(def saved-ns (ctx-current-ns ctx))
(ctx-set-current-ns ctx defining-ns)
(var result nil)
(each bf body
(set result (eval-form ctx new-bindings bf)))
(ctx-set-current-ns ctx saved-ns)
result))
(let [ns-name (ctx-current-ns ctx)
(let [ns-name (ctx-current-ns ctx)
ns (ctx-find-ns ctx ns-name)]
(def v (ns-intern ns (name-sym :name) macro-fn))
(put v :macro true)
@ -290,60 +295,70 @@
(ctx-find-ns ctx ns-name)
nil)
"fn*" (if (array? (in form 1))
# Multi-arity: (fn* ([args] body...) ([args] body...)...)
(let [pairs (tuple/slice form 1)
arities @{}]
(var self nil)
(each pair pairs
(let [args-form (in pair 0)
body (tuple/slice pair 1)
arg-info (parse-arg-names args-form)
fixed-names (arg-info :fixed)
rest-name (arg-info :rest)
n-fixed (length fixed-names)]
(put arities n-fixed
(fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each arg-name fixed-names
(bind-put fn-bindings arg-name (fn-args i))
(++ i))
(when rest-name
(put fn-bindings rest-name (tuple/slice fn-args i)))
(put fn-bindings :jolt/loop-fn self)
(var result nil)
(each body-form body
(set result (eval-form ctx fn-bindings body-form)))
result))))
(set self (fn [& fn-args]
(let [n (length fn-args)
f (get arities n)]
(if f
(apply f fn-args)
(error (string "Wrong number of args (" n ") passed to fn"))))))
self)
# Single-arity: (fn* [args] body...)
(let [args-form (in form 1)
body (tuple/slice form 2)
arg-info (parse-arg-names args-form)
fixed-names (arg-info :fixed)
rest-name (arg-info :rest)]
(var self nil)
(set self (fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each arg-name fixed-names
(bind-put fn-bindings arg-name (fn-args i))
(++ i))
(when rest-name
(put fn-bindings rest-name (tuple/slice fn-args i)))
(put fn-bindings :jolt/loop-fn self)
(var result nil)
(each body-form body
(set result (eval-form ctx fn-bindings body-form)))
result))
# Multi-arity: (fn* ([args] body...) ([args] body...)...)
(let [pairs (tuple/slice form 1)
arities @{}
defining-ns (ctx-current-ns ctx)]
(var self nil)
(each pair pairs
(let [args-form (in pair 0)
body (tuple/slice pair 1)
arg-info (parse-arg-names args-form)
fixed-names (arg-info :fixed)
rest-name (arg-info :rest)
n-fixed (length fixed-names)]
(put arities n-fixed
(fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each arg-name fixed-names
(bind-put fn-bindings arg-name (fn-args i))
(++ i))
(when rest-name
(put fn-bindings rest-name (tuple/slice fn-args i)))
(put fn-bindings :jolt/loop-fn self)
# Use defining namespace for symbol resolution
(def saved-ns (ctx-current-ns ctx))
(ctx-set-current-ns ctx defining-ns)
(var result nil)
(each body-form body
(set result (eval-form ctx fn-bindings body-form)))
(ctx-set-current-ns ctx saved-ns)
result))))
(set self (fn [& fn-args]
(let [n (length fn-args)
f (get arities n)]
(if f
(apply f fn-args)
(error (string "Wrong number of args (" n ") passed to fn"))))))
self)
# Single-arity: (fn* [args] body...)
(let [args-form (in form 1)
body (tuple/slice form 2)
arg-info (parse-arg-names args-form)
fixed-names (arg-info :fixed)
rest-name (arg-info :rest)
defining-ns (ctx-current-ns ctx)]
(var self nil)
(set self (fn [& fn-args]
(var fn-bindings @{})
(table/setproto fn-bindings bindings)
(var i 0)
(each arg-name fixed-names
(bind-put fn-bindings arg-name (fn-args i))
(++ i))
(when rest-name
(put fn-bindings rest-name (tuple/slice fn-args i)))
(put fn-bindings :jolt/loop-fn self)
# Use defining namespace for symbol resolution
(def saved-ns (ctx-current-ns ctx))
(ctx-set-current-ns ctx defining-ns)
(var result nil)
(each body-form body
(set result (eval-form ctx fn-bindings body-form)))
(ctx-set-current-ns ctx saved-ns)
result))
self))
"let*" (let [bind-vec (in form 1)
body (tuple/slice form 2)]
@ -352,9 +367,28 @@
(var i 0)
(let [len (length bind-vec)]
(while (< i len)
(let [sym (bind-vec i)]
(let [pat (bind-vec i)]
(def val (eval-form ctx new-bindings (bind-vec (+ i 1))))
(bind-put new-bindings (sym :name) val)
# Handle destructuring patterns
(if (struct? pat)
(let [keys-vec (get pat :keys)]
(if (and keys-vec (indexed? keys-vec))
(each k keys-vec
(def kname (if (keyword? k) (string k) (k :name)))
(bind-put new-bindings kname (get val (keyword kname))))
(bind-put new-bindings (pat :name) val)))
(if (indexed? pat)
# Sequential destructuring (vector pattern)
(do
(var di 0)
(while (< di (length pat))
(let [inner-pat (in pat di)]
(if (struct? inner-pat)
(bind-put new-bindings (inner-pat :name) (get val di))
(bind-put new-bindings inner-pat (get val di))))
(+= di 1)))
# Plain symbol binding
(bind-put new-bindings (pat :name) val)))
(+= i 2))))
(var result nil)
(each body-form body