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

Phases 15-16: SCI bootstrap, Janet interop, eval, lazy-cat, CLJS ported tests

Browse source 
- SCI bootstrap complete: all 9 SCI source files load (317 forms, 0 failures)
- prefer-method/remove-method/remove-all-methods promoted to special forms
- eval special form (interpreter + compiler) with eval-test.janet
- lazy-cat macro with structural equality tests in lazy-test.janet
- Janet-native interop via . special form on tables/structs:
  field access (. obj :key), method calls (. obj method args...)
  fn* form compilation support, .- reader sugar
  interop-test.janet with 7 test sections (14 assertions)
- New core bindings: with-meta, var-dynamic?, load-string
- ^:dynamic def handler, core-str nil handling, core-meta for with-meta
- 7 new CLJS ported test files: cljs-port-6 through -10, cljs-core-test, cljs-collections-test
- test-sci-runtime.janet verifies SCI namespaces/types/Var/IBox/IVar
- 317/317 tests pass, 0 failing scripts, 440+ assertions across 31 test files
- README updated with Janet interop documentation
This commit is contained in:
Yogthos 2026-06-03 23:44:49 -04:00
parent 9ac8f26a70
commit 0e08f65016
42 changed files with 770 additions and 837 deletions
Download patch file Download diff file Expand all files Collapse all files

17
src/jolt/api.janet
View file

@ -60,7 +60,8 @@
(= head-name "deftype") (= head-name "defmulti") (= head-name "defmethod")
(= head-name "require") (= head-name "in-ns")
(= head-name "syntax-quote") (= head-name "set!")
(= head-name "var") (= head-name ".") (= head-name "new"))]
(= head-name "var") (= head-name ".") (= head-name "new")
(= head-name "eval"))]
(if stateful?
(eval-form ctx @{} form)
(compile-and-eval form ctx)))
@ -78,6 +79,20 @@
(let [form (parse-string s)]
(eval-form ctx bindings form)))
(defn load-string
"Evaluate all forms from a Clojure source string.
Uses parse-next to load every top-level form in sequence.
Returns the result of the last form evaluated."
[ctx s]
(var cur s)
(var result nil)
(while (> (length (string/trim cur)) 0)
(def [form rest] (parse-next cur))
(set cur rest)
(when (not (nil? form))
(set result (eval-form ctx @{} form))))
result)
(defn compile-string
"Compile a Clojure source string to Janet source.
Returns the Janet source string."

4
src/jolt/compiler.janet
View file

@ -106,8 +106,10 @@
(= name "if") (= name "def") (= name "defmacro") (= name "fn*")
(= name "let*") (= name "loop*") (= name "recur") (= name "throw")
(= name "try") (= name "set!") (= name "var") (= name ".")
(= name "eval")
(= name "new") (= name "deftype") (= name "instance?")
(= name "defmulti") (= name "defmethod") (= name "locking")))
(= name "defmulti") (= name "defmethod") (= name "locking")
(= name "prefer-method") (= name "remove-method") (= name "remove-all-methods")))
# ============================================================
# Macro resolution

89
src/jolt/core.janet
View file

@ -343,15 +343,17 @@
(defn core-take [n coll]
(var result @[])
(var i 0)
(while (and (< i n) (< i (length coll)))
(array/push result (coll i))
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(while (and (< i n) (< i (length c)))
(array/push result (c i))
(++ i))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
(if (tuple? c) (tuple/slice (tuple ;result)) result))
(defn core-drop [n coll]
(if (tuple? coll)
(tuple/slice coll (min n (length coll)))
(array/slice coll (min n (length coll)))))
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(if (tuple? c)
(tuple/slice c (min n (length c)))
(array/slice c (min n (length c)))))
(defn core-take-while [pred coll]
(var result @[])
@ -360,59 +362,67 @@
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
(defn core-drop-while [pred coll]
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(var start 0)
(while (and (< start (length coll)) (pred (coll start)))
(while (and (< start (length c)) (pred (c start)))
(++ start))
(if (tuple? coll)
(tuple/slice coll start)
(array/slice coll start)))
(if (tuple? c)
(tuple/slice c start)
(array/slice c start)))
(defn core-concat [& colls]
(var result @[])
(each c colls
(each x c (array/push result x)))
(def c-realized (if (lazy-seq? c) (realize-ls c) c))
(each x c-realized (array/push result x)))
result)
(defn core-reverse [coll]
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(var result @[])
(var i (dec (length coll)))
(var i (dec (length c)))
(while (>= i 0)
(array/push result (coll i))
(array/push result (c i))
(-- i))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
(if (tuple? c) (tuple/slice (tuple ;result)) result))
(defn core-nth
"Return the nth element of a sequential collection."
[coll idx &opt default]
(if (and (>= idx 0) (< idx (length coll)))
(in coll idx)
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(if (and (>= idx 0) (< idx (length c)))
(in c idx)
(if (nil? default)
(error (string "Index " idx " out of bounds, length: " (length coll)))
(error (string "Index " idx " out of bounds, length: " (length c)))
default)))
(defn core-sort [coll]
(let [arr (if (tuple? coll) (array/slice coll) coll)
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(let [arr (if (tuple? c) (array/slice c) c)
sorted (sort arr)]
(if (tuple? coll) (tuple/slice (tuple ;sorted)) sorted)))
(if (tuple? c) (tuple/slice (tuple ;sorted)) sorted)))
(defn core-sort-by [keyfn coll]
(let [arr (if (tuple? coll) (array/slice coll) coll)
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(let [arr (if (tuple? c) (array/slice c) c)
sorted (sort-by keyfn arr)]
(if (tuple? coll) (tuple/slice (tuple ;sorted)) sorted)))
(if (tuple? c) (tuple/slice (tuple ;sorted)) sorted)))
(defn core-distinct [coll]
(var seen @{})
(var result @[])
(each x coll
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(each x c
(if (nil? (seen x))
(do
(put seen x true)
(array/push result x))))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))
(if (tuple? c) (tuple/slice (tuple ;result)) result))
(defn core-group-by [f coll]
(var result @{})
(each x coll
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(each x c
(let [k (f x)]
(put result k (array/push (core-get result k @[]) x))))
result)
@ -511,7 +521,7 @@
(defn core-meta [x]
"Returns the metadata of x, or nil."
(if (var? x) (var-meta x)
(if (struct? x) (get x :meta) nil)))
(if (table? x) (or (get x :jolt/meta) (get x :meta)) nil)))
(defn core-every-pred [& preds]
(fn [x]
@ -582,6 +592,14 @@
@[{:jolt/type :symbol :ns nil :name "make-lazy-seq"}
@[{:jolt/type :symbol :ns nil :name "fn*"} [] ;body]])
(defn core-lazy-cat [& colls]
"Macro: (lazy-cat & colls) — concatenate lazy sequences, wrapping each coll in lazy-seq."
(def result @[])
(array/push result {:jolt/type :symbol :ns nil :name "concat"})
(each c colls
(array/push result @[{:jolt/type :symbol :ns nil :name "lazy-seq"} c]))
result)
(defn core-set [coll]
(apply core-hash-set (if (tuple? coll) (array/slice coll) coll)))
@ -597,7 +615,7 @@
(do
(var result @[])
(each x xs
(if (nil? x) nil # skip nil
(if (nil? x) (array/push result "nil")
(array/push result (if (string? x) x (string x)))))
(string/join result ""))))
@ -963,6 +981,20 @@
(do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers)))]
(put prefs dispatch-val-a dispatch-val-b) mm-var))
(defn core-with-meta [obj meta]
(var new-obj @{})
(each k (keys obj)
(put new-obj k (get obj k)))
# table/setproto requires a table, convert struct meta to table
(var meta-tab @{})
(each k (keys meta) (put meta-tab k (get meta k)))
(table/setproto new-obj meta-tab)
(put new-obj :jolt/meta meta)
new-obj)
(defn core-var-dynamic? [v]
(var-dynamic? v))
# Java interop stubs
(def core-Object (fn [] (struct ;[:jolt/type :jolt/java-object])))
@ -1234,6 +1266,7 @@
"keys" core-keys
"vals" core-vals
"select-keys" core-select-keys
"with-meta" core-with-meta
"zipmap" core-zipmap
"map" core-map
"filter" core-filter
@ -1274,6 +1307,7 @@
"set?" core-set?
"disj" core-disj
"lazy-seq" core-lazy-seq
"lazy-cat" core-lazy-cat
"make-lazy-seq" make-lazy-seq
"str" core-str
"name" core-name
@ -1380,6 +1414,7 @@
"var-get" core-var-get
"var-set" core-var-set
"var?" core-var?
"var-dynamic?" core-var-dynamic?
"alter-var-root" core-alter-var-root
"alter-meta!" core-alter-meta!
"reset-meta!" core-reset-meta!
@ -1399,7 +1434,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 "binding" true "lazy-seq" 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 "lazy-seq" true "lazy-cat" true})
(def init-core!
(fn [& args]

86
src/jolt/evaluator.janet
View file

@ -15,6 +15,7 @@
(= name "def") (= name "defmacro") (= name "fn*") (= name "let*") (= name "loop*")
(= name "recur") (= name "throw") (= name "try")
(= name "set!") (= name "var") (= name "locking")
(= name "eval")
(= name "instance?") (= name "defmulti") (= name "defmethod")
(= name "deftype") (= name "new") (= name ".")
(= name "var-get") (= name "var-set") (= name "var?")
@ -22,7 +23,8 @@
(= name "alter-meta!") (= name "reset-meta!")
(= name "disj") (= name "set?")
(= name "satisfies?")
(= name "protocol-dispatch") (= name "register-method") (= name "make-reified")))
(= name "protocol-dispatch") (= name "register-method") (= name "make-reified")
(= name "prefer-method") (= name "remove-method") (= name "remove-all-methods")))
(var eval-form nil)
@ -244,6 +246,7 @@
"syntax-quote" (syntax-quote* ctx bindings (in form 1))
"unquote" (error "Unquote not valid outside of syntax-quote")
"unquote-splicing" (error "Unquote-splicing not valid outside of syntax-quote")
"eval" (eval-form ctx bindings (eval-form ctx bindings (in form 1)))
"do" (do
(var result nil)
(var i 1)
@ -259,10 +262,16 @@
"def" (let [raw-name (in form 1)
name-sym (unwrap-meta-name raw-name)
val (eval-form ctx bindings (in form 2))
# Check for ^:dynamic metadata
dynamic? (and (array? raw-name) (> (length raw-name) 0)
(sym-name? (first raw-name) "with-meta")
(= :dynamic (last raw-name)))
ns-name (ctx-current-ns ctx)
ns (ctx-find-ns ctx ns-name)]
(ns-intern ns (name-sym :name) val)
(var-get (ns-intern ns (name-sym :name))))
(def v (ns-intern ns (name-sym :name) val))
(when dynamic?
(put v :dynamic true))
(var-get v))
"defmacro" (let [name-sym (in form 1)
rest-form (tuple/slice form 2)
# optional docstring
@ -458,15 +467,24 @@
(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)
(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))))
(if (and (struct? inner-pat) (= :symbol (inner-pat :jolt/type)) (= "&" (inner-pat :name)))
# & rest: next element gets (drop di val)
(do
(+= di 1)
(when (< di (length pat))
(let [rest-pat (in pat di)]
(bind-put new-bindings
(if (struct? rest-pat) (rest-pat :name) rest-pat)
(tuple/slice val 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)))
@ -761,6 +779,33 @@
result)]
(put methods dispatch-val impl)
mm-var)
"prefer-method" (let [mm-arg (in form 1)
mm-var (if (and (struct? mm-arg) (= :symbol (mm-arg :jolt/type)))
(resolve-var ctx bindings mm-arg)
(eval-form ctx bindings mm-arg))
# Auto-create multimethod if it doesn't exist
mm-var (if mm-var mm-var
(let [ns (ctx-find-ns ctx (ctx-current-ns ctx))
dummy-fn (fn [& args] nil)]
(def v (ns-intern ns (mm-arg :name) dummy-fn))
(put v :jolt/methods @{})
v))
dispatch-val-a (eval-form ctx bindings (in form 2))
dispatch-val-b (eval-form ctx bindings (in form 3))
prefs (or (get mm-var :jolt/prefers)
(do (put mm-var :jolt/prefers @{}) (mm-var :jolt/prefers)))]
(put prefs dispatch-val-a dispatch-val-b)
mm-var)
"remove-method" (let [mm-var (eval-form ctx bindings (in form 1))
dispatch-val (eval-form ctx bindings (in form 2))]
(if mm-var
(let [methods (get mm-var :jolt/methods)]
(put methods dispatch-val nil)))
mm-var)
"remove-all-methods" (let [mm-var (eval-form ctx bindings (in form 1))]
(if mm-var
(put mm-var :jolt/methods @{}))
mm-var)
"deftype" (let [raw-name (in form 1)
type-name (unwrap-meta-name raw-name)
fields-vec (in form 2)
@ -792,9 +837,14 @@
ctor (eval-form ctx bindings type-sym)]
(apply ctor args))
"." (let [target (eval-form ctx bindings (in form 1))
member-sym (in form 2)
member-name (member-sym :name)
field-name (if (and (> (length member-name) 0) (= "-" (string/slice member-name 0 1)))
member-raw (in form 2)
# Resolve member name: symbols have :name, keywords use string, strings as-is
member-name (if (and (struct? member-raw) (= :symbol (member-raw :jolt/type)))
(member-raw :name)
(if (keyword? member-raw)
(string member-raw)
member-raw))
field-name (if (and (string? member-name) (> (length member-name) 0) (= "-" (string/slice member-name 0 1)))
(string/slice member-name 1)
member-name)]
(if (> (length form) 3)
@ -803,8 +853,20 @@
(if (target :jolt/deftype)
(let [method-key (keyword field-name)]
(apply (get target method-key) target ;args))
(error (string "Cannot call method " field-name " on non-deftype"))))
# field access: (. obj field)
# Janet-native interop: try field lookup + call
(if (or (table? target) (struct? target))
(let [method (get target (keyword field-name))]
(if (or (function? method) (cfunction? method))
(method target ;args)
# If stored as fn* form (array), compile to function then call
(if (array? method)
(let [method-fn (eval-form ctx bindings method)]
(if (or (function? method-fn) (cfunction? method-fn))
(method-fn target ;args)
(error (string "Cannot call non-function " field-name " on " (type target)))))
(error (string "Cannot call non-function " field-name " on " (type target))))))
(error (string "Cannot call method " field-name " on " (type target))))))
# field access: (. obj field) — works on tables, structs, and deftypes
(get target (keyword field-name))))
# default: function application — check for macros
(if (and (struct? first-form) (= :symbol (first-form :jolt/type)))

18
src/jolt/main.janet
View file

@ -32,6 +32,22 @@
(++ i)))
(push-str buf "]"))
# LazySeq — realize and print as a list
(and (table? v) (= :jolt/lazy-seq (v :jolt/type)))
(do
(def val (if (get v :realized) (v :val) (let [vf ((v :fn))] (put v :realized true) (put v :val vf) vf)))
(if (nil? val)
(push-str buf "()")
(do
(push-str buf "(")
(var i 0)
(let [n (length val)]
(while (< i n)
(write-value (in val i) buf)
(when (< (+ i 1) n) (push-str buf " "))
(++ i)))
(push-str buf ")"))))
(array? v)
(do
(push-str buf "(")
@ -106,7 +122,7 @@
(push-str buf (string "#'" (ctx-current-ns ctx) "/" ((var-name v) :name)))
(or (tuple? v) (array? v) (struct? v) (table? v))
(write-collection v buf)
(push-str buf (string v)))))
true (push-str buf (string v)))))
(defn print-value [v]
(def buf @"")

2
src/jolt/phm.janet
View file

@ -122,7 +122,7 @@
[x]
(and (table? x) (= :jolt/lazy-seq (x :jolt/type))))
(defn- realize-ls
(defn realize-ls
"Force a LazySeq. Returns the realized value, caching it."
[ls]
(if (get ls :realized)