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

Split 20-coll.clj into three collection-tier files

Browse source 
The 1123-line collection tier is the largest source file. Cut it at two existing
section banners into 20-coll (predicates, printing, hierarchies, pure-over-core
leaves), 21-coll (rand/sort seams, the test runner, fn combinators), and 22-coll
(canonical Clojure ports, transduce/into, JVM-shape stubs). No macros in this tier,
so order is the only constraint; the emit-image manifest lists the three in
sequence. Re-minted seed is identical apart from gensym label renumbering.
This commit is contained in:
Yogthos 2026-06-23 02:06:24 -04:00
parent 0db08e7571
commit f7767706cf
5 changed files with 906 additions and 898 deletions
Download patch file Download diff file Expand all files Collapse all files

668
jolt-core/clojure/core/20-coll.clj
View file

@ -455,671 +455,3 @@
(defn println-str [& xs] (__with-out-str (fn* [] (apply println xs))))
(defn prn-str [& xs] (__with-out-str (fn* [] (apply prn xs))))
;; --- leaves over the rand / sort host seams ----------------------------------
;; Canonical truncation toward zero via int (the kernel fn floored, which is
;; wrong for a negative n).
(defn rand-int [n] (int (rand n)))
;; Pure-functional Fisher-Yates over vector assoc; returns a vector, as in
;; Clojure. Collections only — a string is seqable but not shuffleable, as on
;; the JVM (Collections/shuffle wants a Collection).
(defn shuffle [coll]
(when-not (coll? coll)
(throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
(loop [v (vec coll) i (dec (count v))]
(if (pos? i)
(let [j (rand-int (inc i))
t (nth v i)]
(recur (assoc (assoc v i (nth v j)) j t) (dec i)))
v)))
;; Canonical sort-by: the default comparator is compare (so nil sorts first,
;; like Clojure — the kernel fn used host ordering, which put nil last); the
;; comparator compares KEYS and may be 3-way or a boolean predicate (the host
;; sort seam normalizes).
(defn sort-by
([keyfn coll] (sort-by keyfn compare coll))
([keyfn comp coll]
(sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws
;; on a non-string (Clojure 1.11). __make-uuid is the host constructor for the
;; tagged value (overlay source can't write :jolt/type map literals — the
;; reader treats them as tagged forms).
(defn parse-uuid [s]
(if (string? s)
(when (re-matches
#"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}" s)
(__make-uuid s))
(throw (str "parse-uuid requires a string, got: " s))))
;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version
;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid.
(defn random-uuid []
(let [hx4 (fn [] (format "%04x" (rand-int 0x10000)))
hx3 (fn [] (format "%03x" (rand-int 0x1000)))]
(parse-uuid (str (hx4) (hx4) "-" (hx4) "-4" (hx3)
"-" (format "%x" (+ 8 (rand-int 4))) (hx3)
"-" (hx4) (hx4) (hx4)))))
;; The char escape/name tables, as char-keyed maps (Clojure's shape).
(def ^:private char-escape-strings
{\newline "\\n" \tab "\\t" \return "\\r" \formfeed "\\f"
\backspace "\\b" \" "\\\"" \\ "\\\\"})
(defn char-escape-string [c] (get char-escape-strings c))
(def ^:private char-name-strings
{\newline "newline" \tab "tab" \return "return" \formfeed "formfeed"
\backspace "backspace" \space "space"})
(defn char-name-string [c] (get char-name-strings c))
;; Random selection over the host rand primitives.
(defn rand-nth [coll]
(let [v (vec coll)] (nth v (rand-int (count v)))))
(defn random-sample
([prob] (filter (fn [_] (< (rand) prob))))
([prob coll] (filter (fn [_] (< (rand) prob)) coll)))
(defn comparator [pred]
(fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
;; Lazy: the running accumulators, one at a time (matches Clojure).
(defn reductions
([f coll]
(lazy-seq
(let [s (seq coll)]
(if s
(reductions f (first s) (rest s))
(list (f))))))
([f init coll]
(cons init
(lazy-seq
(when-let [s (seq coll)]
(reductions f (f init (first s)) (rest s)))))))
;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
;; via the (now lazy) mapcat.
(defn tree-seq [branch? children root]
(let [walk (fn walk [node]
(lazy-seq
(cons node
(when (branch? node)
(mapcat walk (children node))))))]
(walk root)))
;; file-seq: the tree of paths under root (root included), directories walked
;; via the host dir primitives. Paths (strings), not File objects. (Lives below
;; tree-seq: forward references are analysis errors.)
(defn file-seq [root]
(if (__file? root)
;; java.io.File tree: walk via the File method surface so leaves are File
;; values callers can invoke .isFile/.getName/slurp on.
(tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root)
(tree-seq __dir? __list-dir root)))
;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
;; Flattens lists too (sequential?), matching Clojure/CLJS.
(defn flatten [coll]
(filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
(defn xml-seq [root]
(tree-seq (complement string?) (comp seq :content) root))
;; Lazy interleave: round-robin one element from each coll until any exhausts.
(defn interleave
([] ())
([c1] (lazy-seq c1))
([c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
(when (and s1 s2)
(cons (first s1)
(cons (first s2)
(interleave (rest s1) (rest s2))))))))
([c1 c2 & cs]
(lazy-seq
(let [ss (map seq (list* c1 c2 cs))]
(when (every? identity ss)
(concat (map first ss)
(apply interleave (map rest ss))))))))
;; No ratio type on Jolt, so rationalize is identity.
(defn rationalize [x] x)
;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
;; value is needed). 1-arg: eager dedupe of consecutive equal elements.
(defn dedupe
([]
(fn [rf]
(let [pv (volatile! [false nil])]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [[seen prior] @pv]
(vreset! pv [true input])
(if (and seen (= prior input)) result (rf result input))))))))
([coll]
(let [step (fn step [s prev]
(make-lazy-seq
(fn* []
(let [s (seq s)]
(if s
(let [x (first s)]
(if (= x prev)
(coll->cells (step (rest s) prev))
(coll->cells (cons x (step (rest s) x)))))
nil)))))]
(let [s (seq coll)]
(if s
(make-lazy-seq
(fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
())))))
;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs —
;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
;; element is returned as-is (the trailing-map calling convention), and an
;; unpaired key past pairs throws.
(defn seq-to-map-for-destructuring [s]
(if (next s)
(loop [m {} xs (seq s)]
(if xs
(if (next xs)
(recur (assoc m (first xs) (second xs)) (nnext xs))
(throw (str "No value supplied for key: " (first xs))))
m))
(if (seq s) (first s) {})))
;; Host-coupled fns that are pure logic over existing core primitives, so they
;; need no new jolt.host surface.
;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
;; with-meta are the irreducible host primitives; vary-meta is just their compose.
(defn vary-meta [obj f & args]
(with-meta obj (apply f (meta obj) args)))
;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
(defn namespace-munge [s]
(apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
;; so reduced short-circuits — and the vector path indexes correctly. nil folds
;; to init, matching Clojure.
(defn reduce-kv [f init coll]
(cond
(vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
(map? coll) (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
(nil? coll) init
:else (throw (str "reduce-kv not supported on: " coll))))
;; ex-info accessors. The constructor (ex-info) stays native — it builds the tagged
;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
(defn- ex-unwrap [e]
(if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
(defn ex-data [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
(defn ex-message [e]
(let [e (ex-unwrap e)]
(cond (ex-info-val? e) (get e :message)
:else nil)))
(defn ex-cause [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
;; inst-ms: epoch milliseconds of an instant; throws on a non-inst (Clojure
;; protocol behavior).
(defn inst-ms [x]
(if (inst? x) (get x :ms) (throw (str "inst-ms requires an inst, got: " x))))
;; Clojure 1.11 map transformers. PHM base so transformed keys canonicalize
;; (collisions: last entry in seq order wins, matching the reference).
(defn update-keys [m f]
(reduce-kv (fn [acc k v] (assoc acc (f k) v)) (hash-map) m))
(defn update-vals [m f]
(reduce-kv (fn [acc k v] (assoc acc k (f v))) (hash-map) m))
;; Vector-returning partition variants (1.11): lazy seqs OF vectors.
(defn partitionv
([n coll] (map vec (partition n coll)))
([n step coll] (map vec (partition n step coll)))
([n step pad coll] (map vec (partition n step pad coll))))
;; partition-all is a lazy-tier fn (40-lazy) — declared so partitionv-all
;; compiles; bound by the time anything calls it.
(declare partition-all)
(defn partitionv-all
([n coll] (map vec (partition-all n coll)))
([n step coll] (map vec (partition-all n step coll))))
;; First part a vector, rest a seq — matching the reference implementation.
(defn splitv-at [n coll]
[(vec (take n coll)) (drop n coll)])
;; with-redefs-fn: temporarily set each var's root to the mapped value, run
;; the thunk, restore the saved roots even on throw. The with-redefs macro
;; (30-macros) builds the {var val} map from names.
(defn with-redefs-fn [binding-map func]
(let [vars (vec (keys binding-map))
saved (mapv var-get vars)]
(doseq [v vars] (var-set v (get binding-map v)))
(try
(func)
(finally
;; loop/recur, not dotimes: dotimes is a 30-macros macro and this tier
;; compiles before it exists (a forward ref would resolve to the macro
;; fn at runtime and mis-apply it).
(loop [i 0]
(when (< i (count vars))
(var-set (nth vars i) (nth saved i))
(recur (inc i))))))))
;; Jolt has no chunked seqs, so this is always false.
(defn chunked-seq? [x] false)
;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
;; the native ops (which already validate and notify watches); get-validator reads a
;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
;; mutation kernel the overlay can't express over core fns (a nil value removes the
;; key). compare-and-set! compares by value.
(defn swap-vals! [a f & args]
(let [old (deref a)] [old (apply swap! a f args)]))
(defn reset-vals! [a newval]
(let [old (deref a)] (reset! a newval) [old newval]))
(defn compare-and-set! [a oldval newval]
(if (= oldval (deref a)) (do (reset! a newval) true) false))
(defn get-validator [a] (get a :validator))
(defn add-watch [a key f]
(jolt.host/ref-put! (get a :watches) key f) a)
(defn remove-watch [a key]
(jolt.host/ref-put! (get a :watches) key nil) a)
(defn set-validator! [a f]
(jolt.host/ref-put! a :validator f) nil)
;; vreset!/vswap! live in the seq tier (10-seq.clj): its transducers use them.
;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
;; future? stays native (deref/future-cancel/realized? call it); future-call and
;; future-cancel stay native too (OS threads).
(defn future-done? [x]
(if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
(defn future-cancelled? [x]
(and (future? x) (boolean (get x :cancelled))))
;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
(defn ns-name [ns]
(let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
;; constructors (object-array/make-array/to-array/...) stay native — they build the
;; mutable backing.
(defn aget [arr & idxs]
(reduce (fn [v i] (nth v i)) arr idxs))
(defn alength [arr] (count arr))
(defn aset [arr & idxs+val]
(let [n (count idxs+val)
val (nth idxs+val (dec n))
target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
(jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
val))
;; --- fn combinators + host-free stubs ----------------------------------------
(defn complement
"Takes a fn f and returns a fn that takes the same arguments as f, has the
same effects, if any, and returns the opposite truth value."
[f]
(fn [& args] (not (apply f args))))
;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments.
(defn fnil
([f x]
(fn [a & args] (apply f (if (nil? a) x a) args)))
([f x y]
(fn [a b & args] (apply f (if (nil? a) x a) (if (nil? b) y b) args)))
([f x y z]
(fn [a b c & args]
(apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) args))))
(defn clojure-version [] "1.11.0-jolt")
;; bigdec is a host fn (host/chez/bigdec.ss) — a real BigDecimal value type.
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
;; No class hierarchy on this host.
(defn supers [x] #{})
;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
;; type — a symbol munges to a symbol, anything else to a string. (jolt only
;; rewrites dashes, not the full Compiler CHAR_MAP.)
(defn munge [s]
(let [m (str-replace-all "-" "_" (str s))]
(if (symbol? s) (symbol m) m)))
(defn test
"Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."
[v]
(let [t (:test (meta v))]
(if t (do (t) :ok) :no-test)))
;; --- canonical Clojure ports -------------------------------------------------
;; key/val/find first — merge-with and memoize below use them.
;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT
;; a plain vector — (key [1 2]) throws.
;; key/val moved above the hierarchies section (underive uses them).
;; find was previously missing from jolt entirely. Presence (contains?), not
;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by
;; index. The result must be a REAL entry (key/val are strict), so it is
;; minted as the first entry of a one-entry map — nil values survive (the
;; map builder switches to a phm when nil is involved).
(defn find [m k]
(when (contains? m k) (first {k (get m k)})))
;; some? lives in the top leaf block now (forward refs are errors).
(defn true? [x] (= true x))
(defn false? [x] (= false x))
;; Presence-preserving: a key with a nil value is kept ((hash-map) base keeps
;; nil values and canonicalizes collection keys).
(defn select-keys [map keyseq]
(reduce (fn [m k] (if (contains? map k) (assoc m k (get map k)) m))
(hash-map) keyseq))
(defn zipmap [keys vals]
(loop [m (hash-map) ks (seq keys) vs (seq vals)]
(if (and ks vs)
(recur (assoc m (first ks) (first vs)) (next ks) (next vs))
m)))
;; conj semantics per entry arg (a map merges, a [k v] pair adds); nil args are
;; no-ops; all-nil (or no args) is nil.
(defn merge [& maps]
(when (some identity maps)
(reduce (fn [acc m] (if (nil? m) acc (conj (or acc (hash-map)) m)))
maps)))
(defn merge-with [f & maps]
(when (some identity maps)
(let [merge-entry (fn [m e]
(let [k (key e) v (val e)]
;; presence — not nil-of-value — decides combination
(if (contains? m k)
(assoc m k (f (get m k) v))
(assoc m k v))))
merge2 (fn [m1 m2]
(reduce merge-entry (or m1 (hash-map)) (seq m2)))]
(reduce merge2 maps))))
(defn get-in
([m ks] (reduce get m ks))
([m ks not-found]
;; a fresh table is its own identity — a present-but-nil step is
;; distinguished from a missing one
(let [sentinel (hash-map)]
(loop [m m ks (seq ks)]
(if ks
(let [nxt (get m (first ks) sentinel)]
(if (identical? sentinel nxt)
not-found
(recur nxt (next ks))))
m)))))
;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
(defn memoize [f]
(let [mem (atom (hash-map))]
(fn [& args]
;; plain let/if, not if-let: this tier loads before 30-macros defines it
(let [e (find (deref mem) args)]
(if e
(val e)
(let [ret (apply f args)]
(swap! mem assoc args ret)
ret))))))
(defn partial
([f] f)
([f a] (fn [& args] (apply f a args)))
([f a b] (fn [& args] (apply f a b args)))
([f a b c] (fn [& args] (apply f a b c args)))
([f a b c & more] (fn [& args] (apply f a b c (concat more args)))))
(defn trampoline
([f] (let [ret (f)] (if (fn? ret) (trampoline ret) ret)))
([f & args] (trampoline (fn [] (apply f args)))))
;; Canonical pairwise max/min: > / < throw on non-numbers, and the NaN
;; behavior is Clojure's by construction.
(defn max
([x] x)
([x y] (if (> x y) x y))
([x y & more] (reduce max (max x y) more)))
(defn min
([x] x)
([x y] (if (< x y) x y))
([x y & more] (reduce min (min x y) more)))
(defn reverse [coll] (reduce conj (list) coll))
;; An empty coll of the same category; sorted colls keep their comparator (the
;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy
;; seq empties to ().
(defn empty [coll]
(cond
(nil? coll) nil
(sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll)
(map? coll) {}
(set? coll) #{}
(vector? coll) []
(coll? coll) ()
:else nil))
(defn assoc-in [m [k & ks] v]
(if ks
(assoc m k (assoc-in (get m k) ks v))
(assoc m k v)))
(defn update-in [m ks f & args]
(let [up (fn up [m ks f args]
(let [[k & ks] ks]
(if ks
(assoc m k (up (get m k) ks f args))
(assoc m k (apply f (get m k) args)))))]
(up m ks f args)))
;; jolt keywords have no intern table (any keyword "exists"), so find-keyword
;; always finds — babashka makes the same call.
(defn find-keyword
([nm] (keyword nm))
([ns nm] (keyword ns nm)))
;; The raw Inst protocol method; jolt insts have one representation, so it is
;; inst-ms itself.
(defn inst-ms* [i] (inst-ms i))
;; Canonical comp — here rather than a host primitive so each stage is invoked with
;; jolt call semantics: (comp seq :content) works because the keyword stage
;; goes through IFn dispatch.
(defn comp
([] identity)
([f] f)
([f g]
;; fixed arities first (Clojure's own shape): the 1-arg path — every
;; map/filter stage — is two direct calls, no rest-seq, no apply.
(fn
([] (f (g)))
([x] (f (g x)))
([x y] (f (g x y)))
([x y z] (f (g x y z)))
([x y z & args] (f (apply g x y z args)))))
([f g & fs] (reduce comp (comp f g) fs)))
;; Canonical IFn set: fns, keywords, symbols, maps (sorted incl.),
;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure).
(defn ifn? [x]
(or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x)))
;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow,
;; so all of these are the checked ops; fixed arities mirror Clojure's
;; signatures. unchecked-divide-int goes through quot, so dividing by zero
;; throws as on the JVM.
(def +' +)
(def -' -)
(def *' *)
(def inc' inc)
(def dec' dec)
(defn unchecked-add [x y] (+ x y))
(defn unchecked-subtract [x y] (- x y))
(defn unchecked-multiply [x y] (* x y))
(defn unchecked-negate [x] (- x))
(defn unchecked-inc [x] (+ x 1))
(defn unchecked-dec [x] (- x 1))
(def unchecked-add-int unchecked-add)
(def unchecked-subtract-int unchecked-subtract)
(def unchecked-multiply-int unchecked-multiply)
(def unchecked-negate-int unchecked-negate)
(def unchecked-inc-int unchecked-inc)
(def unchecked-dec-int unchecked-dec)
(defn unchecked-divide-int [x y] (quot x y))
(defn unchecked-remainder-int [x y] (rem x y))
(defn unchecked-int [x] (int x))
(def unchecked-long unchecked-int)
;; int? is integer? on jolt: one number type, so fixed-precision and
;; arbitrary-precision integers coincide.
(defn int? [x] (integer? x))
;; num: Clojure coerces to java.lang.Number; jolt just checks.
(defn num [x]
(if (number? x) x (throw (str "num requires a number, got: " x))))
;; == numeric equality: 1-arity is trivially true without inspecting the value
;; (Clojure's shape); 2+ args must be numbers, as Numbers.equiv throws.
(defn ==
([x] true)
([x y]
(if (and (number? x) (number? y))
(= x y)
(throw (str "Cannot cast to number: " (if (number? x) y x)))))
([x y & more]
(if (== x y)
(apply == y more)
false)))
;; ensure-reduced / halt-when: canonical Clojure. halt-when smuggles the halt
;; value through reduce in a ::halt-keyed map and unwraps it in the completion
;; arity, so the halt REPLACES the whole reduction result.
(defn ensure-reduced [x] (if (reduced? x) x (reduced x)))
(defn halt-when
([pred] (halt-when pred nil))
([pred retf]
(fn [rf]
(fn
([] (rf))
([result]
(if (and (map? result) (contains? result ::halt))
(get result ::halt)
(rf result)))
([result input]
(if (pred input)
(reduced (hash-map ::halt (if retf (retf (rf result) input) input)))
(rf result input)))))))
;; parse-boolean: exact "true"/"false" only; nil on anything else, throw on a
;; non-string (Clojure 1.11).
(defn parse-boolean [s]
(if (string? s)
(cond (= s "true") true (= s "false") false :else nil)
(throw (str "parse-boolean requires a string, got: " s))))
(defn newline [] (print "\n") nil)
;; seque: jolt is single-threaded eager here — the queue is a no-op and the
;; coll passes through.
(defn seque
([s] s)
([n-or-q s] s))
(defn array-seq [arr & _] (seq arr))
(defn to-array-2d [coll] (to-array (map to-array coll)))
;; Masking integer coercions (not aliases): byte/short wrap to their width.
;; unchecked-byte/short truncate to a number; unchecked-char returns a char (as on
;; the JVM). int handles chars, so (unchecked-byte \a) works.
(defn unchecked-byte [x] (bit-and (int x) 0xff))
(defn unchecked-short [x] (bit-and (int x) 0xffff))
(defn unchecked-char [x] (char (bit-and (int x) 0xffff)))
(defn unchecked-float [x] (double x))
(defn unchecked-double [x] (double x))
;; --- transduce / into / eduction ---------------------------------------------
;; Canonical transduce: build the stacked rf once, reduce (which honors
;; `reduced` and steps lazy seqs incrementally), then run the completion arity.
(defn transduce
([xform f coll] (transduce xform f (f) coll))
([xform f init coll]
(let [xf (xform f)]
(xf (reduce xf init coll)))))
;; into stays a host primitive: it's perf-wall hot (the into-vec bench pays ~11%
;; through the overlay call layers — same lesson as even?/odd?).
;; eduction is EAGER on jolt (documented divergence): the composed
;; xforms applied to coll, realized into a vector.
(defn eduction [& args]
(let [coll (last args)
xforms (butlast args)]
(if xforms
(into [] (apply comp xforms) coll)
(into [] coll))))
(defn ->Eduction [xform coll] (into [] xform coll))
;; --- JVM-shape stubs and trivial shells --------------------------------------
;; Pure compositions or documented jolt stubs; the host keeps nothing.
(defn enumeration-seq [e] (seq e))
(defn iterator-seq [i] (seq i))
;; jolt is single-threaded: a promise is an atom, deref never blocks
;; ((deref undelivered) is nil rather than a hang).
(defn promise [] (atom nil))
(defn deliver [p v] (reset! p v) p)
(defn bean [x] (if (map? x) x {}))
(defn uri? [x] false)
;; An EVALUATED set of quoted symbols — a quoted set literal ('#{if ...})
;; stays an unevaluated reader form on jolt and contains? can't see into it.
(def ^:private special-syms
#{'if 'do 'let* 'fn* 'quote 'var 'def 'loop* 'recur 'throw 'try 'catch
'finally 'new 'set! '. 'monitor-enter 'monitor-exit})
(defn special-symbol? [s] (contains? special-syms s))
;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
;; JVM proxies don't exist on this host: the read-only surface is inert,
;; the constructive surface throws.
(defn proxy-mappings [p] {})
(defn proxy-call-with-super [f p meth] (f))
(defn init-proxy [p mappings] p)
(defn update-proxy [p mappings] p)
(defn proxy-super [& args] (throw "proxy-super: JVM proxies are not supported in Jolt"))
(defn construct-proxy [c & args] (throw "construct-proxy: not supported in Jolt"))
(defn get-proxy-class [& interfaces] (throw "get-proxy-class: not supported in Jolt"))

362
jolt-core/clojure/core/21-coll.clj Normal file
View file

@ -0,0 +1,362 @@
;; clojure.core — collection tier, part 2 (rand/sort host seams, the
;; clojure.test runner, fn combinators). Continues 20-coll.clj; same constraints
;; (pure, eager, no macros), loaded in the 20 slot before 25-sorted.
;; --- leaves over the rand / sort host seams ----------------------------------
;; Canonical truncation toward zero via int (the kernel fn floored, which is
;; wrong for a negative n).
(defn rand-int [n] (int (rand n)))
;; Pure-functional Fisher-Yates over vector assoc; returns a vector, as in
;; Clojure. Collections only — a string is seqable but not shuffleable, as on
;; the JVM (Collections/shuffle wants a Collection).
(defn shuffle [coll]
(when-not (coll? coll)
(throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
(loop [v (vec coll) i (dec (count v))]
(if (pos? i)
(let [j (rand-int (inc i))
t (nth v i)]
(recur (assoc (assoc v i (nth v j)) j t) (dec i)))
v)))
;; Canonical sort-by: the default comparator is compare (so nil sorts first,
;; like Clojure — the kernel fn used host ordering, which put nil last); the
;; comparator compares KEYS and may be 3-way or a boolean predicate (the host
;; sort seam normalizes).
(defn sort-by
([keyfn coll] (sort-by keyfn compare coll))
([keyfn comp coll]
(sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws
;; on a non-string (Clojure 1.11). __make-uuid is the host constructor for the
;; tagged value (overlay source can't write :jolt/type map literals — the
;; reader treats them as tagged forms).
(defn parse-uuid [s]
(if (string? s)
(when (re-matches
#"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}" s)
(__make-uuid s))
(throw (str "parse-uuid requires a string, got: " s))))
;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version
;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid.
(defn random-uuid []
(let [hx4 (fn [] (format "%04x" (rand-int 0x10000)))
hx3 (fn [] (format "%03x" (rand-int 0x1000)))]
(parse-uuid (str (hx4) (hx4) "-" (hx4) "-4" (hx3)
"-" (format "%x" (+ 8 (rand-int 4))) (hx3)
"-" (hx4) (hx4) (hx4)))))
;; The char escape/name tables, as char-keyed maps (Clojure's shape).
(def ^:private char-escape-strings
{\newline "\\n" \tab "\\t" \return "\\r" \formfeed "\\f"
\backspace "\\b" \" "\\\"" \\ "\\\\"})
(defn char-escape-string [c] (get char-escape-strings c))
(def ^:private char-name-strings
{\newline "newline" \tab "tab" \return "return" \formfeed "formfeed"
\backspace "backspace" \space "space"})
(defn char-name-string [c] (get char-name-strings c))
;; Random selection over the host rand primitives.
(defn rand-nth [coll]
(let [v (vec coll)] (nth v (rand-int (count v)))))
(defn random-sample
([prob] (filter (fn [_] (< (rand) prob))))
([prob coll] (filter (fn [_] (< (rand) prob)) coll)))
(defn comparator [pred]
(fn [a b] (cond (pred a b) -1 (pred b a) 1 :else 0)))
;; Lazy: the running accumulators, one at a time (matches Clojure).
(defn reductions
([f coll]
(lazy-seq
(let [s (seq coll)]
(if s
(reductions f (first s) (rest s))
(list (f))))))
([f init coll]
(cons init
(lazy-seq
(when-let [s (seq coll)]
(reductions f (f init (first s)) (rest s)))))))
;; Lazy pre-order DFS (matches Clojure): node, then its children's walks spliced
;; via the (now lazy) mapcat.
(defn tree-seq [branch? children root]
(let [walk (fn walk [node]
(lazy-seq
(cons node
(when (branch? node)
(mapcat walk (children node))))))]
(walk root)))
;; file-seq: the tree of paths under root (root included), directories walked
;; via the host dir primitives. Paths (strings), not File objects. (Lives below
;; tree-seq: forward references are analysis errors.)
(defn file-seq [root]
(if (__file? root)
;; java.io.File tree: walk via the File method surface so leaves are File
;; values callers can invoke .isFile/.getName/slurp on.
(tree-seq (fn [f] (.isDirectory f)) (fn [f] (seq (.listFiles f))) root)
(tree-seq __dir? __list-dir root)))
;; Canonical flatten via tree-seq: the leaves (non-sequential nodes) in order.
;; Flattens lists too (sequential?), matching Clojure/CLJS.
(defn flatten [coll]
(filter (complement sequential?) (rest (tree-seq sequential? seq coll))))
;; xml-seq: tree-seq over XML element trees. Elements are maps with :content.
(defn xml-seq [root]
(tree-seq (complement string?) (comp seq :content) root))
;; Lazy interleave: round-robin one element from each coll until any exhausts.
(defn interleave
([] ())
([c1] (lazy-seq c1))
([c1 c2]
(lazy-seq
(let [s1 (seq c1) s2 (seq c2)]
(when (and s1 s2)
(cons (first s1)
(cons (first s2)
(interleave (rest s1) (rest s2))))))))
([c1 c2 & cs]
(lazy-seq
(let [ss (map seq (list* c1 c2 cs))]
(when (every? identity ss)
(concat (map first ss)
(apply interleave (map rest ss))))))))
;; No ratio type on Jolt, so rationalize is identity.
(defn rationalize [x] x)
;; 0-arg: a stateful transducer (tracks [seen? prev] in a volatile, so no sentinel
;; value is needed). 1-arg: eager dedupe of consecutive equal elements.
(defn dedupe
([]
(fn [rf]
(let [pv (volatile! [false nil])]
(fn
([] (rf))
([result] (rf result))
([result input]
(let [[seen prior] @pv]
(vreset! pv [true input])
(if (and seen (= prior input)) result (rf result input))))))))
([coll]
(let [step (fn step [s prev]
(make-lazy-seq
(fn* []
(let [s (seq s)]
(if s
(let [x (first s)]
(if (= x prev)
(coll->cells (step (rest s) prev))
(coll->cells (cons x (step (rest s) x)))))
nil)))))]
(let [s (seq coll)]
(if s
(make-lazy-seq
(fn* [] (coll->cells (cons (first s) (step (rest s) (first s))))))
())))))
;; Internal helper for {:keys [...]} destructuring over a seq of k/v pairs —
;; canonical Clojure 1.11 shape (core.clj seq-to-map-for-destructuring):
;; even pairs build a map (later keys win, as createAsIfByAssoc), a SINGLE
;; element is returned as-is (the trailing-map calling convention), and an
;; unpaired key past pairs throws.
(defn seq-to-map-for-destructuring [s]
(if (next s)
(loop [m {} xs (seq s)]
(if xs
(if (next xs)
(recur (assoc m (first xs) (second xs)) (nnext xs))
(throw (str "No value supplied for key: " (first xs))))
m))
(if (seq s) (first s) {})))
;; Host-coupled fns that are pure logic over existing core primitives, so they
;; need no new jolt.host surface.
;; vary-meta: f applied to obj's metadata (+ extra args), reattached. meta and
;; with-meta are the irreducible host primitives; vary-meta is just their compose.
(defn vary-meta [obj f & args]
(with-meta obj (apply f (meta obj) args)))
;; namespace-munge: Clojure namespace name -> legal Java package name (- -> _).
(defn namespace-munge [s]
(apply str (map (fn [c] (if (= c \-) \_ c)) (seq (str s)))))
;; reduce-kv over a map (k v) or vector (index v). Both branches go through reduce,
;; so reduced short-circuits — and the vector path indexes correctly. nil folds
;; to init, matching Clojure.
(defn reduce-kv [f init coll]
(cond
(vector? coll) (reduce (fn [acc i] (f acc i (nth coll i))) init (range (count coll)))
(map? coll) (reduce (fn [acc k] (f acc k (get coll k))) init (keys coll))
(nil? coll) init
:else (throw (str "reduce-kv not supported on: " coll))))
;; ex-info accessors. The constructor (ex-info) stays native — it builds the tagged
;; value and wires into throw — but the value exposes :jolt/type/:message/:data/
;; :cause via get, so the accessors are pure over get. A thrown non-ex-info arrives
;; wrapped as {:jolt/type :jolt/exception :value v}; unwrap that first.
(defn- ex-info-val? [x] (= (get x :jolt/type) :jolt/ex-info))
(defn- ex-unwrap [e]
(if (= (get e :jolt/type) :jolt/exception) (get e :value) e))
(defn ex-data [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :data) nil)))
(defn ex-message [e]
(let [e (ex-unwrap e)]
(cond (ex-info-val? e) (get e :message)
:else nil)))
(defn ex-cause [e]
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
;; inst-ms: epoch milliseconds of an instant; throws on a non-inst (Clojure
;; protocol behavior).
(defn inst-ms [x]
(if (inst? x) (get x :ms) (throw (str "inst-ms requires an inst, got: " x))))
;; Clojure 1.11 map transformers. PHM base so transformed keys canonicalize
;; (collisions: last entry in seq order wins, matching the reference).
(defn update-keys [m f]
(reduce-kv (fn [acc k v] (assoc acc (f k) v)) (hash-map) m))
(defn update-vals [m f]
(reduce-kv (fn [acc k v] (assoc acc k (f v))) (hash-map) m))
;; Vector-returning partition variants (1.11): lazy seqs OF vectors.
(defn partitionv
([n coll] (map vec (partition n coll)))
([n step coll] (map vec (partition n step coll)))
([n step pad coll] (map vec (partition n step pad coll))))
;; partition-all is a lazy-tier fn (40-lazy) — declared so partitionv-all
;; compiles; bound by the time anything calls it.
(declare partition-all)
(defn partitionv-all
([n coll] (map vec (partition-all n coll)))
([n step coll] (map vec (partition-all n step coll))))
;; First part a vector, rest a seq — matching the reference implementation.
(defn splitv-at [n coll]
[(vec (take n coll)) (drop n coll)])
;; with-redefs-fn: temporarily set each var's root to the mapped value, run
;; the thunk, restore the saved roots even on throw. The with-redefs macro
;; (30-macros) builds the {var val} map from names.
(defn with-redefs-fn [binding-map func]
(let [vars (vec (keys binding-map))
saved (mapv var-get vars)]
(doseq [v vars] (var-set v (get binding-map v)))
(try
(func)
(finally
;; loop/recur, not dotimes: dotimes is a 30-macros macro and this tier
;; compiles before it exists (a forward ref would resolve to the macro
;; fn at runtime and mis-apply it).
(loop [i 0]
(when (< i (count vars))
(var-set (nth vars i) (nth saved i))
(recur (inc i))))))))
;; Jolt has no chunked seqs, so this is always false.
(defn chunked-seq? [x] false)
;; Atom peripheral operations. atom/swap!/reset!/deref stay native — the compiler
;; depends on them and they're hot. swap-vals!/reset-vals!/compare-and-set! compose
;; the native ops (which already validate and notify watches); get-validator reads a
;; slot; add-watch/remove-watch/set-validator! mutate the atom (or its watches
;; sub-table) through the one host primitive jolt.host/ref-put! — the minimal
;; mutation kernel the overlay can't express over core fns (a nil value removes the
;; key). compare-and-set! compares by value.
(defn swap-vals! [a f & args]
(let [old (deref a)] [old (apply swap! a f args)]))
(defn reset-vals! [a newval]
(let [old (deref a)] (reset! a newval) [old newval]))
(defn compare-and-set! [a oldval newval]
(if (= oldval (deref a)) (do (reset! a newval) true) false))
(defn get-validator [a] (get a :validator))
(defn add-watch [a key f]
(jolt.host/ref-put! (get a :watches) key f) a)
(defn remove-watch [a key]
(jolt.host/ref-put! (get a :watches) key nil) a)
(defn set-validator! [a f]
(jolt.host/ref-put! a :validator f) nil)
;; vreset!/vswap! live in the seq tier (10-seq.clj): its transducers use them.
;; Future status predicates — pure reads of the future's :cached/:cancelled slots.
;; future? stays native (deref/future-cancel/realized? call it); future-call and
;; future-cancel stay native too (OS threads).
(defn future-done? [x]
(if (future? x) (boolean (get x :cached)) (throw "future-done? requires a future")))
(defn future-cancelled? [x]
(and (future? x) (boolean (get x :cancelled))))
;; ns-name: a namespace object's :name as a symbol. Pure over get + symbol.
(defn ns-name [ns]
(let [nm (get ns :name)] (if nm (symbol (str nm)) nil)))
;; Java-array element access. Jolt arrays are mutable backing arrays; aget/alength
;; read them (nth/count) and aset writes a slot through ref-put!. Both handle the
;; multi-dimensional form (aget a i j ... / aset a i j ... v) by walking. The array
;; constructors (object-array/make-array/to-array/...) stay native — they build the
;; mutable backing.
(defn aget [arr & idxs]
(reduce (fn [v i] (nth v i)) arr idxs))
(defn alength [arr] (count arr))
(defn aset [arr & idxs+val]
(let [n (count idxs+val)
val (nth idxs+val (dec n))
target (reduce (fn [t k] (nth t k)) arr (take (- n 2) idxs+val))]
(jolt.host/ref-put! target (nth idxs+val (- n 2)) val)
val))
;; --- fn combinators + host-free stubs ----------------------------------------
(defn complement
"Takes a fn f and returns a fn that takes the same arguments as f, has the
same effects, if any, and returns the opposite truth value."
[f]
(fn [& args] (not (apply f args))))
;; Canonical Clojure fnil: patches only the FIRST 1-3 arguments.
(defn fnil
([f x]
(fn [a & args] (apply f (if (nil? a) x a) args)))
([f x y]
(fn [a b & args] (apply f (if (nil? a) x a) (if (nil? b) y b) args)))
([f x y z]
(fn [a b c & args]
(apply f (if (nil? a) x a) (if (nil? b) y b) (if (nil? c) z c) args))))
(defn clojure-version [] "1.11.0-jolt")
;; bigdec is a host fn (host/chez/bigdec.ss) — a real BigDecimal value type.
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))
;; No class hierarchy on this host.
(defn supers [x] #{})
;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
;; type — a symbol munges to a symbol, anything else to a string. (jolt only
;; rewrites dashes, not the full Compiler CHAR_MAP.)
(defn munge [s]
(let [m (str-replace-all "-" "_" (str s))]
(if (symbol? s) (symbol m) m)))
(defn test
"Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."
[v]
(let [t (:test (meta v))]
(if t (do (t) :ok) :no-test)))

314
jolt-core/clojure/core/22-coll.clj Normal file
View file

@ -0,0 +1,314 @@
;; clojure.core — collection tier, part 3 (canonical Clojure ports: key/val/find,
;; merge-with, memoize, group-by, frequencies, transduce/into/eduction, and the
;; JVM-shape stubs). Continues 21-coll.clj; same constraints.
;; --- canonical Clojure ports -------------------------------------------------
;; key/val/find first — merge-with and memoize below use them.
;; Strict, as in Clojure: an entry is what (seq m) yields (a host tuple), NOT
;; a plain vector — (key [1 2]) throws.
;; key/val moved above the hierarchies section (underive uses them).
;; find was previously missing from jolt entirely. Presence (contains?), not
;; value, decides — so (find {:a nil} :a) is [:a nil]. Works on vectors by
;; index. The result must be a REAL entry (key/val are strict), so it is
;; minted as the first entry of a one-entry map — nil values survive (the
;; map builder switches to a phm when nil is involved).
(defn find [m k]
(when (contains? m k) (first {k (get m k)})))
;; some? lives in the top leaf block now (forward refs are errors).
(defn true? [x] (= true x))
(defn false? [x] (= false x))
;; Presence-preserving: a key with a nil value is kept ((hash-map) base keeps
;; nil values and canonicalizes collection keys).
(defn select-keys [map keyseq]
(reduce (fn [m k] (if (contains? map k) (assoc m k (get map k)) m))
(hash-map) keyseq))
(defn zipmap [keys vals]
(loop [m (hash-map) ks (seq keys) vs (seq vals)]
(if (and ks vs)
(recur (assoc m (first ks) (first vs)) (next ks) (next vs))
m)))
;; conj semantics per entry arg (a map merges, a [k v] pair adds); nil args are
;; no-ops; all-nil (or no args) is nil.
(defn merge [& maps]
(when (some identity maps)
(reduce (fn [acc m] (if (nil? m) acc (conj (or acc (hash-map)) m)))
maps)))
(defn merge-with [f & maps]
(when (some identity maps)
(let [merge-entry (fn [m e]
(let [k (key e) v (val e)]
;; presence — not nil-of-value — decides combination
(if (contains? m k)
(assoc m k (f (get m k) v))
(assoc m k v))))
merge2 (fn [m1 m2]
(reduce merge-entry (or m1 (hash-map)) (seq m2)))]
(reduce merge2 maps))))
(defn get-in
([m ks] (reduce get m ks))
([m ks not-found]
;; a fresh table is its own identity — a present-but-nil step is
;; distinguished from a missing one
(let [sentinel (hash-map)]
(loop [m m ks (seq ks)]
(if ks
(let [nxt (get m (first ks) sentinel)]
(if (identical? sentinel nxt)
not-found
(recur nxt (next ks))))
m)))))
;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
(defn memoize [f]
(let [mem (atom (hash-map))]
(fn [& args]
;; plain let/if, not if-let: this tier loads before 30-macros defines it
(let [e (find (deref mem) args)]
(if e
(val e)
(let [ret (apply f args)]
(swap! mem assoc args ret)
ret))))))
(defn partial
([f] f)
([f a] (fn [& args] (apply f a args)))
([f a b] (fn [& args] (apply f a b args)))
([f a b c] (fn [& args] (apply f a b c args)))
([f a b c & more] (fn [& args] (apply f a b c (concat more args)))))
(defn trampoline
([f] (let [ret (f)] (if (fn? ret) (trampoline ret) ret)))
([f & args] (trampoline (fn [] (apply f args)))))
;; Canonical pairwise max/min: > / < throw on non-numbers, and the NaN
;; behavior is Clojure's by construction.
(defn max
([x] x)
([x y] (if (> x y) x y))
([x y & more] (reduce max (max x y) more)))
(defn min
([x] x)
([x y] (if (< x y) x y))
([x y & more] (reduce min (min x y) more)))
(defn reverse [coll] (reduce conj (list) coll))
;; An empty coll of the same category; sorted colls keep their comparator (the
;; value's own :empty op). Strings and scalars are nil, as in Clojure; a lazy
;; seq empties to ().
(defn empty [coll]
(cond
(nil? coll) nil
(sorted? coll) ((get (jolt.host/ref-get coll :ops) :empty) coll)
(map? coll) {}
(set? coll) #{}
(vector? coll) []
(coll? coll) ()
:else nil))
(defn assoc-in [m [k & ks] v]
(if ks
(assoc m k (assoc-in (get m k) ks v))
(assoc m k v)))
(defn update-in [m ks f & args]
(let [up (fn up [m ks f args]
(let [[k & ks] ks]
(if ks
(assoc m k (up (get m k) ks f args))
(assoc m k (apply f (get m k) args)))))]
(up m ks f args)))
;; jolt keywords have no intern table (any keyword "exists"), so find-keyword
;; always finds — babashka makes the same call.
(defn find-keyword
([nm] (keyword nm))
([ns nm] (keyword ns nm)))
;; The raw Inst protocol method; jolt insts have one representation, so it is
;; inst-ms itself.
(defn inst-ms* [i] (inst-ms i))
;; Canonical comp — here rather than a host primitive so each stage is invoked with
;; jolt call semantics: (comp seq :content) works because the keyword stage
;; goes through IFn dispatch.
(defn comp
([] identity)
([f] f)
([f g]
;; fixed arities first (Clojure's own shape): the 1-arg path — every
;; map/filter stage — is two direct calls, no rest-seq, no apply.
(fn
([] (f (g)))
([x] (f (g x)))
([x y] (f (g x y)))
([x y z] (f (g x y z)))
([x y z & args] (f (apply g x y z args)))))
([f g & fs] (reduce comp (comp f g) fs)))
;; Canonical IFn set: fns, keywords, symbols, maps (sorted incl.),
;; sets, vectors, and vars — NOT lists ((ifn? '(1 2)) is false in Clojure).
(defn ifn? [x]
(or (fn? x) (keyword? x) (symbol? x) (map? x) (set? x) (vector? x) (var? x)))
;; Auto-promoting (') and unchecked arithmetic. Jolt numbers don't overflow,
;; so all of these are the checked ops; fixed arities mirror Clojure's
;; signatures. unchecked-divide-int goes through quot, so dividing by zero
;; throws as on the JVM.
(def +' +)
(def -' -)
(def *' *)
(def inc' inc)
(def dec' dec)
(defn unchecked-add [x y] (+ x y))
(defn unchecked-subtract [x y] (- x y))
(defn unchecked-multiply [x y] (* x y))
(defn unchecked-negate [x] (- x))
(defn unchecked-inc [x] (+ x 1))
(defn unchecked-dec [x] (- x 1))
(def unchecked-add-int unchecked-add)
(def unchecked-subtract-int unchecked-subtract)
(def unchecked-multiply-int unchecked-multiply)
(def unchecked-negate-int unchecked-negate)
(def unchecked-inc-int unchecked-inc)
(def unchecked-dec-int unchecked-dec)
(defn unchecked-divide-int [x y] (quot x y))
(defn unchecked-remainder-int [x y] (rem x y))
(defn unchecked-int [x] (int x))
(def unchecked-long unchecked-int)
;; int? is integer? on jolt: one number type, so fixed-precision and
;; arbitrary-precision integers coincide.
(defn int? [x] (integer? x))
;; num: Clojure coerces to java.lang.Number; jolt just checks.
(defn num [x]
(if (number? x) x (throw (str "num requires a number, got: " x))))
;; == numeric equality: 1-arity is trivially true without inspecting the value
;; (Clojure's shape); 2+ args must be numbers, as Numbers.equiv throws.
(defn ==
([x] true)
([x y]
(if (and (number? x) (number? y))
(= x y)
(throw (str "Cannot cast to number: " (if (number? x) y x)))))
([x y & more]
(if (== x y)
(apply == y more)
false)))
;; ensure-reduced / halt-when: canonical Clojure. halt-when smuggles the halt
;; value through reduce in a ::halt-keyed map and unwraps it in the completion
;; arity, so the halt REPLACES the whole reduction result.
(defn ensure-reduced [x] (if (reduced? x) x (reduced x)))
(defn halt-when
([pred] (halt-when pred nil))
([pred retf]
(fn [rf]
(fn
([] (rf))
([result]
(if (and (map? result) (contains? result ::halt))
(get result ::halt)
(rf result)))
([result input]
(if (pred input)
(reduced (hash-map ::halt (if retf (retf (rf result) input) input)))
(rf result input)))))))
;; parse-boolean: exact "true"/"false" only; nil on anything else, throw on a
;; non-string (Clojure 1.11).
(defn parse-boolean [s]
(if (string? s)
(cond (= s "true") true (= s "false") false :else nil)
(throw (str "parse-boolean requires a string, got: " s))))
(defn newline [] (print "\n") nil)
;; seque: jolt is single-threaded eager here — the queue is a no-op and the
;; coll passes through.
(defn seque
([s] s)
([n-or-q s] s))
(defn array-seq [arr & _] (seq arr))
(defn to-array-2d [coll] (to-array (map to-array coll)))
;; Masking integer coercions (not aliases): byte/short wrap to their width.
;; unchecked-byte/short truncate to a number; unchecked-char returns a char (as on
;; the JVM). int handles chars, so (unchecked-byte \a) works.
(defn unchecked-byte [x] (bit-and (int x) 0xff))
(defn unchecked-short [x] (bit-and (int x) 0xffff))
(defn unchecked-char [x] (char (bit-and (int x) 0xffff)))
(defn unchecked-float [x] (double x))
(defn unchecked-double [x] (double x))
;; --- transduce / into / eduction ---------------------------------------------
;; Canonical transduce: build the stacked rf once, reduce (which honors
;; `reduced` and steps lazy seqs incrementally), then run the completion arity.
(defn transduce
([xform f coll] (transduce xform f (f) coll))
([xform f init coll]
(let [xf (xform f)]
(xf (reduce xf init coll)))))
;; into stays a host primitive: it's perf-wall hot (the into-vec bench pays ~11%
;; through the overlay call layers — same lesson as even?/odd?).
;; eduction is EAGER on jolt (documented divergence): the composed
;; xforms applied to coll, realized into a vector.
(defn eduction [& args]
(let [coll (last args)
xforms (butlast args)]
(if xforms
(into [] (apply comp xforms) coll)
(into [] coll))))
(defn ->Eduction [xform coll] (into [] xform coll))
;; --- JVM-shape stubs and trivial shells --------------------------------------
;; Pure compositions or documented jolt stubs; the host keeps nothing.
(defn enumeration-seq [e] (seq e))
(defn iterator-seq [i] (seq i))
;; jolt is single-threaded: a promise is an atom, deref never blocks
;; ((deref undelivered) is nil rather than a hang).
(defn promise [] (atom nil))
(defn deliver [p v] (reset! p v) p)
(defn bean [x] (if (map? x) x {}))
(defn uri? [x] false)
;; An EVALUATED set of quoted symbols — a quoted set literal ('#{if ...})
;; stays an unevaluated reader form on jolt and contains? can't see into it.
(def ^:private special-syms
#{'if 'do 'let* 'fn* 'quote 'var 'def 'loop* 'recur 'throw 'try 'catch
'finally 'new 'set! '. 'monitor-enter 'monitor-exit})
(defn special-symbol? [s] (contains? special-syms s))
;; print-method / print-dup are real multimethods in the io tier (50-io.clj).
;; JVM proxies don't exist on this host: the read-only surface is inert,
;; the constructive surface throws.
(defn proxy-mappings [p] {})
(defn proxy-call-with-super [f p meth] (f))
(defn init-proxy [p mappings] p)
(defn update-proxy [p mappings] p)
(defn proxy-super [& args] (throw "proxy-super: JVM proxies are not supported in Jolt"))
(defn construct-proxy [c & args] (throw "construct-proxy: not supported in Jolt"))
(defn get-proxy-class [& interfaces] (throw "get-proxy-class: not supported in Jolt"))