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

core: close surfaced gaps — first-class sorted colls, with-out-str, rand arity, deref reduced

Browse source 
jolt-ti9: sorted-map/sorted-set are now first-class across the collection fns —
get/assoc/dissoc/conj/contains?/keys/vals/disj and call-as-fn all operate on the
wrapper and preserve sort order. The by-comparator constructors (sorted-map-by/
sorted-set-by) now thread the user comparator (numeric or boolean-predicate) through
all derived colls. Sorted predicates/ctors/ops moved above core-conj so the
collection fns can branch on them; jolt-invoke (interpreter) gets inline branches.

jolt-rfw: add with-out-str (binds output to a string buffer) + the macro.
jolt-ek3: (rand n) arity and deref-of-reduced (uuid? still deferred).

Specs: new io-spec.janet; sorted-spec expanded to pin the now-working map/set ops
and by-comparator ordering; predicate/number spec restorations.
This commit is contained in:
Yogthos 2026-06-10 08:00:36 -04:00
parent ae8b635602
commit afef55704c
7 changed files with 174 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

5
jolt-core/clojure/core/30-macros.clj
View file

@ -12,6 +12,11 @@
(defmacro comment [& body] nil)
;; with-out-str: capture everything the body prints to *out* and return it as a
;; string. __with-out-str (clojure.core) runs the thunk with the output captured.
(defmacro with-out-str [& body]
`(__with-out-str (fn* [] ~@body)))
;; defmulti/defmethod are sugar over defmulti-setup/defmethod-setup (ctx-capturing
;; clojure.core fns) so they compile as plain invokes. name/mm are passed quoted;
;; the dispatch fn, options, and dispatch value evaluate normally, and the method

125
src/jolt/core.janet
View file

@ -269,7 +269,7 @@
(defn core-max [& args] (each x args (need-num x "max")) (apply max args))
(defn core-min [& args] (each x args (need-num x "min")) (apply min args))
(defn core-rand [] (math/random))
(defn core-rand [& n] (let [r (math/random)] (if (empty? n) r (* r (in n 0)))))
(defn core-rand-int [n] (math/floor (* (math/random) n)))
# ============================================================
@ -375,12 +375,69 @@
(defn- map-value? [x]
(or (phm? x) (and (struct? x) (nil? (get x :jolt/type)))))
# --- Sorted collections (sorted-map / sorted-set) -------------------------------
# Defined here (before the collection fns) so conj/assoc/get/contains?/keys/vals/
# disj can branch on them. A sorted-map is {:jolt/type :jolt/sorted-map :map STRUCT};
# a sorted-set is {:jolt/type :jolt/sorted-set :items SORTED-ARRAY}. Keys/elements
# are assumed Comparable scalars (the premise of a sorted coll); ops return a fresh
# wrapper (persistent — source unchanged). by-comparator ctors are still TODO (no
# stored comparator yet).
(defn core-sorted-map? [x] (and (table? x) (= :jolt/sorted-map (x :jolt/type))))
(defn core-sorted-set? [x] (and (table? x) (= :jolt/sorted-set (x :jolt/type))))
(defn core-sorted? [x] (or (core-sorted-map? x) (core-sorted-set? x)))
# A sorted coll may carry a :cmp — a Janet 2-arg comparator returning a Clojure
# compare result (neg/0/pos). nil means natural order (Janet's < via sort). The
# by-comparator constructors install one (built from the user IFn); all derived
# colls (assoc/conj/...) propagate it so ordering stays consistent.
# A Clojure comparator is either a (neg/0/pos)-returning fn or a boolean predicate
# (true => a sorts before b, like <). Reduce both to a strict less-than for sort.
(defn- cmp-lt? [cmp a b]
(let [r (cmp a b)]
(if (boolean? r) r (if (number? r) (< r 0) (truthy? r)))))
(defn- sorted-by [cmp arr] (if cmp (sort arr (fn [a b] (cmp-lt? cmp a b))) (sort arr)))
(defn sm-make [m &opt cmp] @{:jolt/type :jolt/sorted-map :map m :cmp cmp})
(defn ss-make [items &opt cmp] @{:jolt/type :jolt/sorted-set :items items :cmp cmp})
(defn core-sorted-map [& kvs]
(var m @{}) (var i 0)
(while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
(sm-make (table/to-struct m)))
(defn core-sorted-set [& xs]
(var seen @{}) (each x xs (put seen x true))
(ss-make (sorted-by nil (array ;(keys seen)))))
(defn sorted-map-keys [sm] (sorted-by (sm :cmp) (array ;(keys (sm :map)))))
(defn sorted-map-entries [sm] (let [m (sm :map)] (map (fn [k] [k (get m k)]) (sorted-map-keys sm))))
(defn sm-assoc-many [sm kvs]
(var m @{}) (each k (keys (sm :map)) (put m k (get (sm :map) k)))
(var i 0) (while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
(sm-make (table/to-struct m) (sm :cmp)))
(defn sm-dissoc-many [sm ks]
(def rm @{}) (each x ks (put rm x true))
(var m @{}) (each k (keys (sm :map)) (unless (get rm k) (put m k (get (sm :map) k))))
(sm-make (table/to-struct m) (sm :cmp)))
(defn ss-contains? [ss x] (var f false) (each e (ss :items) (when (deep= e x) (set f true) (break))) f)
(defn ss-conj-many [ss xs]
(var seen @{}) (each e (ss :items) (put seen e true)) (each x xs (put seen x true))
(ss-make (sorted-by (ss :cmp) (array ;(keys seen))) (ss :cmp)))
(defn ss-disj-many [ss xs]
(def rm @{}) (each x xs (put rm x true))
(ss-make (filter (fn [e] (not (get rm e))) (ss :items)) (ss :cmp)))
(defn core-conj [& args]
(if (= 0 (length args)) (make-vec @[]) # (conj) -> []
(let [coll (first args) xs (tuple/slice args 1)]
(if (nil? coll)
# conj onto nil builds a list (prepends): (conj nil 1 2) -> (2 1)
(do (var result nil) (each x xs (set result (pl-cons x result))) result)
(if (core-sorted-map? coll)
# conj a [k v] entry (or merge a map) into a sorted-map
(do (var m coll)
(each x xs
(if (map-value? x)
(each e (map-entries-of x) (set m (sm-assoc-many m [(in e 0) (in e 1)])))
(set m (sm-assoc-many m [(vnth x 0) (vnth x 1)]))))
m)
(if (core-sorted-set? coll)
(ss-conj-many coll xs)
(if (pvec? coll)
(do (var result coll) (each x xs (set result (pv-conj result x))) result)
(if (plist? coll)
@ -414,7 +471,7 @@
(each e (map-entries-of x)
(set result (map-assoc1 result (in e 0) (in e 1))))
(set result (map-assoc1 result (vnth x 0) (vnth x 1)))))
result)))))))))))
result)))))))))))))
(defn core-assoc [m & kvs]
(when (odd? (length kvs))
@ -425,6 +482,7 @@
(and (struct? m) (get m :jolt/type)))
(error (string "assoc requires a map or vector, got " (type m))))
(cond
(core-sorted-map? m) (sm-assoc-many m kvs)
(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)
@ -466,6 +524,7 @@
(defn core-dissoc [m & ks]
(cond
(nil? m) nil
(core-sorted-map? m) (sm-dissoc-many m ks)
(phm? m) (do (var result m) (each k ks (set result (phm-dissoc result k))) result)
# reject clearly non-map values (scalars, sequences, sets, symbol/char structs)
(or (number? m) (string? m) (buffer? m) (keyword? m) (boolean? m)
@ -479,6 +538,8 @@
(defn core-get [m k &opt default]
(default default nil)
(if (nil? m) default
(if (core-sorted-map? m) (let [v (get (m :map) k)] (if (nil? v) default v))
(if (core-sorted-set? m) (if (ss-contains? m k) k default)
(if (core-transient? m)
(case (m :kind)
:vector (if (and (number? k) (>= k 0) (< k (length (m :arr)))) (in (m :arr) k) default)
@ -493,7 +554,7 @@
(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.
@ -502,6 +563,8 @@
(or (function? f) (cfunction? f)) (apply f args)
(keyword? f) (core-get (get args 0) f (get args 1))
(and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1))
(core-sorted-map? f) (let [v (get (f :map) (get args 0))] (if (nil? v) (get args 1) v))
(core-sorted-set? f) (if (ss-contains? f (get args 0)) (get args 0) (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)
@ -551,6 +614,8 @@
(if missing default current))
(defn core-contains? [coll key]
(if (core-sorted-map? coll) (not (nil? (get (coll :map) key)))
(if (core-sorted-set? coll) (ss-contains? coll key)
(if (core-transient? coll)
(case (coll :kind)
:vector (and (number? key) (>= key 0) (< key (length (coll :arr))))
@ -562,7 +627,7 @@
(if (table? coll) (not (nil? (coll key)))
(if (or (tuple? coll) (array? coll))
(and (number? key) (>= key 0) (< key (length coll)))
false))))))))
false))))))))))
# Coerce a Clojure IFn value to a Janet-callable fn for higher-order fns
# (map/filter/sort-by/group-by/...). Janet functions pass through; a keyword or
@ -579,21 +644,8 @@
# 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.
(defn core-sorted-map? [x] (and (table? x) (= :jolt/sorted-map (x :jolt/type))))
(defn core-sorted-set? [x] (and (table? x) (= :jolt/sorted-set (x :jolt/type))))
# sorted? is true for either sorted maps or sorted sets (Clojure: any Sorted coll).
(defn core-sorted? [x] (or (core-sorted-map? x) (core-sorted-set? x)))
(defn sm-make [m] @{:jolt/type :jolt/sorted-map :map m})
(defn ss-make [items] @{:jolt/type :jolt/sorted-set :items items})
(defn core-sorted-map [& kvs]
(var m @{}) (var i 0)
(while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
(sm-make (table/to-struct m)))
(defn core-sorted-set [& xs]
(var seen @{}) (each x xs (put seen x true))
(ss-make (sort (array ;(keys seen)))))
(defn sorted-map-keys [sm] (sort (array ;(keys (sm :map)))))
(defn sorted-map-entries [sm] (let [m (sm :map)] (map (fn [k] [k (get m k)]) (sorted-map-keys sm))))
# sorted-map/sorted-set predicates, constructors and ops live ABOVE core-conj so
# the collection fns (conj/assoc/get/contains?/…) can branch on them.
(defn core-count [coll]
(cond
@ -773,10 +825,12 @@
(defn core-keys [m]
# phm-entries (not phm-to-struct) so keys mapped to nil values are not dropped.
(if (phm? m) (tuple ;(map |(in $ 0) (phm-entries m))) (tuple ;(keys m))))
(if (core-sorted-map? m) (tuple ;(sorted-map-keys m))
(if (phm? m) (tuple ;(map |(in $ 0) (phm-entries m))) (tuple ;(keys m)))))
(defn core-vals [m]
(if (phm? m) (tuple ;(map |(in $ 1) (phm-entries m))) (tuple ;(map |(m $) (keys m)))))
(if (core-sorted-map? m) (tuple ;(map |(in $ 1) (sorted-map-entries m)))
(if (phm? m) (tuple ;(map |(in $ 1) (phm-entries m))) (tuple ;(map |(m $) (keys m))))))
(defn core-select-keys [m ks]
# Include a key when it is PRESENT (contains?), even if its value is nil — a
@ -1509,7 +1563,10 @@
(defn core-set? [x] (set? x))
(defn core-disj [s & ks]
(if (set? s) (apply phs-disj s ks) (error "disj expects a set")))
(cond
(core-sorted-set? s) (ss-disj-many s ks)
(set? s) (apply phs-disj s ks)
(error "disj expects a set")))
(defn core-set [coll]
(apply core-hash-set (realize-for-iteration coll)))
@ -1698,6 +1755,14 @@
(prin "\n")
nil)
# Capture *out*: run thunk with Janet's :out dynamic bound to a buffer, so all
# print/println/pr/prn output (which go through `prin` -> (dyn :out)) is collected
# and returned as a string. The with-out-str macro (overlay) wraps a body thunk.
(defn core-with-out-str [thunk]
(def buf @"")
(with-dyns [:out buf] (thunk))
(string buf))
(defn core-pr [& xs]
(var i 0)
(while (< i (length xs))
@ -1826,8 +1891,17 @@
(defn core-reader-conditional [form splicing?]
@{:jolt/type :jolt/reader-conditional :form form :splicing? splicing?})
# reader-conditional? now lives in the Clojure collection tier (tagged-value predicate).
(defn core-sorted-map-by [cmp & kvs] (apply core-sorted-map kvs))
(defn core-sorted-set-by [cmp & xs] (apply core-sorted-set xs))
# The user comparator is a Clojure IFn; wrap it as a Janet 2-arg fn returning the
# numeric compare result, then thread it through the sorted wrapper.
(defn core-sorted-map-by [cmp & kvs]
(let [jc (fn [a b] (jolt-call cmp a b))]
(var m @{}) (var i 0)
(while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
(sm-make (table/to-struct m) jc)))
(defn core-sorted-set-by [cmp & xs]
(let [jc (fn [a b] (jolt-call cmp a b))]
(var seen @{}) (each x xs (put seen x true))
(ss-make (sorted-by jc (array ;(keys seen))) jc)))
(defn core-array-seq [arr & _] (core-seq arr))
(defn core-seque [& args] (in args (- (length args) 1)))
(defn core-supers [x] (make-phs))
@ -1966,6 +2040,8 @@
# future macro: (future body...) -> (future-call (fn* [] body...))
(defn core-deref [ref & opts]
(cond
(and (table? ref) (= :jolt/reduced (ref :jolt/type)))
(ref :val)
(and (table? ref) (= :jolt/atom (ref :jolt/type)))
(ref :value)
(and (table? ref) (= :jolt/volatile (ref :jolt/type)))
@ -2844,6 +2920,7 @@
"ex-info" core-ex-info
"prn-str" core-prn-str
"println-str" core-println-str
"__with-out-str" core-with-out-str
"force" core-force
"realized?" core-realized?
"delay?" core-delay?

4
src/jolt/evaluator.janet
View file

@ -102,6 +102,10 @@
(keyword? f) (coll-lookup (get args 0) f (get args 1))
(and (struct? f) (= :symbol (f :jolt/type)))
(coll-lookup (get args 0) f (get args 1))
(and (table? f) (= :jolt/sorted-map (f :jolt/type)))
(let [v (get (f :map) (get args 0))] (if (nil? v) (get args 1) v))
(and (table? f) (= :jolt/sorted-set (f :jolt/type)))
(if (some |(deep= $ (get args 0)) (f :items)) (get args 0) (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)

26
test/spec/io-spec.janet Normal file
View file

@ -0,0 +1,26 @@
# Specification: printing / output (print/println/pr/prn, *-str, format, str).
# Output is captured with with-out-str (jolt-rfw); the *-str fns return strings.
(use ../support/harness)
(defspec "io / with-out-str captures"
["println" "\"hi\\n\"" "(with-out-str (println \"hi\"))"]
["print spaces" "\"a b\"" "(with-out-str (print \"a\" \"b\"))"]
["prn quotes" "\"[1 2]\\n\"" "(with-out-str (prn [1 2]))"]
["pr no newline" "\"5\"" "(with-out-str (pr 5))"]
["multiple writes" "\"12\"" "(with-out-str (print 1) (print 2))"]
["no output" "\"\"" "(with-out-str 42)"]
["println no args" "\"\\n\"" "(with-out-str (println))"])
(defspec "io / *-str builders"
["print-str" "\"a b\"" "(print-str \"a\" \"b\")"]
["println-str" "\"x\\n\"" "(println-str \"x\")"]
["prn-str" "\"[1 2]\\n\"" "(prn-str [1 2])"]
["pr-str quotes" "\"\\\"s\\\"\"" "(pr-str \"s\")"]
["pr-str keyword" "\":a\"" "(pr-str :a)"])
(defspec "io / str & format"
["str concat" "\"1:ab\"" "(str 1 :a \"b\")"]
["str nil" "\"\"" "(str nil)"]
["str of coll" "\"[1 2]\"" "(str [1 2])"]
["format d/s" "\"5-x\"" "(format \"%d-%s\" 5 \"x\")"]
["format float" "\"3.14\"" "(format \"%.2f\" 3.14159)"])

1
test/spec/numbers-spec.janet
View file

@ -131,5 +131,6 @@
["rand-int in range" "true" "(let [r (rand-int 5)] (and (integer? r) (>= r 0) (< r 5)))"]
["rand-int zero" "0" "(rand-int 1)"]
["rand in [0,1)" "true" "(let [r (rand)] (and (>= r 0) (< r 1)))"]
["rand n in [0,n)" "true" "(let [r (rand 10)] (and (>= r 0) (< r 10)))"]
["rand-nth member" "true" "(contains? #{:a :b :c} (rand-nth [:a :b :c]))"]
["rand-nth single" ":x" "(rand-nth [:x])"])

1
test/spec/predicates-spec.janet
View file

@ -124,6 +124,7 @@
["integer? fraction" "false" "(integer? 5.5)"]
["reduced? wrapped" "true" "(reduced? (reduced 1))"]
["reduced? plain" "false" "(reduced? 1)"]
["deref reduced" "9" "(deref (reduced 9))"]
["unreduced wrapped" "9" "(unreduced (reduced 9))"]
["unreduced plain" "9" "(unreduced 9)"]
["not-empty full" "[1]" "(not-empty [1])"]

42
test/spec/sorted-spec.janet
View file

@ -1,11 +1,10 @@
# Specification: sorted collections (sorted-map / sorted-set, subseq/rsubseq).
#
# NOTE: sorted collections are only partially first-class in Jolt — get/conj/assoc/
# contains?/keys/vals on a sorted coll, and the by-comparator constructors, are NOT
# yet wired up (jolt-ti9). This spec pins the behavior that DOES work (construction,
# SEQ ordering, subseq/rsubseq, sorted?, first) so it can't regress; the broken ops
# are tracked in jolt-ti9. (vec coerces the seq to a vector so expecteds are vector
# literals rather than quoted lists.)
# sorted collections are first-class for the core ops (jolt-ti9): get/assoc/dissoc/
# conj/contains?/keys/vals/disj all work and preserve sort order, and a sorted coll
# is callable as a key-lookup fn. STILL TODO: the by-comparator constructors
# (sorted-map-by / sorted-set-by) ignore the supplied comparator (jolt-ti9). (vec
# coerces a seq to a vector so expecteds are vector literals, not quoted lists.)
(use ../support/harness)
(defspec "sorted / construction & ordering"
@ -22,6 +21,37 @@
["plain map" "false" "(sorted? {:a 1})"]
["vector" "false" "(sorted? [1 2])"])
(defspec "sorted / map ops"
["get hit" "2" "(get (sorted-map :a 1 :b 2) :b)"]
["get miss default" ":none" "(get (sorted-map :a 1) :z :none)"]
["contains? yes" "true" "(contains? (sorted-map :a 1) :a)"]
["contains? no" "false" "(contains? (sorted-map :a 1) :z)"]
["assoc keeps order" "[[:a 1] [:b 2] [:c 3]]" "(vec (seq (assoc (sorted-map :c 3 :a 1) :b 2)))"]
["dissoc" "[[:a 1] [:c 3]]" "(vec (seq (dissoc (sorted-map :a 1 :b 2 :c 3) :b)))"]
["conj entry" "[[:a 1] [:z 9]]" "(vec (seq (conj (sorted-map :a 1) [:z 9])))"]
["keys sorted" "[:a :b :c]" "(vec (keys (sorted-map :c 3 :a 1 :b 2)))"]
["vals by key" "[1 2 3]" "(vec (vals (sorted-map :c 3 :a 1 :b 2)))"]
["map as fn" "2" "((sorted-map :a 1 :b 2) :b)"]
["map as fn miss" ":d" "((sorted-map :a 1) :z :d)"])
(defspec "sorted / set ops"
["get present" "2" "(get (sorted-set 1 2 3) 2)"]
["get absent" ":none" "(get (sorted-set 1 2 3) 9 :none)"]
["contains? yes" "true" "(contains? (sorted-set 1 2 3) 2)"]
["contains? no" "false" "(contains? (sorted-set 1 2 3) 9)"]
["conj keeps order" "[0 1 2 3 5]" "(vec (seq (conj (sorted-set 1 2 3) 5 0)))"]
["disj" "[1 3]" "(vec (seq (disj (sorted-set 1 2 3) 2)))"]
["set as fn" "3" "((sorted-set 1 2 3) 3)"]
["set as fn miss" "nil" "((sorted-set 1 2 3) 9)"])
(defspec "sorted / by comparator"
["sorted-set-by desc" "[10 3 2 1]" "(vec (seq (sorted-set-by > 1 3 2 10)))"]
["sorted-map-by desc" "[[3 :c] [2 :b] [1 :a]]" "(vec (seq (sorted-map-by > 1 :a 3 :c 2 :b)))"]
["conj keeps comparator" "[5 3 2 1 0]" "(vec (seq (conj (sorted-set-by > 1 3 2) 5 0)))"]
["assoc keeps comparator" "[3 2 1]" "(vec (keys (assoc (sorted-map-by > 1 :a 3 :c) 2 :b)))"]
["disj keeps comparator" "[3 1]" "(vec (seq (disj (sorted-set-by > 1 2 3) 2)))"]
["by-comparator is sorted?" "true" "(sorted? (sorted-set-by > 1 2))"])
(defspec "sorted / subseq & rsubseq"
["subseq >=" "[3 4 5]" "(vec (subseq (sorted-set 1 2 3 4 5) >= 3))"]
["subseq <" "[1 2]" "(vec (subseq (sorted-set 1 2 3 4 5) < 3))"]