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

multi-arity fn*, nil sentinel in resolve-sym, let pre-registration, meta/when-not/qualified-symbol? core bindings

Browse source 
evaluator: fn* multi-arity dispatch, nil-local-vs-absent sentinel, let* pre-registers bindings
core: core-meta, core-when-not, core-qualified-symbol?, *unchecked-math*, *clojure-version*
This commit is contained in:
Yogthos 2026-06-01 23:37:55 -04:00
parent b20536d1e3
commit e1317c0a7e
6 changed files with 175 additions and 78 deletions
Download patch file Download diff file Expand all files Collapse all files

20
src/jolt/core.janet
View file

@ -448,6 +448,14 @@
(defn core-complement [f]
(fn [& args] (not (apply f args))))
(defn core-qualified-symbol? [x]
"Returns true if x is a symbol with a namespace."
(and (struct? x) (= :symbol (x :jolt/type)) (not (nil? (x :ns)))))
(defn core-meta [x]
"Returns the metadata of x, or nil."
(if (struct? x) (get x :meta) nil))
(def core-comp
(fn [& fs]
(case (length fs)
@ -602,6 +610,13 @@
test
arr])
(defn core-when-not
"Macro: (when-not test & body) -> (when (not test) & body)"
[test & body]
(def not-form @[{:jolt/type :symbol :ns nil :name "not"} test])
@[{:jolt/type :symbol :ns nil :name "if"} not-form
@[{:jolt/type :symbol :ns nil :name "do"} ;body]])
(defn core-defn
"Macro: (defn name [args] body) -> (def name (fn* [args] body))"
[fn-name args-form & body]
@ -799,6 +814,7 @@
"swap!" core-swap!
"not" core-not
"when" core-when
"when-not" core-when-not
"defn" core-defn
"defn-" core-defn-
"derive" core-derive
@ -827,6 +843,8 @@
"definterface" core-definterface
"comment" core-comment
"prefer-method" core-prefer-method
"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}})
@ -834,7 +852,7 @@
(defn core-macro-names
"Set of core binding names that are macros."
[]
@{"when" 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 "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})
(def init-core!
(fn [& args]

104
src/jolt/evaluator.janet
View file

@ -102,8 +102,9 @@
(if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name))))
(let [target-ns (ctx-find-ns ctx ns) v (ns-find target-ns name)]
(if v (var-get v) (error (string "Unable to resolve symbol: " ns "/" name))))))
(let [local (get bindings name)]
(if (not (nil? local)) local
# Use :jolt/not-found sentinel to distinguish nil binding from absent binding
(let [local (get bindings name :jolt/not-found)]
(if (not= local :jolt/not-found) local
(let [current-ns (ctx-current-ns ctx) ns (ctx-find-ns ctx current-ns) v (ns-find ns name)]
(if v (var-get v)
# Check clojure.core as auto-referred fallback
@ -281,38 +282,75 @@
(ctx-set-current-ns ctx ns-name)
(ctx-find-ns ctx ns-name)
nil)
"fn*" (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
(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))
self)
"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
(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
(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))
self))
"let*" (let [bind-vec (in form 1)
body (tuple/slice form 2)]
(var new-bindings @{})
(table/setproto new-bindings bindings)
(var i 0)
(let [len (length bind-vec)]
(while (< i len)
(let [sym (bind-vec i)
val (eval-form ctx new-bindings (bind-vec (+ i 1)))]
(put new-bindings (sym :name) val)
(+= i 2))))
body (tuple/slice form 2)]
(var new-bindings @{})
(table/setproto new-bindings bindings)
(var i 0)
(let [len (length bind-vec)]
(while (< i len)
(let [sym (bind-vec i)]
# Pre-register with nil to prevent proto fallthrough to global scope
(put new-bindings (sym :name) nil)
(def val (eval-form ctx new-bindings (bind-vec (+ i 1))))
(put new-bindings (sym :name) val)
(+= i 2))))
(var result nil)
(each body-form body
(set result (eval-form ctx new-bindings body-form)))