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

Phase 1: Var/Namespace system — ns accessors, ns form extensions

Browse source 
- types.janet: all-ns, remove-ns, create-ns, the-ns, ns-interns, ns-aliases, ns-imports-fn
- core.janet: core-binding macro, core-push-thread-bindings, core-pop-thread-bindings
  wired into core-bindings and core-macro-names
- evaluator.janet:
  - ns accessor special forms: all-ns, the-ns, create-ns, remove-ns, ns-interns, ns-aliases, ns-imports, ns-resolve
  - ns form extended: :require/:refer, :use, :refer-clojure/:exclude, :import
  - eval-require extended: :refer support
- compiler-test.janet: Phase 1 tests (ns accessors + ns form extensions)
- pre-existing delimiter fix in core-binding macro brackets

All 317 tests pass, 0 failures.
This commit is contained in:
Yogthos 2026-06-02 17:20:46 -04:00
parent 3ac293c7a5
commit 496f169a2e
6 changed files with 195 additions and 248 deletions
Download patch file Download diff file Expand all files Collapse all files

30
src/jolt/core.janet
View file

@ -784,6 +784,31 @@
(array/push result sym)
result)
(defn core-push-thread-bindings [b] (push-thread-bindings b))
(defn core-pop-thread-bindings [] (pop-thread-bindings))
(defn core-binding
"Macro: (binding [var val ...] body...)"
[bindings & body]
(def frame-pairs @[])
(var i 0)
(let [n (length bindings)]
(while (< i n)
(array/push frame-pairs
[{:jolt/type :symbol :ns nil :name "var"} (in bindings i)])
(array/push frame-pairs (in bindings (+ i 1)))
(+= i 2)))
(def hm-form (tuple ;(array/insert frame-pairs 0
{:jolt/type :symbol :ns nil :name "hash-map"})))
@[{:jolt/type :symbol :ns nil :name "let"}
[{:jolt/type :symbol :ns nil :name "frame"} hm-form]
{:jolt/type :symbol :ns nil :name "push-thread-bindings"}
{:jolt/type :symbol :ns nil :name "frame"}
{:jolt/type :symbol :ns nil :name "try"}
[{:jolt/type :symbol :ns nil :name "do"} ;body]
[{:jolt/type :symbol :ns nil :name "finally"}
{:jolt/type :symbol :ns nil :name "pop-thread-bindings"}]])
(defn core-defn
"Macro: (defn name [args] body) or (defn name ([args] body)...)
-> (def name (fn* ...) )"
@ -1136,6 +1161,9 @@
"avoid-method-too-large" core-avoid-method-too-large
"qualified-symbol?" core-qualified-symbol?
"meta" core-meta
"binding" core-binding
"push-thread-bindings" core-push-thread-bindings
"pop-thread-bindings" core-pop-thread-bindings
# Dynamic vars — stubs for SCI bootstrap
"*unchecked-math*" false
"*clojure-version*" @{:major 1 :minor 11 :incremental 0 :qualifier nil}
@ -1148,7 +1176,7 @@
(defn core-macro-names
"Set of core binding names that are macros."
[]
@{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true})
@{"and" true "or" true "when" true "when-not" true "if-let" true "when-let" true "if-some" true "when-some" true "doto" true "defn" true "defn-" true "declare" true "fn" true "let" true "loop" true "defrecord" true "defprotocol" true "extend-type" true "extend-protocol" true "extend" true "reify" true "proxy" true "definterface" true "comment" true "binding" true})
(def init-core!
(fn [& args]

93
src/jolt/evaluator.janet
View file

@ -76,6 +76,7 @@
(let [ns-sym (in spec 0)
ns-name (sym-name-str ns-sym)]
(var alias nil)
(var refer-syms nil)
(var i 1)
(let [slen (length spec)]
(while (< i slen)
@ -85,11 +86,22 @@
(def alias-sym (in spec (+ i 1)))
(set alias (alias-sym :name))
(set i slen))
(++ i)))))
(if (or (= item :refer) (and (struct? item) (= :symbol (item :jolt/type)) (= "refer" (item :name))))
(do
(set refer-syms (in spec (+ i 1)))
(set i slen))
(++ i))))))
(ctx-find-ns ctx ns-name)
(when alias
(let [current-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(ns-import current-ns alias ns-name)))
(when refer-syms
(let [source-ns (ctx-find-ns ctx ns-name)
target-ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(each refer-sym refer-syms
(let [name (if (struct? refer-sym) (refer-sym :name) refer-sym)
v (ns-find source-ns name)]
(when v (ns-intern target-ns name (var-get v)))))))
nil))
(defn- bind-put
@ -283,26 +295,75 @@
clauses (tuple/slice form 2)]
(ctx-set-current-ns ctx ns-name)
(ctx-find-ns ctx ns-name)
(var result nil)
(var i 0)
(let [clen (length clauses)]
(while (< i clen)
(let [clause (in clauses i)]
(if (and (array? clause) (> (length clause) 0) (= :require (first clause)))
(let [specs (tuple/slice clause 1)
slen (length specs)]
(var j 0)
(while (< j slen)
(let [s (in specs j)]
(when s (eval-require ctx s)))
(++ j))
(set i (+ i 1)))
(do (set result clause) (++ i))))))
(var result nil)
(var i 0)
(let [clen (length clauses)]
(while (< i clen)
(let [clause (in clauses i)
head (if (and (array? clause) (> (length clause) 0)) (first clause) nil)]
(if (nil? head)
(do (set result clause) (++ i))
(match head
:require (let [specs (tuple/slice clause 1)
slen (length specs)]
(var j 0)
(while (< j slen)
(let [s (in specs j)]
(when s (eval-require ctx s)))
(++ j))
(set i (+ i 1)))
:use (let [specs (tuple/slice clause 1)
slen (length specs)]
(var j 0)
(while (< j slen)
(let [s (in specs j)
ns-sym (if (array? s) (in s 0) s)
ns-name (sym-name-str ns-sym)
source-ns (ctx-find-ns ctx ns-name)
target-ns (ctx-find-ns ctx ns-name)]
(loop [[sym v] :pairs (source-ns :mappings)]
(ns-intern target-ns sym (var-get v))))
(++ j))
(set i (+ i 1)))
:refer-clojure (let [spec (in clause 1)]
(when (and (array? spec) (= (first spec) :exclude))
(let [ns (ctx-find-ns ctx ns-name)]
(each sym (tuple/slice spec 1)
(ns-unmap ns (if (struct? sym) (sym :name) sym)))))
(set i (+ i 1)))
:import (let [specs (tuple/slice clause 1)
slen (length specs)]
(var j 0)
(while (< j slen)
(let [class-spec (in specs j)
class-name (if (struct? class-spec) (class-spec :name) (string class-spec))
last-dot (do
(var idx -1)
(var pos 0)
(while (< pos (length class-name))
(if (= (class-name pos) 46) (set idx pos))
(++ pos))
idx)
short-name (if (>= last-dot 0)
(string/slice class-name (+ last-dot 1))
class-name)]
(ns-import (ctx-find-ns ctx ns-name) short-name class-name))
(++ j))
(set i (+ i 1)))
(do (set result clause) (++ i)))))))
result)
"require" (let [spec (eval-form ctx bindings (in form 1))]
(if (and (tuple? spec) (> (length spec) 0))
(eval-require ctx spec)
(error "require expects a vector spec")))
"all-ns" (all-ns ctx)
"the-ns" (the-ns ctx)
"create-ns" (create-ns ctx (sym-name-str (in form 1)))
"remove-ns" (remove-ns ctx (sym-name-str (in form 1)))
"ns-interns" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :mappings))
"ns-aliases" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :aliases))
"ns-imports" (let [ns (ctx-find-ns ctx (ctx-current-ns ctx))] (ns :imports))
"ns-resolve" (ns-resolve (ctx-find-ns ctx (ctx-current-ns ctx)) (in form 1))
"in-ns" (let [ns-name (sym-name-str (in form 1))]
(ctx-set-current-ns ctx ns-name)
(ctx-find-ns ctx ns-name)

42
src/jolt/types.janet
View file

@ -277,3 +277,45 @@
"Set the current namespace symbol."
[ctx ns-sym]
(put (ctx :env) :current-ns ns-sym))
(defn all-ns
"Return a list of all namespaces in the context."
[ctx]
(let [namespaces (get (ctx :env) :namespaces)
result @[]]
(loop [[_ ns] :pairs namespaces]
(array/push result ns))
result))
(defn remove-ns
"Remove a namespace from the context by name string."
[ctx ns-name]
(put (get (ctx :env) :namespaces) ns-name nil) nil)
(defn create-ns
"Create a new namespace."
[ctx ns-name]
(ctx-find-ns ctx ns-name))
(defn the-ns
"Return the current namespace object."
[ctx]
(ctx-find-ns ctx (ctx-current-ns ctx)))
(defn ns-interns
"Return the map of all interned vars in the current namespace."
[ctx]
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(ns :mappings)))
(defn ns-aliases
"Return the alias map of the current namespace."
[ctx]
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(ns :aliases)))
(defn ns-imports-fn
"Return the import map of the current namespace."
[ctx]
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))]
(ns :imports)))