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

feat: structural-sharing persistent vectors (immutable build) + mutable toggle

Browse source 
Round 2 of the persistent-collections work.

Add a real 32-way branching-trie persistent vector (src/jolt/pv.janet) with a
tail buffer: O(log32 n) conj/assoc/nth/pop, with unchanged subtrees shared by
identity. Vector literals and vec/vector/conj/assoc/subvec/etc. now produce and
maintain these in the default (immutable) build, replacing the old tuple-based
vectors. Every core seq op, the destructurer, IFn application, the printers, =,
and the evaluator's literal/splice paths were taught to handle the pvec type.

Define several Clojure seq fns that were silently leaking to Janet builtins
(some, keep, interleave, flatten, mapcat, interpose) and broke once vectors
became tables; normalize collections through realize-for-iteration everywhere.

Build-time JOLT_MUTABLE flag now selects fast Janet-native mutable collections:
in that mode vectors are arrays (conj appends in place, vector? true, print []),
sharing one representation with lists. Default build is immutable.

Tests: conformance 206/206, features 71/71, jank 119 (baseline). Test helpers
normalized so Janet-level = compares against tuple literals regardless of repr.
The 2 test-load-sci failures (bit-clear/get-method) pre-date this work.
This commit is contained in:
Yogthos 2026-06-04 18:56:55 -04:00
parent 1ca93d61c6
commit 1eb2843365
44 changed files with 525 additions and 170 deletions
Download patch file Download diff file Expand all files Collapse all files

44
src/jolt/api.janet
View file

@ -2,34 +2,25 @@
# High-level interface for the Clojure-on-Janet interpreter.
(use ./types)
(use ./pv)
(use ./reader)
(use ./evaluator)
(use ./core)
(use ./compiler)
(use ./loader)
(defn- load-persistent-structures
"Load immutable persistent data structures and swap clojure.core bindings."
[ctx]
(def saved-ns (ctx-current-ns ctx))
(def source (slurp "src/jolt/clojure/lang/persistent_vector.clj"))
(var cur source)
(while (> (length (string/trim cur)) 0)
(def [form rest] (parse-next cur))
(set cur rest)
(when (not (nil? form))
(eval-form ctx @{} form)))
# Vectors are represented as Janet tuples throughout core; bind vec/vector/
# vector? to the tuple-based implementations so literals (`[...]`) and the
# constructors share one representation. The PersistentVector namespace stays
# loaded for code that wants it explicitly via jolt.lang.persistent-vector.
(let [core-ns (ctx-find-ns ctx "clojure.core")]
(ns-intern core-ns "vec" core-vec)
(ns-intern core-ns "vector" core-vector)
(ns-intern core-ns "vector?" core-vector?))
# Restore the namespace: loading the PV file above left current-ns set to
# jolt.lang.persistent-vector, which would shadow clojure.core bindings.
(ctx-set-current-ns ctx saved-ns))
(defn normalize-pvecs
"Deep-convert any sequential (pvec/tuple/array) to a Janet tuple. Test helper
so Janet-level `=`/deep= can compare jolt collection results against Janet
tuple literals regardless of representation — mirroring Clojure, where vectors
and lists with the same elements are equal."
[x]
(cond
(pvec? x) (tuple ;(map normalize-pvecs (pv->array x)))
(tuple? x) (tuple ;(map normalize-pvecs x))
(array? x) (tuple ;(map normalize-pvecs x))
x))
(defn init
"Create a new Jolt evaluation context.
@ -39,12 +30,11 @@
:compile? — enable compilation of Clojure forms to Janet"
[&opt opts]
(default opts {})
(let [ctx (make-ctx opts)
mutable? (get opts :mutable?)]
(let [ctx (make-ctx opts)]
# Collection representation (persistent vs mutable) is selected at BUILD time
# via JOLT_MUTABLE (see config.janet); init-core! registers vec/vector/conj/
# etc. that produce the mode-appropriate values, so nothing extra to load.
(init-core! ctx)
(if mutable?
nil
(load-persistent-structures ctx))
ctx))
(defn eval-string

352
src/jolt/core.janet
View file

@ -5,6 +5,62 @@
(use ./phm)
(use ./regex)
(use ./config)
(use ./pv)
# ------------------------------------------------------------
# Vector representation helpers
#
# In immutable mode a vector value is a structural-sharing persistent vector
# (pvec); in mutable mode it is a plain Janet array. Janet tuples may also still
# appear (e.g. literals that have not been routed through make-vec), so the read
# helpers below accept tuple, pvec and (mutable mode) array uniformly.
# ------------------------------------------------------------
(defn jvec?
"True when x is a vector VALUE. In immutable mode that is a persistent vector
or tuple; in mutable mode vectors are plain arrays (so vectors and lists share
one fast representation — `vector?` is true for both)."
[x]
(if mutable?
(or (array? x) (tuple? x))
(or (tuple? x) (pvec? x))))
(defn vcount [x] (if (pvec? x) (pv-count x) (length x)))
(defn vnth [x i] (if (pvec? x) (pv-nth x i) (in x i)))
(defn vview
"An indexed (tuple/array) view of a vector value, for iteration/slicing."
[x]
(if (pvec? x) (pv->array x) x))
(defn make-vec
"Build a vector value from a Janet array/tuple of elements, honoring the
build-time collection mode."
[xs]
(if mutable? (array ;xs) (pv-from-indexed xs)))
(defn realize-for-iteration [c]
"Normalize a seqable to a Janet array/tuple for iteration: pvec -> array,
set -> seq, lazy-seq -> realized array; others pass through. Warning: will
loop on infinite lazy-seqs. Terminates on the empty cell, not on nil."
(cond
(pvec? c) (pv->array c)
(set? c) (phs-seq c)
(lazy-seq? c)
(do
(var items @[])
(var cur c)
(var go true)
(while go
(let [cell (realize-ls cur)]
(if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))
(set go false)
(do
(array/push items (in cell 0))
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (make-lazy-seq rt))))))))
items)
c))
# ============================================================
# Predicates
@ -22,10 +78,10 @@
(defn core-fn? [x] (or (function? x) (cfunction? x)))
(defn core-keyword? [x] (keyword? x))
(defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type))))
(defn core-vector? [x] (tuple? x))
(defn core-vector? [x] (jvec? x))
(defn core-map? [x] (or (phm? x) (struct? x) (if (and (table? x) (get x :jolt/deftype)) true false)))
(defn core-seq? [x] (or (array? x) (tuple? x)))
(defn core-coll? [x] (or (array? x) (tuple? x) (struct? x) (phm? x) (set? x) (lazy-seq? x)))
(defn core-seq? [x] (or (array? x) (tuple? x) (pvec? x)))
(defn core-coll? [x] (or (array? x) (tuple? x) (pvec? x) (struct? x) (phm? x) (set? x) (lazy-seq? x)))
(defn core-true? [x] (= true x))
(defn core-false? [x] (= false x))
@ -45,12 +101,14 @@
(if (nil? coll) true
(if (set? coll) (= 0 (coll :cnt))
(if (phm? coll) (= 0 (coll :cnt))
(if (struct? coll) (= 0 (length (keys coll)))
(= 0 (length coll)))))))
(if (pvec? coll) (= 0 (pv-count coll))
(if (lazy-seq? coll) (nil? (ls-first coll))
(if (struct? coll) (= 0 (length (keys coll)))
(= 0 (length coll)))))))))
(defn core-every? [pred coll]
(var result true)
(each x (if (set? coll) (phs-seq coll) coll)
(each x (realize-for-iteration coll)
(if (not (pred x)) (do (set result false) (break))))
result)
@ -96,32 +154,13 @@
# Comparison
# ============================================================
(defn realize-for-iteration [c]
"If c is a lazy-seq, traverse and return all its elements as an array.
Otherwise return c as-is. Warning: will loop on infinite lazy-seqs.
Correctly handles nil elements (terminates on the empty cell, not on nil)."
(if (lazy-seq? c)
(do
(var items @[])
(var cur c)
(var go true)
(while go
(let [cell (realize-ls cur)]
(if (or (nil? cell) (= :jolt/pending cell) (= 0 (length cell)))
(set go false)
(do
(array/push items (in cell 0))
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (make-lazy-seq rt))))))))
items)
c))
(defn- eq-seqable
"If x is a Clojure sequential (vector/list/lazy-seq), return its elements as
an array; otherwise nil. Lets = compare across tuple/array/lazy-seq."
[x]
(cond
(lazy-seq? x) (realize-for-iteration x)
(pvec? x) (pv->array x)
(tuple? x) x
(array? x) x
nil))
@ -192,17 +231,22 @@
# ============================================================
(defn core-conj [coll & xs]
(if (pvec? coll)
(do (var result coll) (each x xs (set result (pv-conj result x))) result)
(if (tuple? coll)
(tuple/slice (tuple ;(array/concat (array/slice coll) xs)))
(if (array? coll)
(do
# lists prepend; copy first unless built in mutable mode
(var result (if mutable? coll (array/slice coll)))
(var i 0)
(while (< i (length xs))
(set result (array/insert result 0 (xs i)))
(++ i))
result)
(if mutable?
# mutable mode: arrays are vectors — append in place
(do (each x xs (array/push coll x)) coll)
# immutable mode: arrays are lists — prepend onto a copy
(do
(var result (array/slice coll))
(var i 0)
(while (< i (length xs))
(set result (array/insert result 0 (xs i)))
(++ i))
result))
(if (set? coll)
(apply phs-conj coll xs)
(if (phm? coll)
@ -211,7 +255,7 @@
(var i 0)
(while (< i (length xs))
(let [pair (xs i)]
(set result (phm-assoc result (pair 0) (pair 1))))
(set result (phm-assoc result (vnth pair 0) (vnth pair 1))))
(++ i))
result)
(do
@ -219,14 +263,16 @@
(var i 0)
(while (< i (length xs))
(let [pair (xs i)]
(set result (merge result {(pair 0) (pair 1)})))
(set result (merge result {(vnth pair 0) (vnth pair 1)})))
(++ i))
result))))))
result)))))))
(defn core-assoc [m & kvs]
(cond
(phm? m)
(do (var result m) (var i 0) (while (< i (length kvs)) (set result (phm-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
(pvec? m)
(do (var result m) (var i 0) (while (< i (length kvs)) (set result (pv-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
# vector: assoc by integer index (appending at count is allowed); stays a vector
(or (tuple? m) (array? m))
(do (var result (array/slice m)) (var i 0)
@ -250,12 +296,14 @@
(if (nil? m) default
(if (set? m) (phs-get m k default)
(if (phm? m) (phm-get m k default)
(if (pvec? m)
(if (and (number? k) (>= k 0) (< k (pv-count m))) (pv-nth m k) default)
(if (or (struct? m) (table? m))
(let [v (m k)]
(if (nil? v) default v))
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
(in m k)
default))))))
default)))))))
# Runtime invoke dispatch for COMPILED code (interpreter uses evaluator's
# jolt-invoke). Handles real functions plus Clojure IFn collections.
@ -266,6 +314,11 @@
(and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1))
(phm? f) (phm-get f (get args 0) (get args 1))
(set? f) (if (phs-contains? f (get args 0)) (get args 0) (get args 1))
(pvec? f)
(let [k (get args 0)]
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (pv-count f)))
(pv-nth f k)
(error (string "Index " k " out of bounds for vector of length " (pv-count f)))))
(or (tuple? f) (array? f))
(let [k (get args 0)]
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f)))
@ -276,8 +329,22 @@
(if (= v :jolt/not-found) (get args 1) v))
(error (string "Cannot call " (type f) " as a function"))))
(defn core-apply
"(apply f a b ... coll) — call f with the leading args plus the elements of
the final collection spliced in. Materializes pvec/lazy-seq/set tails."
[f & args]
(let [n (length args)]
(if (= n 0)
(jolt-call f)
(let [fixed (array/slice args 0 (- n 1))
t (in args (- n 1))
tail (cond (set? t) (phs-seq t) (phm? t) (tuple ;(phm-entries t))
(realize-for-iteration t))]
(jolt-call f ;fixed ;tail)))))
(defn core-get-in [m ks &opt default]
(default default nil)
(def ks (vview ks))
(var current m)
(var i 0)
(while (< i (length ks))
@ -289,11 +356,12 @@
(defn core-contains? [coll key]
(if (set? coll) (phs-contains? coll key)
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false))
(if (pvec? coll) (and (number? key) (>= key 0) (< key (pv-count coll)))
(if (struct? coll) (not (nil? (coll key)))
(if (table? coll) (not (nil? (coll key)))
(if (or (tuple? coll) (array? coll))
(and (number? key) (>= key 0) (< key (length coll)))
false))))))
false)))))))
# Sorted collections — minimal: backed by a struct (map) / sorted array (set),
# ordered by key/element on read. Defined early so seq/count/get can dispatch.
@ -316,6 +384,7 @@
(core-sorted-map? coll) (length (keys (coll :map)))
(core-sorted-set? coll) (length (coll :items))
(lazy-seq? coll) (ls-count coll)
(pvec? coll) (pv-count coll)
(set? coll) (coll :cnt)
(phm? coll) (coll :cnt)
(and (table? coll) (get coll :jolt/deftype)) (- (length (keys coll)) 1)
@ -326,6 +395,7 @@
(core-sorted-map? coll) (let [e (sorted-map-entries coll)] (if (empty? e) nil (in e 0)))
(core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (in i 0)))
(lazy-seq? coll) (ls-first coll)
(pvec? coll) (if (= 0 (pv-count coll)) nil (pv-nth coll 0))
(or (nil? coll) (= 0 (length coll))) nil
(string? coll) (make-char (in coll 0))
(in coll 0)))
@ -333,6 +403,7 @@
(defn core-rest [coll]
(cond
(lazy-seq? coll) (ls-rest coll)
(pvec? coll) (let [a (pv->array coll)] (if (<= (length a) 1) @[] (array/slice a 1)))
(or (nil? coll) (= 0 (length coll))) @[]
(string? coll) (tuple ;(map make-char (string/bytes (string/slice coll 1))))
(tuple? coll) (tuple/slice coll 1)
@ -352,6 +423,7 @@
(core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (tuple ;i)))
(or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) nil
(lazy-seq? coll) (ls-seq coll)
(pvec? coll) (if (= 0 (pv-count coll)) nil (tuple ;(pv->array coll)))
(set? coll) (phs-seq coll)
(phm? coll) (tuple ;(phm-entries coll))
(tuple? coll) (tuple/slice coll)
@ -361,19 +433,23 @@
(defn core-vec [coll]
(let [coll (realize-for-iteration coll)]
(if (tuple? coll) coll
(if (array? coll) (tuple ;coll)
(if (struct? coll) (tuple ;(map |(in (kvs coll) (+ (* $ 2) 1)) (range (/ (length (kvs coll)) 2))))
(if (string? coll) (tuple ;(map |(string/from-bytes $) (string/bytes coll)))
(tuple)))))))
(cond
(array? coll) (make-vec coll)
(tuple? coll) (make-vec coll)
(struct? coll) (make-vec (map |(in (kvs coll) (+ (* $ 2) 1)) (range (/ (length (kvs coll)) 2))))
(string? coll) (make-vec (map |(string/from-bytes $) (string/bytes coll)))
(make-vec @[]))))
(defn- into-conj [to items]
(cond
(or (phm? to) (struct? to) (and (table? to) (get to :jolt/deftype)))
(do (var result to)
(each item items (set result (core-assoc result (in item 0) (in item 1))))
(each item items (set result (core-assoc result (vnth item 0) (vnth item 1))))
result)
(array? to) (do (var result (array/slice to)) (each x items (array/insert result 0 x)) result)
(pvec? to) (do (var result to) (each x items (set result (pv-conj result x))) result)
(array? to) (if mutable?
(do (each x items (array/push to x)) to) # vector: append
(do (var result (array/slice to)) (each x items (array/insert result 0 x)) result)) # list: prepend
(tuple? to) (tuple/slice (tuple ;(array/concat (array/slice to) (array/slice items))))
to))
@ -404,12 +480,13 @@
(if (struct? m) (table/to-struct result) result))
(defn core-zipmap [ks vs]
(var result @{})
(var i 0)
(while (and (< i (length ks)) (< i (length vs)))
(put result (ks i) (vs i))
(++ i))
(table/to-struct result))
(let [ks (realize-for-iteration ks) vs (realize-for-iteration vs)]
(var result @{})
(var i 0)
(while (and (< i (length ks)) (< i (length vs)))
(put result (in ks i) (in vs i))
(++ i))
(table/to-struct result)))
# ============================================================
# Transducers
@ -516,9 +593,9 @@
@[(f (core-first c)) (mstep (core-rest c))])))
(make-lazy-seq (mstep coll)))
# Concrete collection: eager (preserves tuple/array representation).
(let [c (if (set? coll) (phs-seq coll) coll)
(let [c (if (set? coll) (phs-seq coll) (realize-for-iteration coll))
result (do (var res @[]) (each x c (array/push res (f x))) res)]
(if (tuple? c) (tuple/slice (tuple ;result)) result))))
(if (jvec? coll) (make-vec result) result))))
# Multi-collection: lazy-seq with per-element independent state
(let [init-cs (array/new-filled (length colls) nil)
init-idxs (array/new-filled (length colls) 0)
@ -529,7 +606,8 @@
(let [c (in colls i)]
(if (lazy-seq? c)
(put init-cs i c)
(do (put init-cs i nil) (put init-reals i c))))
(do (put init-cs i nil)
(put init-reals i (if (set? c) (phs-seq c) (realize-for-iteration c))))))
(++ i))
nil)]
(defn step [cs idxs reals]
@ -582,9 +660,9 @@
(make-lazy-seq (fstep coll)))
(do
(var result @[])
(each x (if (set? coll) (phs-seq coll) coll)
(each x (if (set? coll) (phs-seq coll) (realize-for-iteration coll))
(if (pred x) (array/push result x)))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))))))
(if (jvec? coll) (make-vec result) result))))))
(defn core-remove [pred & rest]
(if (= 0 (length rest)) (td-remove pred)
@ -626,13 +704,13 @@
(set cur (ls-rest cur))
(++ i))
result)
(do
(let [c (realize-for-iteration coll)]
(var result @[])
(var i 0)
(while (and (< i n) (< i (length coll)))
(array/push result (coll i))
(while (and (< i n) (< i (length c)))
(array/push result (in c i))
(++ i))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))))))
(if (jvec? coll) (make-vec result) result))))))
(defn core-drop [n & rest]
(if (= 0 (length rest)) (td-drop n)
@ -645,10 +723,9 @@
(set cur (ls-rest cur))
(++ i))
(if (nil? (ls-first cur)) nil cur))
(do
(if (tuple? coll)
(tuple/slice coll (min n (length coll)))
(array/slice coll (min n (length coll)))))))))
(let [c (realize-for-iteration coll)
dropped (array/slice c (min n (length c)))]
(if (jvec? coll) (make-vec dropped) dropped))))))
(defn core-take-while [pred & rest]
(if (= 0 (length rest)) (td-take-while pred)
@ -663,13 +740,13 @@
result)
(do
(var result @[])
(each x coll (if (pred x) (array/push result x) (break)))
(if (tuple? coll) (tuple/slice (tuple ;result)) result))))))
(each x (realize-for-iteration coll) (if (pred x) (array/push result x) (break)))
(if (jvec? coll) (make-vec result) result))))))
(defn core-drop-while [pred & rest]
(if (= 0 (length rest)) (td-drop-while pred)
(let [coll (in rest 0)
c (if (lazy-seq? coll) (realize-ls coll) coll)]
c (realize-for-iteration coll)]
(var start 0)
(while (and (< start (length c)) (pred (c start)))
(++ start))
@ -682,6 +759,7 @@
If the value is a function, call it and use the result.
If the result is already a cell (array of [val, function]), return it directly."
(if (nil? c) nil
(if (pvec? c) (coll->cells (pv->array c))
(if (function? c)
(let [r (c)]
(if (and (indexed? r) (= 2 (length r)) (function? (in r 1)))
@ -699,7 +777,7 @@
(if (tuple? c) (tuple/slice c 1) (array/slice c 1))
nil)]
@[f (fn [] (coll->cells rest))])))
nil)))))
nil))))))
(defn core-concat [& colls]
"Truly lazy concatenation. `step` returns a 0-arg thunk that is only forced
@ -724,6 +802,31 @@
(array/insert remaining 0 rest-fn)))]))))))
(make-lazy-seq (step (if (tuple? colls) (array/slice colls) colls))))
(defn core-mapcat
"(mapcat f & colls) — map then concat. (mapcat f) returns a transducer."
[f & colls]
(if (= 0 (length colls))
# transducer: map f over each input, then splice (cat) the result
(fn [rf]
(fn [& a]
(case (length a)
0 (rf)
1 (rf (a 0))
(do (var acc (a 0))
(each x (realize-for-iteration (f (a 1)))
(set acc (rf acc x)))
acc))))
# map, then concat; a non-seqable result counts as a single element (this
# leniency is what jolt's `for` expansion relies on for :let on the last
# binding, whose body yields a scalar rather than a seq).
(let [mapped (realize-for-iteration (core-apply core-map f colls))
seqs (map (fn [item]
(if (or (tuple? item) (array? item) (pvec? item)
(lazy-seq? item) (set? item))
item (tuple item)))
mapped)]
(core-apply core-concat seqs))))
(defn core-reverse [coll]
(if (nil? coll) @[]
(if (lazy-seq? coll)
@ -739,17 +842,21 @@
(array/push reversed (in result i))
(-- i))
reversed)
(do
(let [c (realize-for-iteration coll)]
(var result @[])
(var i (dec (length coll)))
(var i (dec (length c)))
(while (>= i 0)
(array/push result (coll i))
(array/push result (in c i))
(-- i))
(if (tuple? coll) (tuple/slice (tuple ;result)) result)))))
result))))
(defn core-nth
"Return the nth element of a sequential collection."
[coll idx &opt default]
(if (pvec? coll)
(if (and (>= idx 0) (< idx (pv-count coll)))
(pv-nth coll idx)
(if (nil? default) (error (string "Index " idx " out of bounds, length: " (pv-count coll))) default))
(if (lazy-seq? coll)
(do
(var cur coll)
@ -762,12 +869,12 @@
(error (string "Index " idx " out of bounds"))
default)))
(do
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(var c (realize-for-iteration coll))
(if (and (>= idx 0) (< idx (length c)))
(if (string? c) (make-char (in c idx)) (in c idx))
(if (nil? default)
(error (string "Index " idx " out of bounds, length: " (length c)))
default)))))
default))))))
(defn core-sort
"(sort coll) or (sort comparator coll). Comparator may return a boolean or a
@ -785,7 +892,7 @@
(defn core-sort-by [keyfn coll]
(if (nil? coll) (break @[]))
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(var c (realize-for-iteration coll))
(let [arr (if (tuple? c) (array/slice c) c)
sorted (sort-by keyfn arr)]
(if (tuple? c) (tuple/slice (tuple ;sorted)) sorted)))
@ -806,14 +913,14 @@
(do
(var seen @{})
(var result @[])
(each x coll
(each x (realize-for-iteration coll)
(if (nil? (seen x))
(do (put seen x true) (array/push result x))))
(if (tuple? coll) (tuple/slice (tuple ;result)) result)))))
(if (jvec? coll) (make-vec result) result)))))
(defn core-group-by [f coll]
(var result @{})
(var c (if (lazy-seq? coll) (realize-ls coll) coll))
(var c (realize-for-iteration coll))
(each x c
(let [k (f x)]
(put result k (array/push (core-get result k @[]) x))))
@ -844,7 +951,7 @@
(var result @[])
(var part @[])
(var last-k nil)
(each x coll
(each x (realize-for-iteration coll)
(let [k (f x)]
(if (and last-k (deep= k last-k))
(array/push part x)
@ -923,6 +1030,7 @@
(cond
(nil? coll) nil
(lazy-seq? coll) (ls-first coll)
(pvec? coll) (if (= 0 (pv-count coll)) nil (pv-nth coll (- (pv-count coll) 1))) # vector: last
(= 0 (length coll)) nil
(tuple? coll) (in coll (- (length coll) 1)) # vector: last
(array? coll) (in coll 0) # list: first
@ -931,12 +1039,14 @@
(defn core-pop [coll]
(cond
(nil? coll) nil
(pvec? coll) (pv-pop coll) # vector: drop last
(tuple? coll) (tuple/slice coll 0 (- (length coll) 1)) # vector: drop last
(array? coll) (array/slice coll 1) # list: rest
coll))
(defn core-subvec [v start &opt end]
(tuple/slice v start (if (nil? end) (length v) end)))
(let [a (vview v)]
(make-vec (tuple/slice a start (if (nil? end) (length a) end)))))
(defn core-trampoline [f & args]
(var result (apply f args))
@ -1050,7 +1160,7 @@
# Collection constructors
# ============================================================
(defn core-vector [& xs] (tuple ;xs))
(defn core-vector [& xs] (make-vec xs))
(defn core-hash-map [& kvs] (make-phm kvs))
(defn core-array-map [& kvs]
@ -1084,7 +1194,7 @@
concat-form)
(defn core-set [coll]
(apply core-hash-set (if (tuple? coll) (array/slice coll) coll)))
(apply core-hash-set (realize-for-iteration coll)))
(defn core-list [& xs]
(array ;xs))
@ -1140,9 +1250,11 @@
(lazy-seq? v) (pr-render-seq buf (realize-for-iteration v) "(" ")")
(set? v) (pr-render-seq buf (phs-seq v) "#{" "}")
(phm? v) (pr-render-pairs buf (phm-entries v))
(pvec? v) (pr-render-seq buf (pv->array v) "[" "]")
(and (table? v) (get v :jolt/deftype)) (buffer/push-string buf (string v))
(tuple? v) (pr-render-seq buf v "[" "]")
(array? v) (pr-render-seq buf v "(" ")")
# mutable mode: arrays are vectors -> print with [] (else lists -> ())
(array? v) (if mutable? (pr-render-seq buf v "[" "]") (pr-render-seq buf v "(" ")"))
(struct? v) (pr-render-pairs buf (pairs v))
(table? v) (pr-render-pairs buf (pairs v))
true (buffer/push-string buf (string v)))))
@ -1259,7 +1371,7 @@
(def core-int-array (fn [size] (array/new-filled size 0)))
(def core-to-array (fn [coll]
(def arr @[])
(each x coll (array/push arr x))
(each x (realize-for-iteration coll) (array/push arr x))
arr))
# ============================================================
@ -2094,14 +2206,14 @@
(if (tuple? ks) (tuple/slice ks 1) (array/slice ks 1)))
(defn core-assoc-in [m ks v]
(let [k (in ks 0)]
(let [ks (vview ks) k (in ks 0)]
(if (<= (length ks) 1)
(core-assoc m k v)
(let [sub (core-get m k)]
(core-assoc m k (core-assoc-in (if (nil? sub) {} sub) (ks-rest ks) v))))))
(defn core-update-in [m ks f & args]
(let [k (in ks 0)]
(let [ks (vview ks) k (in ks 0)]
(if (<= (length ks) 1)
(core-assoc m k (apply f (core-get m k) args))
(let [sub (core-get m k)]
@ -2318,7 +2430,7 @@
(defn core-filterv [pred coll]
(let [r @[]] (each x (realize-for-iteration coll) (when (truthy? (pred x)) (array/push r x)))
(tuple/slice (tuple ;r))))
(make-vec r)))
(defn core-mapv [f & colls]
(let [r @[]]
@ -2327,14 +2439,59 @@
(let [cs (map realize-for-iteration colls)
n (min ;(map length cs))]
(var i 0) (while (< i n) (array/push r (apply f (map (fn [c] (in c i)) cs))) (++ i))))
(tuple/slice (tuple ;r))))
(make-vec r)))
(defn core-interpose [sep coll]
(let [items (realize-for-iteration coll) r @[]]
(var first? true)
(each x items (if first? (set first? false) (array/push r sep)) (array/push r x))
(tuple ;r)))
(defn core-some-search
"(some pred coll) — first truthy (pred x), else nil."
[pred coll]
(var result nil)
(each x (realize-for-iteration coll)
(let [r (pred x)] (when (truthy? r) (set result r) (break))))
result)
(defn core-keep
"(keep f coll) — (f x) for each x, dropping nils. (keep f) is a transducer."
[f & rest]
(if (= 0 (length rest))
(td-keep f)
(let [r @[]]
(each x (realize-for-iteration (in rest 0))
(let [v (f x)] (when (not (nil? v)) (array/push r v))))
(tuple ;r))))
(defn core-interleave
"(interleave & colls) — take one from each in turn until the shortest ends."
[& colls]
(if (= 0 (length colls)) (tuple)
(let [cs (map realize-for-iteration colls)
n (min ;(map length cs))
r @[]]
(var i 0)
(while (< i n) (each c cs (array/push r (in c i))) (++ i))
(tuple ;r))))
(defn core-flatten
"(flatten coll) — fully flatten nested sequentials into one seq."
[coll]
(def r @[])
(defn seqish? [x] (or (tuple? x) (array? x) (pvec? x) (lazy-seq? x)))
(defn step [x] (each e (realize-for-iteration x) (if (seqish? e) (step e) (array/push r e))))
(when (seqish? coll) (step coll))
(tuple ;r))
(defn core-empty [coll]
(cond
(phm? coll) (make-phm)
(set? coll) (make-phs)
(pvec? coll) (make-vec @[])
(struct? coll) (struct)
(tuple? coll) []
(tuple? coll) (make-vec @[])
(array? coll) @[]
(table? coll) @{}
nil))
@ -2366,12 +2523,12 @@
(each p preds (each x xs (when (and (nil? hit) (truthy? (p x))) (set hit (p x)))))
hit))
(defn core-sequential? [x] (or (tuple? x) (array? x) (lazy-seq? x)))
(defn core-associative? [x] (or (phm? x) (struct? x) (tuple? x) (array? x) (and (table? x) (not (set? x)))))
(defn core-sequential? [x] (or (tuple? x) (array? x) (pvec? x) (lazy-seq? x)))
(defn core-associative? [x] (or (phm? x) (struct? x) (tuple? x) (array? x) (pvec? x) (and (table? x) (not (set? x)))))
(defn core-ifn? [x]
(or (function? x) (cfunction? x) (keyword? x) (phm? x) (set? x) (tuple? x) (array? x)
(or (function? x) (cfunction? x) (keyword? x) (phm? x) (set? x) (tuple? x) (array? x) (pvec? x)
(and (struct? x) (= :symbol (x :jolt/type)))))
(defn core-indexed? [x] (or (tuple? x) (array? x)))
(defn core-indexed? [x] (or (tuple? x) (array? x) (pvec? x)))
(defn core-distinct? [& xs]
(var seen @{}) (var ok true)
@ -2514,6 +2671,13 @@
"filter" core-filter
"remove" core-remove
"reduce" core-reduce
"apply" core-apply
"interpose" core-interpose
"mapcat" core-mapcat
"some" core-some-search
"keep" core-keep
"interleave" core-interleave
"flatten" core-flatten
"every-pred" core-every-pred
"find" core-find
"transduce" core-transduce

32
src/jolt/evaluator.janet
View file

@ -3,6 +3,8 @@
(use ./types)
(use ./phm)
(use ./pv)
(use ./config)
(use ./reader)
(use ./regex)
@ -36,6 +38,9 @@
(cond
(phm? coll) (phm-get coll k default)
(set? coll) (if (phs-contains? coll k) k default)
(pvec? coll)
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (pv-count coll)))
(pv-nth coll k) default)
(or (tuple? coll) (array? coll))
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length coll)))
(in coll k) default)
@ -57,6 +62,11 @@
(coll-lookup (get args 0) f (get args 1))
(phm? f) (phm-get f (get args 0) (get args 1))
(set? f) (if (phs-contains? f (get args 0)) (get args 0) (get args 1))
(pvec? f)
(let [k (get args 0)]
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (pv-count f)))
(pv-nth f k)
(error (string "Index " k " out of bounds for vector of length " (pv-count f)))))
(or (tuple? f) (array? f))
(let [k (get args 0)]
(if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f)))
@ -114,14 +124,16 @@
(do (var result @[]) (var i 0) (while (< i (length form))
(let [item (in form i)]
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(each v (eval-form ctx bindings (in item 1)) (array/push result v))
(let [sv (eval-form ctx bindings (in item 1))]
(each v (if (pvec? sv) (pv->array sv) sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(++ i)) (tuple ;result))
(array? form)
(do (var result @[]) (var i 0) (while (< i (length form))
(let [item (in form i)]
(if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing"))
(each v (eval-form ctx bindings (in item 1)) (array/push result v))
(let [sv (eval-form ctx bindings (in item 1))]
(each v (if (pvec? sv) (pv->array sv) sv) (array/push result v)))
(array/push result (syntax-quote* ctx bindings item gsmap))))
(++ i)) result)
(and (struct? form) (get form :jolt/type)) form
@ -361,6 +373,7 @@
(defn- d-realize
"Realize a lazy-seq to an array for positional destructuring; pass others through."
[val]
(if (pvec? val) (pv->array val)
(if (lazy-seq? val)
(do
(var items @[]) (var cur val) (var go true)
@ -372,7 +385,7 @@
(let [rt (in cell 1)]
(if (nil? rt) (set go false) (set cur (make-lazy-seq rt))))))))
items)
val))
val)))
(defn- d-get
"Look up key k in a map-like value (phm/struct/table/nil)."
@ -497,7 +510,7 @@
(keyword? obj) ["Keyword" "Object"]
(and (struct? obj) (= :jolt/char (get obj :jolt/type))) ["Character" "Object"]
(and (struct? obj) (= :symbol (get obj :jolt/type))) ["Symbol" "Object"]
(or (tuple? obj) (array? obj)) ["PersistentVector" "IPersistentVector" "IPersistentCollection" "ISeq" "Object"]
(or (tuple? obj) (array? obj) (pvec? obj)) ["PersistentVector" "IPersistentVector" "IPersistentCollection" "ISeq" "Object"]
(or (function? obj) (cfunction? obj)) ["IFn" "Fn" "Object"]
(nil? obj) ["nil" "Object"]
["Object"]))
@ -667,8 +680,9 @@
(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))
"require" (let [spec0 (eval-form ctx bindings (in form 1))
spec (if (pvec? spec0) (pv->array spec0) spec0)]
(if (and (indexed? spec) (> (length spec) 0))
(eval-require ctx spec)
(error "require expects a vector spec")))
"all-ns" (all-ns ctx)
@ -997,7 +1011,7 @@
"clojure.lang.Volatile" (and (table? val) (= :jolt/volatile (val :jolt/type)))
"clojure.lang.Delay" (and (table? val) (= :jolt/delay (val :jolt/type)))
"clojure.lang.IPersistentMap" (or (phm? val) (struct? val))
"clojure.lang.IPersistentVector" (tuple? val)
"clojure.lang.IPersistentVector" (or (tuple? val) (pvec? val))
"clojure.lang.IPersistentSet" (set? val)
"Object" true
false)))
@ -1203,7 +1217,9 @@
(keyword? form) form
(bytes? form) form
(buffer? form) form
(tuple? form) (tuple/slice (map |(eval-form ctx bindings $) form))
(tuple? form)
(let [els (map |(eval-form ctx bindings $) form)]
(if mutable? (array ;els) (pv-from-indexed els)))
(struct? form)
(if (= :symbol (form :jolt/type))
(resolve-sym ctx bindings form)

18
src/jolt/main.janet
View file

@ -4,6 +4,8 @@
(use ./api)
(use ./types)
(use ./phm)
(use ./pv)
(use ./config)
(use ./reader)
(def ctx (init))
@ -23,6 +25,17 @@
(defn- write-collection [v buf]
(cond
(pvec? v)
(do
(push-str buf "[")
(let [a (pv->array v) n (pv-count v)]
(var i 0)
(while (< i n)
(write-value (in a i) buf)
(when (< (+ i 1) n) (push-str buf " "))
(++ i)))
(push-str buf "]"))
(tuple? v)
(do
(push-str buf "[")
@ -57,14 +70,15 @@
(array? v)
(do
(push-str buf "(")
# mutable mode: arrays are vectors -> [] ; immutable: arrays are lists -> ()
(push-str buf (if mutable? "[" "("))
(var i 0)
(let [n (length v)]
(while (< i n)
(write-value (in v i) buf)
(when (< (+ i 1) n) (push-str buf " "))
(++ i)))
(push-str buf ")"))
(push-str buf (if mutable? "]" ")")))
(and (table? v) (= :jolt/set (v :jolt/type)))
(do

159
src/jolt/pv.janet Normal file
View file

@ -0,0 +1,159 @@
# Persistent vector — a 32-way branching trie with a tail buffer, modeled on
# Clojure's PersistentVector. Immutable: every update returns a new vector that
# structurally shares unchanged subtrees with the old one, so conj/assoc/pop are
# O(log32 n) and share memory instead of copying the whole vector.
#
# Layout:
# @{:jolt/type :jolt/pvec
# :cnt n number of elements
# :shift s bits to shift the index for the root level (5 * depth)
# :root node trie root: a tuple of up to 32 children
# :tail tail} a tuple of up to 32 trailing elements (append fast-path)
#
# Trie nodes are immutable tuples so unchanged subtrees are shared by identity.
(def- bits 5)
(def- width 32) # 2^bits
(def- mask 31) # width - 1
(def empty-node [])
(defn pvec? [x]
(and (table? x) (= :jolt/pvec (get x :jolt/type))))
(defn make-pv [cnt shift root tail]
@{:jolt/type :jolt/pvec :cnt cnt :shift shift :root root :tail tail})
(def EMPTY (make-pv 0 bits empty-node []))
(defn pv-count [pv] (get pv :cnt))
# Index of the first element held in the tail (everything before lives in the trie).
(defn- tail-offset [cnt]
(if (< cnt width) 0 (blshift (brshift (- cnt 1) bits) bits)))
# Return the 32-element leaf array containing index i.
(defn- leaf-for [pv i]
(if (>= i (tail-offset (get pv :cnt)))
(get pv :tail)
(do
(var node (get pv :root))
(var level (get pv :shift))
(while (> level 0)
(set node (get node (band (brshift i level) mask)))
(set level (- level bits)))
node)))
(defn pv-nth [pv i &opt dflt]
(if (and (>= i 0) (< i (get pv :cnt)))
(get (leaf-for pv i) (band i mask))
dflt))
# --- conj -------------------------------------------------------------------
# Push the full tail down into the trie, returning a new root node array.
(defn- push-tail [level parent tail cnt]
(def sub-idx (band (brshift (- cnt 1) level) mask))
(def child
(if (= level bits)
tail
(let [c (get parent sub-idx)]
(if c
(push-tail (- level bits) c tail cnt)
(push-tail (- level bits) empty-node tail cnt)))))
(def arr (array/slice parent))
(put arr sub-idx child)
(tuple/slice arr))
(defn pv-conj [pv val]
(def cnt (get pv :cnt))
(def tail (get pv :tail))
(if (< (length tail) width)
# Room in the tail: just append to it.
(make-pv (+ cnt 1) (get pv :shift)
(get pv :root)
(tuple/slice (tuple ;tail val)))
# Tail is full: push it into the trie, start a fresh tail with val.
(let [shift (get pv :shift)
root (get pv :root)]
(if (> (brshift cnt bits) (blshift 1 shift))
# Root overflow: grow the trie one level taller.
(let [new-root (tuple root (push-tail shift empty-node tail cnt))]
(make-pv (+ cnt 1) (+ shift bits) new-root [val]))
(make-pv (+ cnt 1) shift (push-tail shift root tail cnt) [val])))))
# --- assoc ------------------------------------------------------------------
(defn- assoc-in-node [level node i val]
(def arr (array/slice node))
(if (= level 0)
(put arr (band i mask) val)
(let [sub-idx (band (brshift i level) mask)]
(put arr sub-idx (assoc-in-node (- level bits) (get node sub-idx) i val))))
(tuple/slice arr))
(defn pv-assoc [pv i val]
(def cnt (get pv :cnt))
(cond
(= i cnt) (pv-conj pv val)
(and (>= i 0) (< i cnt))
(if (>= i (tail-offset cnt))
(let [tail (array/slice (get pv :tail))]
(put tail (band i mask) val)
(make-pv cnt (get pv :shift) (get pv :root) (tuple/slice tail)))
(make-pv cnt (get pv :shift)
(assoc-in-node (get pv :shift) (get pv :root) i val)
(get pv :tail)))
(error (string "Index " i " out of bounds for vector of length " cnt))))
# --- pop --------------------------------------------------------------------
(defn- pop-tail [level node cnt]
(def sub-idx (band (brshift (- cnt 2) level) mask))
(cond
(> level bits)
(let [child (pop-tail (- level bits) (get node sub-idx) cnt)]
(if (and (nil? child) (= sub-idx 0))
nil
(let [arr (array/slice node)] (put arr sub-idx child) (tuple/slice arr))))
(= sub-idx 0) nil
(let [arr (array/slice node)] (put arr sub-idx nil) (tuple/slice arr))))
(defn pv-pop [pv]
(def cnt (get pv :cnt))
(cond
(= cnt 0) (error "Can't pop empty vector")
(= cnt 1) EMPTY
(> (- cnt (tail-offset cnt)) 1)
# More than one element in the tail: drop the last tail element.
(let [tail (get pv :tail)]
(make-pv (- cnt 1) (get pv :shift) (get pv :root)
(tuple/slice tail 0 (- (length tail) 1))))
# Tail has one element: the new tail is the last leaf of the trie.
(let [shift (get pv :shift)
new-tail (leaf-for pv (- cnt 2))
new-root-raw (pop-tail shift (get pv :root) cnt)
new-root (if (nil? new-root-raw) empty-node new-root-raw)]
(if (and (> shift bits) (nil? (get new-root 1)))
# Trie lost a level: promote the single remaining child to root.
(make-pv (- cnt 1) (- shift bits) (get new-root 0) new-tail)
(make-pv (- cnt 1) shift new-root new-tail)))))
# --- conversions ------------------------------------------------------------
(defn pv->array [pv]
(def out @[])
(def cnt (get pv :cnt))
(var i 0)
(while (< i cnt)
(array/push out (pv-nth pv i))
(++ i))
out)
(defn pv-from-indexed [xs]
# Build a pvec from any Janet-indexed collection (tuple/array).
(var pv EMPTY)
(def n (length xs))
(var i 0)
(while (< i n) (set pv (pv-conj pv (in xs i))) (++ i))
pv)