Refactor phase 2b: split core.janet into cluster modules behind a re-export aggregator
core.janet was a 3013-line grab-bag. Split into six order-preserving cluster modules: core_types vector helpers, predicates, math, comparison, equality core_coll collections, transducers, seqs, HOFs, constructors core_print string + pr-str/str rendering core_io I/O, files, JDBC, compare, type core_refs arrays, bit ops, coercions, hash, atoms/refs core_extra additional clojure.core fns, transients, hashing core.janet stays the module everyone imports: it loads the clusters in dependency order and re-exports each one's defs (import :prefix "" :export true), so every consumer keeps its single (use ./core) with no change. The aggregator also owns core-bindings and init-core!, which reference fns from every cluster. The split preserves definition order exactly (verified: no symbol is used in a cluster that loads before its definition), so seed load-order semantics are unchanged. Three private helpers used across clusters (map-entries-of, map-assoc1, str-render-one) are now public so `use` shares them; the five forward vars (canon-key/jolt-equal?/pr-render/core-compare/print-method-cb) each stay within their owning cluster. No behavior change. Gate green: conformance 355x3, clojure-test-suite 4718 pass (>= 4695 baseline), full jpm test exit 0.
This commit is contained in:
Yogthos
parent
c9f60d70c4
commit
0c324178d4
7 changed files with 2796 additions and 2699 deletions
2713
src/jolt/core.janet
2713
src/jolt/core.janet
File diff suppressed because it is too large
Load diff
1126
src/jolt/core_coll.janet
Normal file
1126
src/jolt/core_coll.janet
Normal file
File diff suppressed because it is too large
Load diff
449
src/jolt/core_extra.janet
Normal file
449
src/jolt/core_extra.janet
Normal file
|
|
@ -0,0 +1,449 @@
|
|||
# Jolt Core — additional clojure.core fns, transients, hashing
|
||||
# Extracted from core.janet (jolt-nma8, phase 2b split).
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
(use ./phs)
|
||||
(use ./lazyseq)
|
||||
(use ./regex)
|
||||
(use ./config)
|
||||
(use ./pv)
|
||||
(use ./plist)
|
||||
(use ./core_types)
|
||||
(use ./core_coll)
|
||||
(use ./core_print)
|
||||
(use ./core_io)
|
||||
(use ./core_refs)
|
||||
# Threading macros (as regular functions? No, as macros in Clojure)
|
||||
# These need to be defined as macros in the Jolt namespace system.
|
||||
# For now, skip — they need proper macro definition via the evaluator.
|
||||
# ============================================================
|
||||
|
||||
# ============================================================
|
||||
# Initialization — intern everything into a context's namespace
|
||||
# ============================================================
|
||||
|
||||
(def gensym_counter @{:val 0})
|
||||
|
||||
(defn gensym
|
||||
"Returns a new symbol with a unique name."
|
||||
[&opt prefix-string]
|
||||
(default prefix-string "G__")
|
||||
(def n (get gensym_counter :val))
|
||||
(put gensym_counter :val (+ n 1))
|
||||
{:jolt/type :symbol :ns nil :name (string prefix-string n)})
|
||||
|
||||
|
||||
# if-let/when-let/if-some/when-some now live in the Clojure overlay
|
||||
# (core/30-macros.clj) as defmacros.
|
||||
|
||||
(defn core-push-thread-bindings [b] (push-thread-bindings b))
|
||||
(defn core-pop-thread-bindings [] (pop-thread-bindings))
|
||||
|
||||
(defn core-var-get [v] (var-get v))
|
||||
(defn core-var-set [v val] (var-set v val))
|
||||
(defn core-var? [x] (var? x))
|
||||
(defn core-alter-var-root [v f & args] (apply alter-var-root v f args))
|
||||
(defn core-alter-meta! [v f & args] (apply alter-meta! v f args))
|
||||
(defn core-reset-meta! [v meta] (reset-meta! v meta))
|
||||
|
||||
# intern is a ctx-capturing clojure.core fn now (install-stateful-fns!).
|
||||
|
||||
# get-method/methods/remove-method/remove-all-methods/prefer-method are
|
||||
# overlay macros (core/30-macros.clj) over the evaluator's *-setup fns.
|
||||
|
||||
(defn core-with-meta [obj meta]
|
||||
# Functions and scalars can't carry metadata in Jolt's model — return as-is
|
||||
# rather than crashing (Clojure attaches meta only to IObj values).
|
||||
(if (or (function? obj) (cfunction? obj) (number? obj) (boolean? obj)
|
||||
(nil? obj) (string? obj) (keyword? obj) (buffer? obj))
|
||||
obj
|
||||
(do
|
||||
(var new-obj @{})
|
||||
(each k (keys obj)
|
||||
(put new-obj k (get obj k)))
|
||||
# table/setproto requires a table, convert struct meta to table. meta may
|
||||
# be nil (Clojure allows (with-meta obj nil) to clear metadata).
|
||||
(var meta-tab @{})
|
||||
(when meta (each k (keys meta) (put meta-tab k (get meta k))))
|
||||
(table/setproto new-obj meta-tab)
|
||||
(put new-obj :jolt/meta meta)
|
||||
new-obj)))
|
||||
|
||||
(defn core-var-dynamic? [v]
|
||||
(var-dynamic? v))
|
||||
|
||||
# Java interop stubs
|
||||
(def core-Object (fn [] (struct ;[:jolt/type :jolt/java-object])))
|
||||
|
||||
# Volatiles — typed box so deref/volatile? can recognize them.
|
||||
(defn core-volatile! [v] @{:jolt/type :jolt/volatile :val v})
|
||||
# volatile? / vreset! / vswap! now live in the Clojure collection tier — vreset!
|
||||
# over jolt.host/ref-put!, vswap! over vreset! + get. The constructor stays native.
|
||||
|
||||
# Delays — created lazily by the `delay` macro; forced once via force/deref.
|
||||
(defn core-make-delay [thunk] @{:jolt/type :jolt/delay :fn thunk :realized false :val nil})
|
||||
(defn core-delay? [x] (and (table? x) (= :jolt/delay (x :jolt/type))))
|
||||
# Proxy stub — returns nil form (macro, args not evaluated)
|
||||
# Thread stubs
|
||||
(def core-Thread (fn [& args] (struct ;[:jolt/type :jolt/thread])))
|
||||
(def core-ThreadLocal (fn [& args] (struct ;[:jolt/type :jolt/thread-local])))
|
||||
(def core-IllegalStateException (fn [& args] (struct ;[:jolt/type :jolt/exception])))
|
||||
|
||||
|
||||
|
||||
# letfn — mutually-recursive local fns. Expands to let* of fn* bindings; jolt
|
||||
# closures capture the (shared, mutable) bindings table, so forward references
|
||||
# between the fns resolve at call time.
|
||||
|
||||
# doseq — like `for` but eager and returns nil. Reuse `for`, force realization
|
||||
# with `count`, discard the result.
|
||||
# assert — (assert x) / (assert x message). Throws when x is falsy.
|
||||
|
||||
# ns-name now lives in the Clojure collection tier (pure over get + symbol).
|
||||
|
||||
# update lives in the Clojure kernel tier — core/00-kernel.clj. update-in stays
|
||||
# (it's recursive and has internal callers).
|
||||
(defn- ks-rest [ks]
|
||||
(if (tuple? ks) (tuple/slice ks 1) (array/slice ks 1)))
|
||||
|
||||
# assoc-in / update-in now live in the Clojure collection tier (canonical
|
||||
# recursive ports).
|
||||
|
||||
|
||||
|
||||
# fnil now lives in the Clojure collection tier (core/20-coll.clj), with
|
||||
# Clojure's canonical 2/3/4-arity (patch the first 1-3 args only).
|
||||
|
||||
# copy-var stubs for sci.impl.copy-vars (used by sci.impl.namespaces)
|
||||
(defn core-copy-core-var [sym] nil)
|
||||
(defn core-copy-var [sym & args] nil)
|
||||
(defn core-macrofy [sym fn & more] fn)
|
||||
(defn core-new-var [sym & args] nil)
|
||||
# A free-standing var cell (not interned anywhere): with-local-vars binds
|
||||
# these as locals; var-get/var-set work on any cell.
|
||||
(defn core-local-var [&opt val]
|
||||
@{:jolt/type :jolt/var :name "local" :ns nil :root val :gen 0})
|
||||
# with-open's close seam: a map-like value closes via its :close fn, a host
|
||||
# file via file/close. No .close interop on the Janet host.
|
||||
(defn core-close-resource [x]
|
||||
(cond
|
||||
(and (or (table? x) (struct? x)) (function? (get x :close))) ((get x :close))
|
||||
(= :core/file (type x)) (file/close x)
|
||||
(error (string "with-open: don't know how to close " (type x)))))
|
||||
# sci stub: pass the registry map through (it was @{} — a raw host table that
|
||||
# strict map-conj rightly rejects; identity also keeps sci's registry intact).
|
||||
(defn core-avoid-method-too-large [& args] (if (> (length args) 0) (in args 0) {}))
|
||||
|
||||
# declare macro — accepts symbols, does nothing (forward declaration)
|
||||
|
||||
# Build a protocol value (a self-evaluating tagged table). Exposed so the overlay
|
||||
# `defprotocol` can construct one via a fn call rather than embedding a tagged
|
||||
# struct literal (which the interpreter would try to re-evaluate). `methods` is a
|
||||
# {kw {:name str}} map; only :name is consulted (by satisfies?).
|
||||
(defn core-make-protocol [name-str methods]
|
||||
@{:jolt/type :jolt/protocol
|
||||
:name {:jolt/type :symbol :ns nil :name name-str}
|
||||
:methods methods})
|
||||
|
||||
# extends? is a real overlay fn now (30-macros, over extenders).
|
||||
(def core-implements? (fn [& args] false))
|
||||
|
||||
# ============================================================
|
||||
# Additional clojure.core functions (conformance batch)
|
||||
# ============================================================
|
||||
|
||||
(defn core-keyword
|
||||
"(keyword name) or (keyword ns name). Namespaced keywords are `:ns/name`.
|
||||
(keyword nil) is nil; the 2-arg form requires string args (nil ns allowed)."
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 (let [a (in args 0)]
|
||||
(cond
|
||||
(nil? a) nil
|
||||
(keyword? a) a
|
||||
(or (string? a) (core-symbol? a)) (keyword (core-name a))
|
||||
(error (string "keyword requires a string, symbol or keyword, got " (type a)))))
|
||||
2 (let [ns (in args 0) nm (in args 1)]
|
||||
(when (not (and (or (nil? ns) (string? ns)) (string? nm)))
|
||||
(error "keyword ns and name must be strings"))
|
||||
(keyword (if ns (string ns "/" nm) nm)))
|
||||
(keyword ;args)))
|
||||
|
||||
(defn core-symbol
|
||||
"(symbol name) or (symbol ns name) -> a jolt symbol struct. name/ns must be
|
||||
strings (a single symbol arg is returned as-is)."
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 (let [a (in args 0)]
|
||||
(cond
|
||||
(core-symbol? a) a
|
||||
(or (string? a) (keyword? a)) {:jolt/type :symbol :ns nil :name (core-name a)}
|
||||
(error (string "symbol requires a string or symbol, got " (type a)))))
|
||||
2 (let [ns (in args 0) nm (in args 1)]
|
||||
(when (not (and (or (nil? ns) (string? ns)) (string? nm)))
|
||||
(error "symbol ns and name must be strings"))
|
||||
{:jolt/type :symbol :ns ns :name nm})
|
||||
(error "symbol expects 1 or 2 args")))
|
||||
|
||||
# (take-nth's transducer arity lives in the overlay now.)
|
||||
|
||||
|
||||
# filterv now lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# mapv lives in the Clojure kernel tier — core/00-kernel.clj.
|
||||
|
||||
# (interpose's transducer arity lives in the overlay now.)
|
||||
# interpose / take-nth now live in the Clojure lazy tier (core/40-lazy.clj),
|
||||
# with the canonical transducer arities.
|
||||
|
||||
# keep now lives in the Clojure lazy tier (core/40-lazy.clj).
|
||||
|
||||
# empty now lives in the Clojure collection tier (core/20-coll.clj); a lazy
|
||||
# seq empties to () there (this fn returned a host table for it).
|
||||
|
||||
# not-empty now lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# rseq is defined only on vectors and sorted collections (Reversible).
|
||||
(defn core-rseq [coll]
|
||||
(cond
|
||||
(pvec? coll) (tuple/slice (tuple ;(reverse (pv->array coll))))
|
||||
(core-sorted? coll) ((sorted-op coll :rseq) coll)
|
||||
(error (string "rseq requires a vector or sorted collection, got " (type coll)))))
|
||||
|
||||
|
||||
|
||||
# some-fn now lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# Associative = maps and (real) vectors only. pvec is a literal/built vector;
|
||||
# tuples and lists are seq results, not associative.
|
||||
# ifn? now lives in the Clojure collection tier — canonical IFn set (fns,
|
||||
# keywords, symbols, maps, sets, vectors, vars); lists are NOT IFn.
|
||||
# With a single item, Clojure returns it WITHOUT calling f. On ties, the last
|
||||
# extremal item wins (>=/<= update), matching Clojure.
|
||||
# Clojure's min-key/max-key: the 2-arg base compares with strict < / > (so the
|
||||
# second wins on ties/NaN), and each further item switches on <= / >=. This
|
||||
# asymmetry reproduces the JVM's NaN-ordering behavior. Janet's < / > are used
|
||||
# directly (NaN comparisons are false, never throwing).
|
||||
# keys must be numbers (NaN allowed) — like Clojure, which compares them with </>.
|
||||
# min-key / max-key now live in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# vary-meta / namespace-munge now live in the Clojure collection tier
|
||||
# (core/20-coll.clj) — pure compositions of meta/with-meta and str/map.
|
||||
|
||||
# Exceptions (ex-info / ex-data / ex-message)
|
||||
(defn core-ex-info [msg data & more]
|
||||
@{:jolt/type :jolt/ex-info :message msg :data data
|
||||
:cause (if (> (length more) 0) (in more 0) nil)})
|
||||
# ex-data / ex-message / ex-cause now live in the Clojure collection tier
|
||||
# (core/20-coll.clj) — pure over get on the tagged value the constructor builds.
|
||||
|
||||
# String split/replace that accept either a literal string or a regex value.
|
||||
(defn core-str-split [pat s]
|
||||
(if (regex? pat)
|
||||
(re-split pat s)
|
||||
(string/split pat s)))
|
||||
(defn core-str-replace-all [pat repl s]
|
||||
(if (regex? pat)
|
||||
(re-replace-all pat s repl)
|
||||
(string/replace-all pat repl s)))
|
||||
(defn core-str-replace-first [pat repl s]
|
||||
(if (regex? pat)
|
||||
(re-replace-first pat s repl)
|
||||
(string/replace pat repl s)))
|
||||
|
||||
# Iterator/enumeration seqs — Jolt has no Java iterators, so adapt to plain seq.
|
||||
# enumeration-seq / iterator-seq live in the Clojure collection tier.
|
||||
# xml-seq now lives in the Clojure collection tier (core/20-coll.clj).
|
||||
# line-seq now lives in the Clojure IO tier (core/50-io.clj), over the reader
|
||||
# protocol of the *in* family.
|
||||
(defn core-re-matcher [re s] @{:jolt/type :jolt/matcher :re re :s s :pos 0})
|
||||
|
||||
# bean / print-method / print-dup / the proxy surface live in the Clojure
|
||||
# collection tier (JVM-shape stubs; print hooks inert until jolt-g1r).
|
||||
# == lives in the Clojure collection tier (core/20-coll.clj); memfn is an
|
||||
# overlay macro (core/30-macros.clj) over the .method call sugar.
|
||||
# eduction / ->Eduction live in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
(def- char-escapes
|
||||
{10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b" 34 "\\\"" 92 "\\\\"})
|
||||
(def- char-names
|
||||
{10 "newline" 9 "tab" 13 "return" 12 "formfeed" 8 "backspace" 32 "space"})
|
||||
# char-escape-string / char-name-string now live in the Clojure collection
|
||||
# tier as char-keyed maps. The CODE-keyed tables below stay: pr-render uses them.
|
||||
|
||||
|
||||
# subseq / rsubseq over sorted collections
|
||||
# subseq / rsubseq now live in the Clojure sorted tier (core/25-sorted.clj),
|
||||
# along with the constructors and all sorted-coll semantics.
|
||||
|
||||
# ============================================================
|
||||
# Additional clojure.core functions
|
||||
# ============================================================
|
||||
|
||||
# Integer-valued: a finite number equal to its floor. Infinity floors to itself
|
||||
# but is NOT integer-valued (so float?/double? are true for ##Inf, and int?/
|
||||
# pos-int?/… are false), and NaN is excluded by the equality check.
|
||||
(defn- intval? [x] (and (number? x) (< (math/abs x) math/inf) (= x (math/floor x))))
|
||||
|
||||
# Forcing lazy seqs
|
||||
# Map entries (represented as 2-element vectors)
|
||||
# key/val require a map entry (a 2-element vector/tuple in Jolt); Clojure throws
|
||||
# otherwise. (Jolt can't distinguish a 2-vector from a real MapEntry.)
|
||||
# A map entry is a 2-element tuple — Jolt produces tuples only from map
|
||||
# iteration (first/seq/map over a map), while vector literals are pvecs and
|
||||
# lists are arrays. So key/val/map-entry? accept a 2-tuple and reject a plain
|
||||
# vector, matching Clojure (where a MapEntry is distinct from a vector).
|
||||
(defn- entry-like? [x] (and (tuple? x) (= 2 (length x))))
|
||||
# key / val now live in the Clojure collection tier (core/20-coll.clj),
|
||||
# along with find (previously missing from jolt entirely).
|
||||
(defn core-map-entry? [x] (entry-like? x))
|
||||
|
||||
# Reversible (supports rseq) = vectors and sorted collections.
|
||||
# Numeric predicates (Jolt has no ratios/bigdec). nat-int?/pos-int?/neg-int?/
|
||||
# ratio?/decimal?/rational? live in the Clojure collection tier (core/20-coll.clj).
|
||||
# Jolt has no ratio type, so numerator/denominator have no valid input (Clojure
|
||||
# requires a Ratio and throws otherwise).
|
||||
# numerator / denominator now live in the Clojure collection tier (Jolt has
|
||||
# no ratios; they throw, as on a non-ratio in Clojure).
|
||||
|
||||
# special-symbol? lives in the Clojure collection tier (a quoted symbol set).
|
||||
|
||||
# record? now lives in the Clojure collection tier (tagged-value predicate).
|
||||
|
||||
# Promise: single-threaded box backed by an atom (deref returns nil until set).
|
||||
# promise / deliver live in the Clojure collection tier (an atom; deref of an
|
||||
# undelivered promise is nil — single-threaded host, no blocking).
|
||||
|
||||
(defn core-tagged-literal [tag form] @{:jolt/type :jolt/tagged-literal :tag tag :form form})
|
||||
# ensure-reduced / halt-when live in the Clojure collection tier
|
||||
# (core/20-coll.clj) — halt-when is the canonical ::halt-map version there.
|
||||
(defn core-re-groups [m] (error "re-groups: stateful matchers are not supported in Jolt"))
|
||||
|
||||
# Transients — real mutable scratch collections backed by Janet's native arrays
|
||||
# and tables (host interop): O(1) conj!/assoc!/dissoc!/disj!/pop!, frozen back to
|
||||
# a persistent value by persistent!. A transient is a tagged table holding either
|
||||
# a Janet array (vectors) or a Janet table keyed by canonical key (maps/sets, so
|
||||
# collection keys still compare by value). The mutating ops return the transient.
|
||||
(defn core-transient [coll]
|
||||
(cond
|
||||
(pvec? coll)
|
||||
@{:jolt/type :jolt/transient :kind :vector :arr (pv->array coll)}
|
||||
(set? coll)
|
||||
(let [t @{}] (each e (phs-seq coll) (put t (canon-key e) e))
|
||||
@{:jolt/type :jolt/transient :kind :set :tbl t})
|
||||
(or (phm? coll) (and (struct? coll) (nil? (get coll :jolt/type))))
|
||||
(let [t @{}]
|
||||
(each pair (realize-for-iteration coll)
|
||||
(put t (canon-key (in pair 0)) @[(in pair 0) (in pair 1)]))
|
||||
@{:jolt/type :jolt/transient :kind :map :tbl t})
|
||||
# mutable-build arrays (vectors/lists) — copy into a transient vector
|
||||
(array? coll) @{:jolt/type :jolt/transient :kind :vector :arr (array/slice coll)}
|
||||
# tuples (reader vectors / map entries) are vectors too
|
||||
(tuple? coll) @{:jolt/type :jolt/transient :kind :vector :arr (array ;coll)}
|
||||
(error (string "Don't know how to create a transient from " (type coll)))))
|
||||
|
||||
# A transient is invalidated by persistent!; using it afterwards is a bug.
|
||||
(defn- tr-check-active! [t]
|
||||
(when (get t :jolt/persistent)
|
||||
(error "Transient used after persistent! call")))
|
||||
|
||||
(defn- tr-conj! [t x]
|
||||
(tr-check-active! t)
|
||||
(case (t :kind)
|
||||
:vector (array/push (t :arr) x)
|
||||
:set (put (t :tbl) (canon-key x) x)
|
||||
:map (cond
|
||||
# a [k v] pair (map-entry / 2-vector)
|
||||
(and (or (pvec? x) (tuple? x) (array? x))
|
||||
(= 2 (if (pvec? x) (pv-count x) (length x))))
|
||||
(put (t :tbl) (canon-key (vnth x 0)) @[(vnth x 0) (vnth x 1)])
|
||||
# a map: merge all its entries
|
||||
(or (phm? x) (and (struct? x) (nil? (get x :jolt/type))))
|
||||
(each e (map-entries-of x)
|
||||
(put (t :tbl) (canon-key (in e 0)) @[(in e 0) (in e 1)]))
|
||||
(error "conj! on a transient map requires a [key value] pair or a map")))
|
||||
t)
|
||||
|
||||
(defn- tr-assoc! [t k v]
|
||||
(tr-check-active! t)
|
||||
(case (t :kind)
|
||||
:vector (let [a (t :arr)]
|
||||
(when (not (and (number? k) (= k (math/floor k)) (>= k 0) (<= k (length a))))
|
||||
(error (string "Index " k " out of bounds for assoc! on a transient vector of length " (length a))))
|
||||
(if (= k (length a)) (array/push a v) (put a k v)))
|
||||
:map (put (t :tbl) (canon-key k) @[k v])
|
||||
(error "assoc! expects a transient vector or map"))
|
||||
t)
|
||||
|
||||
# The bang ops require a transient (Clojure throws otherwise); no lenient
|
||||
# fallback to the persistent op.
|
||||
(defn core-conj! [& args]
|
||||
(cond
|
||||
(= 0 (length args)) (core-transient (make-vec @[])) # (conj!) -> (transient [])
|
||||
(= 1 (length args)) (first args) # (conj! coll) -> coll, as-is
|
||||
(let [t (first args) xs (tuple/slice args 1)]
|
||||
(if (core-transient? t)
|
||||
(do (each x xs (tr-conj! t x)) t)
|
||||
(error "conj! requires a transient")))))
|
||||
|
||||
(defn core-assoc! [t & kvs]
|
||||
# Unlike assoc, assoc! accepts an ODD number of args — a missing final value
|
||||
# is taken as nil (so (get kvs (+ i 1)) rather than (in ...), which would
|
||||
# error on the dangling key).
|
||||
(if (core-transient? t)
|
||||
(do (var i 0) (while (< i (length kvs)) (tr-assoc! t (in kvs i) (get kvs (+ i 1))) (+= i 2)) t)
|
||||
(error "assoc! requires a transient")))
|
||||
|
||||
(defn core-dissoc! [t & ks]
|
||||
(if (and (core-transient? t) (= :map (t :kind)))
|
||||
(do (tr-check-active! t) (each k ks (put (t :tbl) (canon-key k) nil)) t)
|
||||
(error "dissoc! requires a transient map")))
|
||||
|
||||
(defn core-disj! [t & xs]
|
||||
(if (and (core-transient? t) (= :set (t :kind)))
|
||||
(do (tr-check-active! t) (each x xs (put (t :tbl) (canon-key x) nil)) t)
|
||||
(error "disj! requires a transient set")))
|
||||
|
||||
(defn core-pop! [t]
|
||||
(if (and (core-transient? t) (= :vector (t :kind)))
|
||||
(do (tr-check-active! t)
|
||||
(when (= 0 (length (t :arr))) (error "Can't pop empty vector"))
|
||||
(array/pop (t :arr)) t)
|
||||
(error "pop! requires a transient vector")))
|
||||
|
||||
(defn core-persistent! [t]
|
||||
(if (core-transient? t)
|
||||
(do
|
||||
(tr-check-active! t)
|
||||
(def result
|
||||
(case (t :kind)
|
||||
:vector (make-vec (t :arr))
|
||||
:set (do (var s (make-phs)) (each [_ e] (pairs (t :tbl)) (set s (phs-conj s e))) s)
|
||||
:map (do (var m (make-phm)) (each [_ pair] (pairs (t :tbl)) (set m (phm-assoc m (in pair 0) (in pair 1)))) m)))
|
||||
# Invalidate: any further bang op (or a second persistent!) now throws.
|
||||
(put t :jolt/persistent true)
|
||||
result)
|
||||
(error "persistent! requires a transient")))
|
||||
|
||||
# Unchecked arithmetic — Jolt numbers don't overflow, so these are plain ops.
|
||||
# unchecked-* arithmetic lives in the Clojure collection tier
|
||||
# (core/20-coll.clj); only the masking byte/short/char coercions remain above.
|
||||
|
||||
# Hashing helpers
|
||||
# Hashes are masked to 24 bits at each step so intermediate products stay within
|
||||
# Janet's integer range (a float here would make band error).
|
||||
(defn- h24 [x] (band (hash x) 0xffffff))
|
||||
(defn core-hash-combine [a b] (band (bxor (h24 a) (+ (h24 b) 0x9e3779)) 0xffffff))
|
||||
(defn core-hash-ordered-coll [coll]
|
||||
(var h 1) (each x (realize-for-iteration coll) (set h (band (+ (* 31 h) (h24 x)) 0xffffff))) h)
|
||||
(defn core-hash-unordered-coll [coll]
|
||||
(var h 0) (each x (realize-for-iteration coll) (set h (band (+ h (h24 x)) 0xffffff))) h)
|
||||
|
||||
# prefers is a macro over prefers-setup now (the store lives on the VAR).
|
||||
|
||||
|
||||
|
||||
# parse-uuid lives in the Clojure collection tier (core/20-coll.clj) over
|
||||
# re-matches + the __make-uuid host constructor (types.janet).
|
||||
|
||||
233
src/jolt/core_io.janet
Normal file
233
src/jolt/core_io.janet
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
# Jolt Core — I/O, files, JDBC, compare, type
|
||||
# Extracted from core.janet (jolt-nma8, phase 2b split).
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
(use ./phs)
|
||||
(use ./lazyseq)
|
||||
(use ./regex)
|
||||
(use ./config)
|
||||
(use ./pv)
|
||||
(use ./plist)
|
||||
(use ./core_types)
|
||||
(use ./core_coll)
|
||||
(use ./core_print)
|
||||
# I/O — minimal wrappers
|
||||
# ============================================================
|
||||
|
||||
# print/println use str semantics (bare strings); pr/prn use readable (quoted).
|
||||
# All space-separate their args, like Clojure.
|
||||
# print/println live in the Clojure collection tier (core/20-coll.clj) over
|
||||
# the __write / __pr-str1 host seams; str-render-one stays for core-str.
|
||||
(defn core-write [s] (prin s) nil)
|
||||
|
||||
(defn core-eprint [s] (eprint s) nil)
|
||||
(defn core-eprintf [fmt & args] (eprintf fmt ;args) nil)
|
||||
|
||||
# next.jdbc host shims (the db library's next.jdbc compat layer builds on these).
|
||||
# A connection is a tagged table wrapping a jdbc.core conn (:raw) plus clj
|
||||
# callbacks: :exec runs one SQL string in the transaction (so the janet-side
|
||||
# Statement.executeBatch can run SQL without a janet->clj call), :close closes
|
||||
# the underlying conn, :product is the JDBC database product name. instance?
|
||||
# Connection (evaluator) and the :jolt/jdbc-conn tagged methods (host_interop) key
|
||||
# off this shape.
|
||||
(defn core-jdbc-wrap-conn [raw exec closef product]
|
||||
@{:jolt/type :jolt/jdbc-conn :raw raw :exec exec :close closef
|
||||
:product product :closed @[false]})
|
||||
# Robust unwrap: a wrapped conn -> its :raw; anything else passes through (so the
|
||||
# next.jdbc fns accept either a wrapped conn or a bare jdbc.core conn/spec).
|
||||
(defn core-jdbc-conn-raw [x]
|
||||
(if (and (table? x) (= :jolt/jdbc-conn (get x :jolt/type))) (get x :raw) x))
|
||||
(defn core-jdbc-make-stmt [w]
|
||||
# :close lets with-open close the statement (core-close-resource calls :close);
|
||||
# nothing to release — executeBatch already ran the commands.
|
||||
@{:jolt/type :jolt/jdbc-stmt :exec (get w :exec) :cmds @[] :close (fn [] nil)})
|
||||
|
||||
# java.io.File model (jolt-hjw). io/file and (File. …) build a tagged :jolt/file
|
||||
# value so (instance? File x) works and migratus's File-vs-jar branching takes
|
||||
# the filesystem path. The File method surface + nio glob live in host_interop; here
|
||||
# are the constructor/predicate builtins and the path coercion str/slurp use.
|
||||
(defn core-file-path
|
||||
"The path string of a :jolt/file, or (string x) for anything else."
|
||||
[x]
|
||||
(if (and (table? x) (= :jolt/file (get x :jolt/type))) (get x :path) (string x)))
|
||||
(defn core-make-file [path &opt child]
|
||||
(def base (core-file-path path))
|
||||
@{:jolt/type :jolt/file :path (if child (string base "/" (core-file-path child)) base)})
|
||||
(defn core-file? [x] (and (table? x) (= :jolt/file (get x :jolt/type))))
|
||||
|
||||
# newline lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# Clojure 1.11 string->scalar parsers: nil on malformed input, throw on a
|
||||
# non-string. Validation is strict (scan-number alone accepts 0x10 etc.).
|
||||
(defn- parse-arg-str [s who]
|
||||
(if (or (string? s) (buffer? s)) (string s)
|
||||
(error (string who " requires a string, got " (type s)))))
|
||||
|
||||
(defn core-parse-long [s]
|
||||
(def str* (parse-arg-str s "parse-long"))
|
||||
(def n (length str*))
|
||||
(def start (if (and (> n 0) (or (= 43 (in str* 0)) (= 45 (in str* 0)))) 1 0))
|
||||
(if (and (> n start)
|
||||
(do (var ok true)
|
||||
(for i start n (when (or (< (in str* i) 48) (> (in str* i) 57)) (set ok false)))
|
||||
ok))
|
||||
(scan-number str*)
|
||||
nil))
|
||||
|
||||
(defn core-parse-double [s]
|
||||
(def str* (parse-arg-str s "parse-double"))
|
||||
# strict float shape: [+-] digits [. digits] [eE [+-] digits] — at least one
|
||||
# digit overall; "Infinity"/"-Infinity"/"NaN" accepted like the reference.
|
||||
(cond
|
||||
(= str* "Infinity") math/inf
|
||||
(= str* "-Infinity") (- math/inf)
|
||||
(= str* "NaN") math/nan
|
||||
(do
|
||||
(def pat (peg/compile ~(sequence (opt (set "+-")) (choice (sequence (some :d) (opt (sequence "." (any :d)))) (sequence "." (some :d))) (opt (sequence (set "eE") (opt (set "+-")) (some :d))) -1)))
|
||||
(if (peg/match pat str*) (scan-number str*) nil))))
|
||||
|
||||
# parse-boolean lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# Host time source for the `time` macro (monotonic, milliseconds).
|
||||
(defn core-current-time-ms [] (* 1000 (os/clock :monotonic)))
|
||||
|
||||
# Host IO (host-classified in the spec): path-based slurp/spit, *out* flush.
|
||||
# Opts (:encoding ...) are accepted and ignored — everything is UTF-8 here.
|
||||
# Reader shims (java.io.StringReader / PushbackReader / anything carrying
|
||||
# :s + :pos) DRAIN instead of opening a file: Ring middleware slurps request
|
||||
# bodies, and the jolt Ring adapter hands those over as StringReaders.
|
||||
(defn core-slurp [src & opts]
|
||||
(cond
|
||||
(core-file? src) (string (slurp (core-file-path src)))
|
||||
(and (table? src) (string? (get src :s)) (number? (get src :pos)))
|
||||
(let [s (src :s) p (src :pos)]
|
||||
(put src :pos (length s))
|
||||
(string/slice s p))
|
||||
(string (slurp src))))
|
||||
|
||||
(defn core-spit [path content & opts]
|
||||
(def append? (do (var a false) (var i 0)
|
||||
(while (< i (length opts))
|
||||
(when (and (= :append (in opts i)) (in opts (+ i 1))) (set a true))
|
||||
(+= i 2))
|
||||
a))
|
||||
(def f (file/open (core-file-path path) (if append? :a :w)))
|
||||
(file/write f (str-render-one content))
|
||||
(file/close f)
|
||||
nil)
|
||||
|
||||
(defn core-flush []
|
||||
(def out (dyn :out))
|
||||
(when out (file/flush out))
|
||||
nil)
|
||||
|
||||
# Thread-binding introspection over the frame stack (types/cur-binding-stack).
|
||||
(defn core-get-thread-bindings []
|
||||
# Innermost frame wins: merge frames oldest-first. The result is a Janet
|
||||
# STRUCT keyed by the var tables themselves — the exact frame representation
|
||||
# var-get reads (identity-keyed get) — so the map can be re-pushed by
|
||||
# with-bindings*/bound-fn* and remains lookup-able with (get m the-var).
|
||||
(def acc @{})
|
||||
(each frame (snapshot-bindings)
|
||||
(each entry (realize-for-iteration frame)
|
||||
(put acc (in entry 0) (in entry 1))))
|
||||
(table/to-struct acc))
|
||||
|
||||
(defn core-thread-bound?* [v]
|
||||
(var found false)
|
||||
(each frame (snapshot-bindings)
|
||||
(each entry (realize-for-iteration frame)
|
||||
(when (= (in entry 0) v) (set found true))))
|
||||
found)
|
||||
|
||||
# Directory primitives for file-seq (paths, not File objects — host-classified).
|
||||
(defn core-dir? [path]
|
||||
(def st (os/stat path))
|
||||
(and st (= :directory (st :mode))))
|
||||
|
||||
(defn core-list-dir [path]
|
||||
(def entries (os/dir path))
|
||||
(map (fn [e] (string path "/" e)) (sort entries)))
|
||||
|
||||
# Clojure compare: a total order over comparable values. nil sorts first;
|
||||
# numbers numerically; strings/keywords lexically; symbols by ns then name;
|
||||
# booleans false<true; chars by codepoint; vectors by length then elementwise;
|
||||
# uuids by canonical string; insts by epoch ms. Cross-type comparison throws
|
||||
# (like Clojure's ClassCastException).
|
||||
(var core-compare nil)
|
||||
(set core-compare (fn ccompare [a b]
|
||||
(defn cmp3 [x y] (cond (< x y) -1 (> x y) 1 0))
|
||||
(cond
|
||||
(and (nil? a) (nil? b)) 0
|
||||
(nil? a) -1
|
||||
(nil? b) 1
|
||||
(and (number? a) (number? b)) (cmp3 a b)
|
||||
(and (or (string? a) (buffer? a)) (or (string? b) (buffer? b)))
|
||||
(cmp3 (string a) (string b))
|
||||
(and (keyword? a) (keyword? b)) (cmp3 (string a) (string b))
|
||||
(and (core-symbol? a) (core-symbol? b))
|
||||
(let [r (cmp3 (string (or (a :ns) "")) (string (or (b :ns) "")))]
|
||||
(if (= 0 r) (cmp3 (a :name) (b :name)) r))
|
||||
(and (boolean? a) (boolean? b))
|
||||
(cond (= a b) 0 (= a false) -1 1)
|
||||
(and (core-char? a) (core-char? b)) (cmp3 (a :ch) (b :ch))
|
||||
(and (struct? a) (= :jolt/uuid (get a :jolt/type))
|
||||
(struct? b) (= :jolt/uuid (get b :jolt/type)))
|
||||
(cmp3 (a :str) (b :str))
|
||||
(and (struct? a) (= :jolt/inst (get a :jolt/type))
|
||||
(struct? b) (= :jolt/inst (get b :jolt/type)))
|
||||
(cmp3 (a :ms) (b :ms))
|
||||
(and (jvec? a) (jvec? b))
|
||||
(let [la (vcount a) lb (vcount b)]
|
||||
(if (not= la lb)
|
||||
(cmp3 la lb)
|
||||
(do
|
||||
(var r 0) (var i 0)
|
||||
(while (and (= r 0) (< i la))
|
||||
(set r (ccompare (vnth a i) (vnth b i)))
|
||||
(++ i))
|
||||
r)))
|
||||
(error (string "Cannot compare " (type a) " with " (type b))))))
|
||||
|
||||
# Clojure type: the :type metadata when present, else the value's type. With no
|
||||
# class objects on this host, the "class" is a symbol: a deftype/record value
|
||||
# yields its type tag symbol; everything else a taxonomy keyword
|
||||
# (host-classified — see spec coverage).
|
||||
(defn core-type [x]
|
||||
(def m (core-meta x))
|
||||
(def override (and m (core-get m :type)))
|
||||
(if (not (nil? override))
|
||||
override
|
||||
(cond
|
||||
(and (table? x) (get x :jolt/deftype))
|
||||
{:jolt/type :symbol :ns nil :name (get x :jolt/deftype)}
|
||||
(nil? x) nil
|
||||
(boolean? x) :boolean
|
||||
(number? x) :number
|
||||
(or (string? x) (buffer? x)) :string
|
||||
(keyword? x) :keyword
|
||||
(core-symbol? x) :symbol
|
||||
(core-char? x) :char
|
||||
(and (struct? x) (get x :jolt/type)) (get x :jolt/type)
|
||||
(jvec? x) :vector
|
||||
(core-map? x) :map
|
||||
(set? x) :set
|
||||
(core-seq? x) :seq
|
||||
(or (function? x) (cfunction? x)) :fn
|
||||
(table? x) (or (get x :jolt/type) :table)
|
||||
:else (keyword (type x)))))
|
||||
|
||||
# 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))
|
||||
|
||||
# pr/prn/pr-str live in the Clojure collection tier (core/20-coll.clj); the
|
||||
# renderer itself stays host (representation-coupled, shared with hot str).
|
||||
(defn core-pr-str1 [x] (let [b @""] (pr-render b x) (string b)))
|
||||
|
||||
# ============================================================
|
||||
236
src/jolt/core_print.janet
Normal file
236
src/jolt/core_print.janet
Normal file
|
|
@ -0,0 +1,236 @@
|
|||
# Jolt Core — string + print rendering (pr-str/str)
|
||||
# Extracted from core.janet (jolt-nma8, phase 2b split).
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
(use ./phs)
|
||||
(use ./lazyseq)
|
||||
(use ./regex)
|
||||
(use ./config)
|
||||
(use ./pv)
|
||||
(use ./plist)
|
||||
(use ./core_types)
|
||||
(use ./core_coll)
|
||||
# String functions
|
||||
# ============================================================
|
||||
|
||||
# Readable rendering of a value (Clojure pr semantics): strings quoted,
|
||||
# keywords with leading ':', symbols by name, collections with their reader
|
||||
# syntax. Used by both pr-str (readable) and str (collection elements).
|
||||
# A namespace's :name may be a string or a symbol struct depending on the
|
||||
# creation path — normalize for display.
|
||||
(defn- ns-display-name [ns]
|
||||
(def n (ns :name))
|
||||
(if (and (struct? n) (= :symbol (get n :jolt/type))) (n :name) (string n)))
|
||||
|
||||
# print-method callback (jolt-g1r): set by api/init AFTER the overlay loads,
|
||||
# to a (fn [v emit] handled?) that looks for a USER-registered print-method
|
||||
# multimethod entry for v's dispatch value and renders through it (emit takes
|
||||
# string pieces). The renderer consults it only on the record/tagged
|
||||
# fallthrough, so built-in rendering pays nothing.
|
||||
(var print-method-cb nil)
|
||||
(defn set-print-method-cb! [f] (set print-method-cb f))
|
||||
|
||||
(def- pr-char-escapes
|
||||
{34 "\\\"" 92 "\\\\" 10 "\\n" 9 "\\t" 13 "\\r" 12 "\\f" 8 "\\b"})
|
||||
(var pr-render nil)
|
||||
|
||||
# Format a number the way Clojure prints it: infinity and NaN have named forms
|
||||
# (Janet renders them "inf"/"-inf"/"nan").
|
||||
(defn- fmt-number [v]
|
||||
(cond
|
||||
(not (number? v)) (string v)
|
||||
(= v math/inf) "Infinity"
|
||||
(= v (- math/inf)) "-Infinity"
|
||||
(not= v v) "NaN"
|
||||
(string v)))
|
||||
|
||||
(defn- pr-render-seq [buf items open close]
|
||||
(buffer/push-string buf open)
|
||||
(var first true)
|
||||
(each x items
|
||||
(if first (set first false) (buffer/push-string buf " "))
|
||||
(pr-render buf x))
|
||||
(buffer/push-string buf close))
|
||||
|
||||
(defn- pr-render-pairs [buf pairs]
|
||||
(buffer/push-string buf "{")
|
||||
(var first true)
|
||||
(each pair pairs
|
||||
(if first (set first false) (buffer/push-string buf ", "))
|
||||
(pr-render buf (in pair 0))
|
||||
(buffer/push-string buf " ")
|
||||
(pr-render buf (in pair 1)))
|
||||
(buffer/push-string buf "}"))
|
||||
|
||||
(defn- name-of
|
||||
"Extract a plain name string from a string, symbol struct, or a namespace/var
|
||||
table (reading its :name) — never recurses into the cyclic ns structure."
|
||||
[x]
|
||||
(cond
|
||||
(nil? x) nil
|
||||
(string? x) x
|
||||
(and (struct? x) (= :symbol (get x :jolt/type))) (x :name)
|
||||
(or (struct? x) (table? x)) (name-of (get x :name))
|
||||
(string x)))
|
||||
|
||||
(defn- var-display
|
||||
"Render a Jolt var as #'ns/name. A var's :meta/:ns refs are cyclic, so this
|
||||
reads only its :name and :ns name — printing the var's pairs would loop."
|
||||
[v]
|
||||
(let [nm (name-of (v :name))
|
||||
ns (name-of (v :ns))]
|
||||
(if ns (string "#'" ns "/" nm) (string "#'" nm))))
|
||||
|
||||
(defn- pr-push-escaped
|
||||
"Readable string body: escape per char-escapes (quote, backslash, \\n & co),
|
||||
so pr-str round-trips through the reader (this was unescaped, jolt pre-r6)."
|
||||
[buf s]
|
||||
(each c (string/bytes s)
|
||||
(if-let [esc (get pr-char-escapes c)]
|
||||
(buffer/push-string buf esc)
|
||||
(buffer/push-byte buf c))))
|
||||
|
||||
(set pr-render
|
||||
(fn [buf v]
|
||||
(cond
|
||||
(nil? v) (buffer/push-string buf "nil")
|
||||
(= true v) (buffer/push-string buf "true")
|
||||
(= false v) (buffer/push-string buf "false")
|
||||
(string? v) (do (buffer/push-string buf "\"") (pr-push-escaped buf v) (buffer/push-string buf "\""))
|
||||
(buffer? v) (do (buffer/push-string buf "\"") (pr-push-escaped buf (string v)) (buffer/push-string buf "\""))
|
||||
(keyword? v) (do (buffer/push-string buf ":") (buffer/push-string buf (string v)))
|
||||
(core-char? v) (do (buffer/push-string buf "\\")
|
||||
(buffer/push-string buf
|
||||
(case (v :ch)
|
||||
10 "newline" 32 "space" 9 "tab" 13 "return"
|
||||
12 "formfeed" 8 "backspace" 0 "nul"
|
||||
(char->string v))))
|
||||
(number? v) (buffer/push-string buf (fmt-number v))
|
||||
(and (struct? v) (= :symbol (v :jolt/type)))
|
||||
(buffer/push-string buf (if (v :ns) (string (v :ns) "/" (v :name)) (v :name)))
|
||||
(and (struct? v) (= :jolt/inst (v :jolt/type)))
|
||||
(do (buffer/push-string buf "#inst \"") (buffer/push-string buf (inst->rfc3339 v))
|
||||
(buffer/push-string buf "\""))
|
||||
(= :jolt/namespace (get v :jolt/type))
|
||||
(do (buffer/push-string buf "#namespace[")
|
||||
(buffer/push-string buf (ns-display-name v))
|
||||
(buffer/push-string buf "]"))
|
||||
(and (table? v) (= :jolt/var (get v :jolt/type))) (buffer/push-string buf (var-display v))
|
||||
(shape-rec? v)
|
||||
(let [rtag (record-tag v)
|
||||
pairs (map (fn [k] [k (shape-get v k nil)]) (shape-keys v))]
|
||||
(cond
|
||||
# a record shape-rec prints Clojure-style: #ns.Type{:k v, ...}
|
||||
(and rtag print-method-cb (print-method-cb v (fn [piece] (buffer/push-string buf piece)))) nil
|
||||
rtag (do (buffer/push-string buf (string "#" rtag))
|
||||
(pr-render-pairs buf pairs))
|
||||
(pr-render-pairs buf pairs)))
|
||||
(core-sorted-map? v) (pr-render-pairs buf
|
||||
(map (fn [e] [(vnth e 0) (vnth e 1)]) (sorted-entries-arr v)))
|
||||
(core-sorted-set? v) (pr-render-seq buf (sorted-entries-arr v) "#{" "}")
|
||||
(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) "[" "]")
|
||||
(plist? v) (pr-render-seq buf (pl->array v) "(" ")")
|
||||
(and (table? v) (get v :jolt/deftype))
|
||||
(if (and print-method-cb (print-method-cb v (fn [piece] (buffer/push-string buf piece))))
|
||||
nil
|
||||
# Clojure's record syntax: #ns.Type{:k v, ...} (fields only, the
|
||||
# deftype tag elided). This used to print the raw janet table.
|
||||
(do
|
||||
(buffer/push-string buf (string "#" (get v :jolt/deftype)))
|
||||
(pr-render-pairs buf
|
||||
(filter (fn [pair] (not= :jolt/deftype (in pair 0))) (pairs v)))))
|
||||
(tuple? 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 "(" ")"))
|
||||
# Any remaining TAGGED value dispatches through print-method when the
|
||||
# hook is wired: the io tier owns the cold renderings (uuid, regex,
|
||||
# transient, channel — branches that used to live here), and user
|
||||
# defmethods on any :jolt/* tag fire from inside nested values. Before
|
||||
# the overlay loads (init-time error messages) these fall through to
|
||||
# the raw pairs view below.
|
||||
(and print-method-cb (get v :jolt/type)
|
||||
(print-method-cb v (fn [piece] (buffer/push-string buf piece))))
|
||||
nil
|
||||
(struct? v) (pr-render-pairs buf (pairs v))
|
||||
(table? v) (pr-render-pairs buf (pairs v))
|
||||
true (buffer/push-string buf (string v)))))
|
||||
|
||||
(defn str-render-one
|
||||
"Render one value with Clojure's `str`/.toString semantics (bare strings,
|
||||
nil -> empty, keywords/symbols by name, collections via pr-render)."
|
||||
[v]
|
||||
(cond
|
||||
(nil? v) ""
|
||||
(string? v) v
|
||||
(buffer? v) (string v)
|
||||
(core-char? v) (char->string v)
|
||||
(keyword? v) (string ":" (string v))
|
||||
(and (struct? v) (= :symbol (v :jolt/type)))
|
||||
(if (v :ns) (string (v :ns) "/" (v :name)) (v :name))
|
||||
(and (struct? v) (= :jolt/uuid (v :jolt/type))) (v :str)
|
||||
(and (struct? v) (= :jolt/inst (v :jolt/type))) (inst->rfc3339 v)
|
||||
# a java.io.File renders as its path (Clojure's File.toString)
|
||||
(and (table? v) (= :jolt/file (get v :jolt/type))) (get v :path)
|
||||
(= :jolt/namespace (get v :jolt/type)) (ns-display-name v)
|
||||
(and (table? v) (= :jolt/var (get v :jolt/type))) (var-display v)
|
||||
(number? v) (fmt-number v)
|
||||
(= true v) "true"
|
||||
(= false v) "false"
|
||||
(let [buf @""] (pr-render buf v) (string buf))))
|
||||
|
||||
(defn core-str [& xs]
|
||||
(if (= 0 (length xs)) ""
|
||||
(do
|
||||
(var result @[])
|
||||
(each x xs (array/push result (str-render-one x)))
|
||||
(string/join result ""))))
|
||||
|
||||
(defn core-str-join
|
||||
"clojure.string/join: stringify each element (Clojure semantics), then join."
|
||||
[coll &opt sep]
|
||||
(default sep "")
|
||||
(let [items (realize-for-iteration coll)
|
||||
parts @[]]
|
||||
(each x items (array/push parts (str-render-one x)))
|
||||
(string/join parts (str-render-one sep))))
|
||||
|
||||
(defn core-name
|
||||
"Returns the name string of a keyword, symbol, or string (without namespace)."
|
||||
[x]
|
||||
(cond
|
||||
(keyword? x) (let [s (string x) i (string/find "/" s)] (if i (string/slice s (+ i 1)) s))
|
||||
(and (struct? x) (= :symbol (x :jolt/type))) (x :name)
|
||||
(string? x) x
|
||||
""))
|
||||
|
||||
(defn core-namespace
|
||||
"Returns the namespace string of a keyword/symbol, or nil if none."
|
||||
[x]
|
||||
(cond
|
||||
(keyword? x) (let [s (string x) i (string/find "/" s)] (if i (string/slice s 0 i) nil))
|
||||
(and (struct? x) (= :symbol (x :jolt/type)))
|
||||
(if (x :ns) (if (struct? (x :ns)) ((x :ns) :name) (string (x :ns))) nil)
|
||||
nil))
|
||||
|
||||
(def core-subs
|
||||
(fn [& args]
|
||||
(when (not (or (= 2 (length args)) (= 3 (length args))))
|
||||
(error "Wrong number of args passed to: subs"))
|
||||
(let [s (args 0)
|
||||
start (get args 1)]
|
||||
(when (not (string? s)) (error (string "subs requires a string, got " (type s))))
|
||||
(let [len (length s)
|
||||
end (if (= 3 (length args)) (args 2) len)]
|
||||
# Clojure validates bounds (no negative/from-end/clamping like Janet):
|
||||
# 0 <= start <= end <= (count s).
|
||||
(when (not (and (number? start) (number? end)
|
||||
(= start (math/floor start)) (= end (math/floor end))
|
||||
(>= start 0) (<= start end) (<= end len)))
|
||||
(error "String index out of range"))
|
||||
(string/slice s start end)))))
|
||||
|
||||
# ============================================================
|
||||
310
src/jolt/core_refs.janet
Normal file
310
src/jolt/core_refs.janet
Normal file
|
|
@ -0,0 +1,310 @@
|
|||
# Jolt Core — arrays, bit ops, coercions, hash, atoms/refs
|
||||
# Extracted from core.janet (jolt-nma8, phase 2b split).
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
(use ./phs)
|
||||
(use ./lazyseq)
|
||||
(use ./regex)
|
||||
(use ./config)
|
||||
(use ./pv)
|
||||
(use ./plist)
|
||||
(use ./core_types)
|
||||
(use ./core_coll)
|
||||
(use ./core_print)
|
||||
(use ./core_io)
|
||||
# Java-style arrays — backed by Janet's C primitives. Byte arrays use Janet
|
||||
# buffers (contiguous, O(1) indexed get/put — genuinely fast); object and
|
||||
# numeric arrays use Janet arrays. aget/aset/alength/aclone work over both.
|
||||
# ============================================================
|
||||
|
||||
# alength / aget / aset now live in the Clojure collection tier — count/nth reads
|
||||
# and an aset write through jolt.host/ref-put!. The typed/object array constructors
|
||||
# below stay native (they build the mutable backing).
|
||||
|
||||
(defn core-aclone [arr]
|
||||
(cond
|
||||
(buffer? arr) (buffer/slice arr)
|
||||
(pvec? arr) (array ;(pv->array arr))
|
||||
(array/slice arr)))
|
||||
|
||||
# Numeric / object arrays: (T-array size) | (T-array size init) | (T-array seq)
|
||||
(defn- make-num-array [a rest init]
|
||||
(if (number? a)
|
||||
(array/new-filled a (if (> (length rest) 0) (in rest 0) init))
|
||||
(array ;(realize-for-iteration a))))
|
||||
(defn core-object-array [a & rest] (make-num-array a rest nil))
|
||||
(defn core-int-array [a & rest] (make-num-array a rest 0))
|
||||
(defn core-long-array [a & rest] (make-num-array a rest 0))
|
||||
(defn core-short-array [a & rest] (make-num-array a rest 0))
|
||||
(defn core-double-array [a & rest] (make-num-array a rest 0))
|
||||
(defn core-float-array [a & rest] (make-num-array a rest 0))
|
||||
(defn core-char-array [a & rest]
|
||||
# JVM char-array also accepts a STRING/char-seq (char[] of its characters) —
|
||||
# selmer's parse-str does (char-array template).
|
||||
(cond
|
||||
(string? a) (map make-char (string/bytes a))
|
||||
(buffer? a) (map make-char (string/bytes (string a)))
|
||||
(make-num-array a rest (make-char 0))))
|
||||
(defn core-boolean-array [a & rest] (make-num-array a rest false))
|
||||
|
||||
# Byte arrays — Janet buffers (each element a 0..255 byte).
|
||||
(defn core-byte-array [a & rest]
|
||||
(if (number? a)
|
||||
(buffer/new-filled a (band (if (> (length rest) 0) (in rest 0) 0) 0xff))
|
||||
(let [b (buffer/new 0)]
|
||||
(each x (realize-for-iteration a) (buffer/push-byte b (band x 0xff)))
|
||||
b)))
|
||||
|
||||
(defn core-aset-byte [arr i v] (put arr i (band v 0xff)) v)
|
||||
(defn core-aset-int [arr i v] (put arr i v) v)
|
||||
(defn core-aset-long [arr i v] (put arr i v) v)
|
||||
(defn core-aset-short [arr i v] (put arr i v) v)
|
||||
(defn core-aset-double [arr i v] (put arr i v) v)
|
||||
(defn core-aset-float [arr i v] (put arr i v) v)
|
||||
(defn core-aset-char [arr i v] (put arr i v) v)
|
||||
(defn core-aset-boolean [arr i v] (put arr i v) v)
|
||||
|
||||
(defn core-make-array [a & rest]
|
||||
# (make-array len) or (make-array type len ...); ignore the type tag
|
||||
(let [len (if (number? a) a (in rest 0))] (array/new-filled len nil)))
|
||||
|
||||
(defn core-into-array [a & rest]
|
||||
(let [s (if (> (length rest) 0) (in rest 0) a)]
|
||||
(array ;(realize-for-iteration s))))
|
||||
|
||||
(defn core-to-array [coll]
|
||||
(def arr @[]) (each x (realize-for-iteration coll) (array/push arr x)) arr)
|
||||
# to-array-2d lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# Array-element casts — identity on arrays; `bytes` coerces to a byte buffer.
|
||||
(defn core-bytes [x] (if (buffer? x) x (core-byte-array x)))
|
||||
(defn core-booleans [x] x)
|
||||
(defn core-ints [x] x)
|
||||
(defn core-longs [x] x)
|
||||
(defn core-shorts [x] x)
|
||||
(defn core-doubles [x] x)
|
||||
(defn core-floats [x] x)
|
||||
(defn core-chars [x] x)
|
||||
|
||||
# Scalar numeric coercions
|
||||
(defn core-byte [x] (let [b (band (math/trunc x) 0xff)] (if (>= b 128) (- b 256) b)))
|
||||
(defn core-short [x] (let [s (band (math/trunc x) 0xffff)] (if (>= s 0x8000) (- s 0x10000) s)))
|
||||
# The masking unchecked-byte/short/char and float/double coercions live in
|
||||
# the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
# 64-bit integers (Janet int/s64 — C-backed)
|
||||
(defn core-bigint [x] (int/s64 x))
|
||||
(defn core-biginteger [x] (int/s64 x))
|
||||
# bigdec now lives in the Clojure collection tier (no BigDecimal: a double).
|
||||
|
||||
# Chunked seqs — Jolt does not chunk, so these are simple eager equivalents.
|
||||
(defn core-chunk-buffer [capacity] @[])
|
||||
(defn core-chunk-append [b x] (array/push b x) b)
|
||||
(defn core-chunk [b] b)
|
||||
# chunked-seq? now lives in the Clojure collection tier (always false on Jolt).
|
||||
(defn core-chunk-first [s] (core-first s))
|
||||
(defn core-chunk-rest [s] (core-rest s))
|
||||
(defn core-chunk-next [s] (core-next s))
|
||||
(defn core-chunk-cons [chunk rest] (core-concat (realize-for-iteration chunk) rest))
|
||||
|
||||
# More clojure.core: real implementations backed by existing Jolt machinery.
|
||||
(defn core-boolean [x] (if x true false))
|
||||
(defn core-cat [rf]
|
||||
(fn [& a]
|
||||
(case (length a)
|
||||
0 (rf) 1 (rf (a 0))
|
||||
(do (var acc (a 0)) (each x (realize-for-iteration (a 1)) (set acc (rf acc x))) acc))))
|
||||
(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).
|
||||
# sorted-map-by / sorted-set-by (and all other sorted-coll constructors and
|
||||
# semantics) now live in the Clojure sorted tier (core/25-sorted.clj).
|
||||
# array-seq / seque live in the Clojure collection tier (core/20-coll.clj).
|
||||
# supers now lives in the Clojure collection tier (no class hierarchy: #{}).
|
||||
(defn core-class [x]
|
||||
(cond
|
||||
(nil? x) nil (number? x) "java.lang.Number" (string? x) "java.lang.String"
|
||||
(boolean? x) "java.lang.Boolean" (keyword? x) "clojure.lang.Keyword"
|
||||
(function? x) "clojure.lang.IFn" (buffer? x) "[B"
|
||||
(string (type x))))
|
||||
# clojure-version / munge / test now live in the Clojure collection tier
|
||||
# (core/20-coll.clj).
|
||||
|
||||
|
||||
# ============================================================
|
||||
# Bit operations (needed for persistent data structures)
|
||||
# ============================================================
|
||||
|
||||
(def core-bit-and (fn [a b] (band a b)))
|
||||
(def core-bit-or (fn [a b] (bor a b)))
|
||||
(def core-bit-xor (fn [a b] (bxor a b)))
|
||||
(def core-bit-not (fn [a] (bnot a)))
|
||||
(def core-bit-shift-left (fn [x n] (blshift x n)))
|
||||
(def core-bit-shift-right (fn [x n] (brshift x n)))
|
||||
(def core-bit-clear (fn [x n] (band x (bnot (blshift 1 n)))))
|
||||
(def core-bit-set (fn [x n] (bor x (blshift 1 n))))
|
||||
(def core-bit-flip (fn [x n] (bxor x (blshift 1 n))))
|
||||
(def core-bit-test (fn [x n] (not= 0 (band x (blshift 1 n)))))
|
||||
(def core-bit-and-not (fn [a b] (band a (bnot b))))
|
||||
(def core-unsigned-bit-shift-right (fn [x n] (brushift x n)))
|
||||
|
||||
# ============================================================
|
||||
# Integer coercion
|
||||
# ============================================================
|
||||
|
||||
(def core-int (fn [x] (if (core-char? x) (x :ch) (math/trunc x))))
|
||||
(def core-long (fn [x] (if (core-char? x) (x :ch) (math/trunc x))))
|
||||
(def core-double (fn [x] (* 1.0 (if (core-char? x) (x :ch) x))))
|
||||
(def core-float core-double)
|
||||
# num and the unchecked-*/promoting-' arithmetic live in the Clojure
|
||||
# collection tier (core/20-coll.clj) — jolt numbers don't overflow.
|
||||
(defn core-char [x]
|
||||
"(char code-or-char) -> a character value."
|
||||
(cond
|
||||
(core-char? x) x
|
||||
(number? x) (make-char (math/trunc x))
|
||||
(string? x) (make-char (in x 0))
|
||||
(error "char expects a number or character")))
|
||||
|
||||
# ============================================================
|
||||
# Hash
|
||||
# ============================================================
|
||||
|
||||
(def core-hash (fn [x] (hash x)))
|
||||
|
||||
|
||||
# ============================================================
|
||||
# Atom
|
||||
# ============================================================
|
||||
|
||||
(defn core-atom
|
||||
"Create an atom. Accepts optional :validator fn and :meta map."
|
||||
[val & opts]
|
||||
(var atm @{:jolt/type :jolt/atom :value val :watches @{} :validator nil})
|
||||
(var i 0)
|
||||
(while (< i (length opts))
|
||||
(case (opts i)
|
||||
:validator (put atm :validator (opts (+ i 1)))
|
||||
:meta (let [m (opts (+ i 1))]
|
||||
(var meta-tab @{})
|
||||
(each k (keys m) (put meta-tab k (get m k)))
|
||||
(table/setproto atm meta-tab)
|
||||
(put atm :jolt/meta m)))
|
||||
(+= i 2))
|
||||
atm)
|
||||
|
||||
# atom? now lives in the Clojure collection tier (tagged-value predicate).
|
||||
|
||||
# Futures — run the body on a real OS thread (ev/thread) for true parallelism.
|
||||
# Janet threads have separate heaps, so the thunk and the state it closes over are
|
||||
# MARSHALLED (copied) to the worker thread and the result is marshalled back. A
|
||||
# future therefore sees a *snapshot* of captured state and communicates only via
|
||||
# its return value — mutating a captured atom does not propagate to the parent.
|
||||
# Coordination uses two channels: a thread-chan carries the single [:ok v] /
|
||||
# [:error e] result back, and a parent-local chan acts as a broadcast latch that
|
||||
# is closed when the result lands so any number of deref-ers can unpark.
|
||||
(defn core-future? [x] (and (table? x) (= :jolt/future (x :jolt/type))))
|
||||
|
||||
(defn core-future-call [thunk]
|
||||
(def tc (ev/thread-chan 1)) # worker thread -> collector (shared, thread-safe)
|
||||
(def latch (ev/chan)) # parent-local: closed when the result is in
|
||||
(def fut @{:jolt/type :jolt/future :latch latch :cached false :res nil :cancelled false})
|
||||
# Worker: compute on a fresh OS thread, send back a marshalled result. The give
|
||||
# is guarded so a non-marshallable value can't strand deref-ers forever.
|
||||
(ev/spawn-thread
|
||||
(def res (try [:ok (thunk)] ([e] [:error e])))
|
||||
(try (ev/give tc res)
|
||||
([_] (ev/give tc [:error "future result is not marshallable across threads"]))))
|
||||
# Collector: a parent-side fiber bridges the single result into the box and
|
||||
# closes the latch to wake every waiter. If the future was already cancelled,
|
||||
# the box is finalized — drop the late result and don't re-close the latch.
|
||||
(ev/spawn
|
||||
(def res (ev/take tc))
|
||||
(when (not (fut :cancelled))
|
||||
(put fut :res res)
|
||||
(put fut :cached true)
|
||||
(try (ev/chan-close latch) ([_] nil))))
|
||||
fut)
|
||||
|
||||
(defn- future-result [fut]
|
||||
(def res (fut :res))
|
||||
(if (= :error (in res 0)) (error (in res 1)) (in res 1)))
|
||||
|
||||
# future-done? / future-cancelled? now live in the Clojure collection tier (pure
|
||||
# reads of :cached/:cancelled). core-future? stays — deref/future-cancel call it.
|
||||
# Janet OS threads can't be interrupted, so the worker still runs to completion
|
||||
# in the background; we can only mark the *future* cancelled (done) so deref
|
||||
# raises and realized?/future-done?/future-cancelled? reflect it. Returns false
|
||||
# if the future has already completed (matching Clojure).
|
||||
(defn core-future-cancel [x]
|
||||
(if (and (core-future? x) (not (x :cached)) (not (x :cancelled)))
|
||||
(do
|
||||
(put x :cancelled true)
|
||||
(put x :res [:error "future cancelled"])
|
||||
(put x :cached true)
|
||||
(try (ev/chan-close (x :latch)) ([_] nil))
|
||||
true)
|
||||
false))
|
||||
|
||||
# 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)))
|
||||
(ref :val)
|
||||
(and (table? ref) (= :jolt/delay (ref :jolt/type)))
|
||||
(if (ref :realized) (ref :val)
|
||||
(let [v ((ref :fn))] (put ref :val v) (put ref :realized true) v))
|
||||
(and (table? ref) (= :jolt/future (ref :jolt/type)))
|
||||
(if (empty? opts)
|
||||
(do (when (not (ref :cached)) (ev/take (ref :latch))) (future-result ref))
|
||||
# (deref future timeout-ms timeout-val): wait at most timeout-ms. The
|
||||
# deadline cancels the parked take; if the result still hasn't landed we
|
||||
# return the supplied timeout value (the future keeps running).
|
||||
(let [timeout-val (in opts 1)]
|
||||
(when (not (ref :cached))
|
||||
(try (ev/with-deadline (/ (in opts 0) 1000) (ev/take (ref :latch))) ([_] nil)))
|
||||
(if (ref :cached) (future-result ref) timeout-val)))
|
||||
(and (table? ref) (= :jolt/var (ref :jolt/type)))
|
||||
(ref :root)
|
||||
ref))
|
||||
|
||||
(defn- atom-validate
|
||||
"Call validator on atm. Returns the value if valid, errors otherwise."
|
||||
[atm val]
|
||||
(let [v (atm :validator)]
|
||||
(if v
|
||||
(if (v val) val
|
||||
(error "Validator rejected value"))
|
||||
val)))
|
||||
|
||||
(defn- atom-notify-watches
|
||||
[atm old-val new-val]
|
||||
(loop [[k w] :pairs (atm :watches)]
|
||||
(w k atm old-val new-val)))
|
||||
|
||||
(defn core-reset! [atm val]
|
||||
(let [old-val (atm :value)]
|
||||
(atom-validate atm val)
|
||||
(put atm :value val)
|
||||
(atom-notify-watches atm old-val val)
|
||||
val))
|
||||
|
||||
(defn core-swap! [atm f & args]
|
||||
(var old-val (atm :value))
|
||||
(var new-val (apply f old-val args))
|
||||
(atom-validate atm new-val)
|
||||
(put atm :value new-val)
|
||||
(atom-notify-watches atm old-val new-val)
|
||||
new-val)
|
||||
|
||||
# Atom peripheral ops (swap-vals!/reset-vals!/compare-and-set!/get-validator/
|
||||
# add-watch/remove-watch/set-validator!) now live in the Clojure collection tier —
|
||||
# composed over the native atom ops + jolt.host/ref-put!. atom/swap!/reset!/deref
|
||||
# and the atom-validate/atom-notify-watches helpers stay native (compiler-critical).
|
||||
|
||||
# ============================================================
|
||||
428
src/jolt/core_types.janet
Normal file
428
src/jolt/core_types.janet
Normal file
|
|
@ -0,0 +1,428 @@
|
|||
# Jolt Core — vector helpers, predicates, math, comparison, equality
|
||||
# Extracted from core.janet (jolt-nma8, phase 2b split).
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
(use ./phs)
|
||||
(use ./lazyseq)
|
||||
(use ./regex)
|
||||
(use ./config)
|
||||
(use ./pv)
|
||||
(use ./plist)
|
||||
|
||||
# ------------------------------------------------------------
|
||||
# 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 core-transient?
|
||||
"True when x is a transient (a mutable scratch collection). See `transient`."
|
||||
[x]
|
||||
(and (table? x) (= :jolt/transient (get x :jolt/type))))
|
||||
|
||||
# Sorted-coll tag checks + entries view, defined this early because canon-key,
|
||||
# empty?, and jolt-equal? (all below) need them. The sorted-coll SEMANTICS are
|
||||
# pure Clojure (core/25-sorted.clj); see the dispatch section further down.
|
||||
(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)))
|
||||
# The :entries vector as a Janet array (entries are jolt vectors: pvecs in
|
||||
# immutable mode, arrays in mutable mode) — for the seed's printers/equality.
|
||||
(defn sorted-entries-arr [coll]
|
||||
(let [e (coll :entries)] (if (pvec? e) (pv->array e) e)))
|
||||
|
||||
# Lazy cell chain over an indexed (tuple/array) collection, walking by INDEX —
|
||||
# O(1) per step. Slicing the remainder per step (the old shape) made every
|
||||
# full walk over a concrete collection O(n^2).
|
||||
(defn indexed-cells [t i]
|
||||
(if (>= i (length t)) nil
|
||||
@[(in t i) (fn [] (indexed-cells t (+ i 1)))]))
|
||||
|
||||
# Canonicalize a collection key/element to a value-hashable Janet struct/tuple so
|
||||
# the PHM/PHS treat value-equal maps/vectors as the same key (Janet hashes tables
|
||||
# by identity otherwise). Installed into phm via set-canonicalize-key!.
|
||||
(var canon-key nil)
|
||||
(set canon-key
|
||||
(fn [k]
|
||||
(cond
|
||||
(pvec? k) (tuple ;(map canon-key (pv->array k)))
|
||||
(plist? k) (tuple ;(map canon-key (pl->array k)))
|
||||
(set? k) (do (def t @{}) (each e (phs-seq k) (put t (canon-key e) true)) (table/to-struct t))
|
||||
(phm? k) (do (def t @{}) (each pair (phm-entries k) (put t (canon-key (in pair 0)) (canon-key (in pair 1)))) (table/to-struct t))
|
||||
# sorted colls canonicalize like their unsorted counterparts, so
|
||||
# (get {(sorted-map :a 1) :hit} {:a 1}) finds the key
|
||||
(core-sorted-map? k) (do (def t @{}) (each e (sorted-entries-arr k) (put t (canon-key (vnth e 0)) (canon-key (vnth e 1)))) (table/to-struct t))
|
||||
(core-sorted-set? k) (do (def t @{}) (each x (sorted-entries-arr k) (put t (canon-key x) true)) (table/to-struct t))
|
||||
(and (table? k) (get k :jolt/deftype))
|
||||
(do (def t @{}) (each kk (keys k) (when (not= kk :jolt/deftype) (put t kk (canon-key (get k kk))))) (table/to-struct t))
|
||||
(struct? k) (do (def t @{}) (each kk (keys k) (put t (canon-key kk) (canon-key (get k kk)))) (table/to-struct t))
|
||||
(array? k) (tuple ;(map canon-key k))
|
||||
(tuple? k) (tuple ;(map canon-key k))
|
||||
k)))
|
||||
(set-canonicalize-key! canon-key)
|
||||
|
||||
# All [k v] entries of a map (struct or phm), nil-valued keys included. Use this
|
||||
# instead of (keys (phm-to-struct m)) — phm-to-struct drops keys whose value is
|
||||
# nil, which is exactly what Clojure maps must keep.
|
||||
(defn map-entries-of [m]
|
||||
(if (phm? m) (phm-entries m) (map (fn [k] [k (in m k)]) (keys m))))
|
||||
|
||||
# assoc one entry onto a map value (struct or phm), preserving a nil key/value and
|
||||
# value-comparing collection keys (promotes a struct to a phm when needed). A
|
||||
# single-entry core-assoc usable by fns defined before core-assoc itself.
|
||||
(defn map-assoc1 [m k v]
|
||||
(cond
|
||||
(phm? m) (phm-assoc m k v)
|
||||
(or (nil? k) (nil? v) (table? k) (array? k))
|
||||
(do (var p (make-phm)) (each ek (keys m) (set p (phm-assoc p ek (in m ek)))) (phm-assoc p k v))
|
||||
(do (def t (merge @{} m)) (put t k v) (table/to-struct t))))
|
||||
|
||||
# Build a map from a flat [k v k v ...] array: a phm when any key/value is nil or
|
||||
# a key is a collection (value hashing); a struct otherwise. One O(n) pass.
|
||||
(defn- kvs->map [kvs]
|
||||
(var need-phm false) (var i 0)
|
||||
(while (< i (length kvs))
|
||||
(let [k (in kvs i) v (in kvs (+ i 1))]
|
||||
(when (or (nil? k) (nil? v) (table? k) (array? k)) (set need-phm true)))
|
||||
(+= i 2))
|
||||
(if need-phm
|
||||
(do (var m (make-phm)) (var j 0)
|
||||
(while (< j (length kvs)) (set m (phm-assoc m (in kvs j) (in kvs (+ j 1)))) (+= j 2)) m)
|
||||
(struct ;kvs)))
|
||||
|
||||
(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
|
||||
# nil is an empty seq in Clojure — iterating it yields nothing.
|
||||
(nil? c) @[]
|
||||
(shape-rec? c) (map (fn [k] (tuple k (shape-get c k nil))) (shape-keys c))
|
||||
(pvec? c) (pv->array c)
|
||||
(plist? c) (pl->array c)
|
||||
(set? c) (phs-seq c)
|
||||
(phm? c) (phm-entries c)
|
||||
# sorted colls iterate their comparator-ordered entries/elements
|
||||
(core-sorted? c) (sorted-entries-arr c)
|
||||
# byte array (Janet buffer) -> array of byte values
|
||||
(buffer? c) (let [a @[]] (each x c (array/push a x)) a)
|
||||
# struct map literal (no :jolt/type marker — not a symbol/char) -> entries
|
||||
(and (struct? c) (nil? (get c :jolt/type))) (map (fn [k] (tuple k (get c k))) (keys c))
|
||||
# raw host table (System/getenv, os/environ) — also a map: entries
|
||||
(and (table? c) (nil? (get c :jolt/type)) (nil? (get c :jolt/deftype)))
|
||||
(map (fn [k] (tuple k (get c k))) (keys 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 (ls-rest-cached cur rt))))))))
|
||||
items)
|
||||
c))
|
||||
|
||||
# Syntax-quote form builders. The syntax-quote lowering (evaluator) emits calls to
|
||||
# these so a `(...)/`[...] body is plain compilable code instead of an interpreted
|
||||
# special form. A list FORM is a Janet array, a vector FORM a tuple (the reader's
|
||||
# representation), so these build those types. Each concat part is either a 1-elem
|
||||
# wrap (__sq1, a non-spliced item) or a spliced seq (~@), flattened in order.
|
||||
(defn core-sq1 [x] @[x])
|
||||
|
||||
(defn core-sqcat [& parts]
|
||||
(def r @[])
|
||||
(each p parts (each x (realize-for-iteration p) (array/push r x)))
|
||||
r)
|
||||
|
||||
(defn core-sqvec [& parts]
|
||||
(def r @[])
|
||||
(each p parts (each x (realize-for-iteration p) (array/push r x)))
|
||||
(tuple/slice r))
|
||||
|
||||
# Map builder: parts are alternating k v (no splicing in map syntax-quote).
|
||||
(defn core-sqmap [& parts]
|
||||
# A syntax-quoted map template is Clojure's array-map case: construction
|
||||
# order is source order and must survive into the built map, which usually
|
||||
# becomes a FORM whose entries the evaluator walks (jolt-p3c). Same
|
||||
# carriers as the reader: struct prototype / phm field.
|
||||
(def kvs (array ;parts))
|
||||
(def m (kvs->map kvs))
|
||||
(cond
|
||||
(struct? m) (struct/with-proto (struct :jolt/kv-order (tuple/slice kvs)) ;kvs)
|
||||
(table? m) (do (put m :jolt/kv-order (tuple/slice kvs)) m)
|
||||
m))
|
||||
|
||||
# Set builder: like core-sqvec but yields a set, so `#{~@a} splices into a set.
|
||||
(defn core-sqset [& parts]
|
||||
(def r @[])
|
||||
(each p parts (each x (realize-for-iteration p) (array/push r x)))
|
||||
(apply make-phs r))
|
||||
|
||||
# ============================================================
|
||||
# Predicates
|
||||
# ============================================================
|
||||
|
||||
(defn core-char? [x] (and (struct? x) (= :jolt/char (x :jolt/type))))
|
||||
(defn char-code [c] (c :ch))
|
||||
(defn char->string [c] (string/from-bytes (c :ch)))
|
||||
|
||||
(defn core-nil? [x] (nil? x))
|
||||
(defn core-not [x] (if x false true))
|
||||
# some? / true? / false? now live in the Clojure collection tier.
|
||||
(defn core-string? [x] (string? x))
|
||||
(defn core-number? [x] (number? x))
|
||||
(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))))
|
||||
# A record shape-rec is a Janet tuple (jvec? true), but a record is NOT a vector
|
||||
# in Clojure — `(vector? record)` is false, and so is `(sequential? record)`.
|
||||
# Excluding it here keeps map-destructuring of a record off the `& {:keys}` kwargs
|
||||
# coerce path (which does `(apply hash-map x)` for a sequential x). jvec? itself
|
||||
# stays as-is for internal representation dispatch.
|
||||
(defn core-vector? [x] (and (jvec? x) (not (shape-rec? x))))
|
||||
# map? is STRICT: a plain struct map literal, a phm, a sorted map, or a record.
|
||||
# Tagged structs (symbols/chars/uuids — anything with :jolt/type) are VALUES,
|
||||
# not maps. (sorted-map? is defined later, so the table check is inlined.)
|
||||
(defn core-map? [x]
|
||||
(or (shape-rec? x)
|
||||
(phm? x)
|
||||
(and (struct? x) (nil? (get x :jolt/type)))
|
||||
(and (table? x)
|
||||
(or (not (nil? (get x :jolt/deftype)))
|
||||
(= :jolt/sorted-map (get x :jolt/type))))))
|
||||
# seq? is true only for actual sequences (lists, lazy-seqs) — NOT vectors, which
|
||||
# are not ISeq in Clojure. (A Janet array represents a Clojure list/seq result.)
|
||||
(defn core-seq? [x] (or (array? x) (plist? x) (lazy-seq? x)))
|
||||
# coll? mirrors map?'s strictness for structs/tables, and includes the sorted
|
||||
# collections and records (IPersistentCollection in Clojure).
|
||||
(defn core-coll? [x]
|
||||
(or (array? x) (tuple? x) (pvec? x) (plist? x) (phm? x) (set? x) (lazy-seq? x)
|
||||
(and (struct? x) (nil? (get x :jolt/type)))
|
||||
(and (table? x)
|
||||
(or (not (nil? (get x :jolt/deftype)))
|
||||
(= :jolt/sorted-map (get x :jolt/type))
|
||||
(= :jolt/sorted-set (get x :jolt/type))))))
|
||||
|
||||
|
||||
|
||||
(defn core-identical? [a b] (= a b))
|
||||
|
||||
# Strictness helpers: like Clojure, numeric ops reject non-numbers, and the
|
||||
# integer ops (odd?/even?) reject non-integers (incl. infinities, NaN, fractions).
|
||||
(defn- finite-num? [x] (and (number? x) (= x x) (< (if (< x 0) (- x) x) math/inf)))
|
||||
(defn- need-num [x op]
|
||||
(if (number? x) x (error (string op " requires a number, got " (type x)))))
|
||||
(defn- need-int [x op]
|
||||
(if (and (number? x) (= x x) (< (if (< x 0) (- x) x) math/inf) (= x (math/floor x))) x
|
||||
(error (string op " requires an integer"))))
|
||||
|
||||
# zero? / pos? live in the syntax tier (core/00-syntax.clj) — empty? and the
|
||||
# analyzer use them; neg? lives in the collection tier (20-coll.clj).
|
||||
# even?/odd? are PERF-WALL residents: (filter even? ...) is idiomatic and the
|
||||
# overlay versions cost an extra call layer per element (seq-pipe bench 4x).
|
||||
(defn core-even? [n] (= 0 (% (need-int n "even?") 2)))
|
||||
(defn core-odd? [n] (not= 0 (% (need-int n "odd?") 2)))
|
||||
|
||||
# Finite integral number: NaN and the infinities are NOT integers (floor of
|
||||
# inf is inf, so the naive floor check wrongly accepted them).
|
||||
(defn core-integer? [x]
|
||||
(and (number? x) (= x x)
|
||||
(< x math/inf) (> x (- math/inf))
|
||||
(= x (math/floor x))))
|
||||
(defn core-list? [x] (or (plist? x) (and (array? x) (not (get x :jolt/type)))))
|
||||
|
||||
# empty? now lives in the syntax tier (core/00-syntax.clj): the expanders
|
||||
# call it, so it must exist before the kernel tier compiles.
|
||||
|
||||
# every? lives in the syntax tier (core/00-syntax.clj) — the analyzer uses it;
|
||||
# the canonical seq/first/next walk short-circuits lazy seqs the same way.
|
||||
|
||||
# ============================================================
|
||||
# Math — Clojure semantics (variadic, / with one arg = reciprocal)
|
||||
# ============================================================
|
||||
|
||||
(def core-+ (fn [& args] (if (= 0 (length args)) 0 (+ ;args))))
|
||||
|
||||
(def core-sub
|
||||
(fn [& args]
|
||||
(if (= 0 (length args))
|
||||
(error "Wrong number of args (0) passed to: -")
|
||||
(apply - args))))
|
||||
|
||||
(def core-* (fn [& args] (if (= 0 (length args)) 1 (* ;args))))
|
||||
|
||||
(def core-/
|
||||
(fn [& args]
|
||||
(case (length args)
|
||||
0 (error "Wrong number of args (0) passed to: /")
|
||||
1 (/ 1 (args 0))
|
||||
(apply / args))))
|
||||
|
||||
(def core-inc inc)
|
||||
(def core-dec dec)
|
||||
# Clojure integer division: quot truncates toward zero; rem matches the sign of
|
||||
# the dividend; mod matches the sign of the divisor (floored).
|
||||
(def core-quot (fn [n d]
|
||||
(when (or (not (finite-num? n)) (not (finite-num? d))) (error "quot requires finite numbers"))
|
||||
(when (= d 0) (error "Divide by zero"))
|
||||
(let [q (/ n d)] (if (< q 0) (math/ceil q) (math/floor q)))))
|
||||
(def core-rem (fn [n d] (- n (* (core-quot n d) d))))
|
||||
(def core-mod (fn [n d]
|
||||
(let [m (core-rem n d)]
|
||||
(if (or (= m 0) (= (> n 0) (> d 0))) m (+ m d)))))
|
||||
|
||||
# max / min now live in the Clojure collection tier (canonical pairwise
|
||||
# >/<, so non-numbers throw and NaN behaves as on the JVM).
|
||||
|
||||
|
||||
(defn core-rand [& n] (let [r (math/random)] (if (empty? n) r (* r (in n 0)))))
|
||||
# rand-int / shuffle / random-uuid now live in the Clojure collection tier
|
||||
# over the rand host seam (canonical: rand-int truncates toward zero).
|
||||
|
||||
# ============================================================
|
||||
# Comparison
|
||||
# ============================================================
|
||||
|
||||
(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
|
||||
# a shape-rec is a MAP, not a sequence, even though it is a tuple
|
||||
(shape-rec? x) nil
|
||||
(lazy-seq? x) (realize-for-iteration x)
|
||||
(pvec? x) (pv->array x)
|
||||
(plist? x) (pl->array x)
|
||||
(tuple? x) x
|
||||
(array? x) x
|
||||
nil))
|
||||
|
||||
(defn- eq-map-pairs
|
||||
"Return [k v] pairs for a map-like value (phm/sorted-map/struct/table), else nil."
|
||||
[x]
|
||||
(cond
|
||||
# a record shape-rec returns nil so equality falls to deep=, which is
|
||||
# type-aware (the descriptor is interned per type): a record equals only a
|
||||
# same-type record, never a plain map — mirroring the :jolt/deftype table
|
||||
# form below. A plain-map shape-rec compares by pairs.
|
||||
(shape-rec? x) (if (record-tag x) nil (map (fn [k] @[k (shape-get x k nil)]) (shape-keys x)))
|
||||
(phm? x) (phm-entries x)
|
||||
# sorted-map equals any map with the same pairs (representation-agnostic, as
|
||||
# in Clojure); sorted-set is handled by the set branch of jolt-equal?
|
||||
(core-sorted-map? x) (map (fn [e] @[(vnth e 0) (vnth e 1)]) (sorted-entries-arr x))
|
||||
(core-sorted-set? x) nil
|
||||
(and (table? x) (get x :jolt/deftype)) nil
|
||||
(struct? x) (pairs x)
|
||||
(table? x) (pairs x)
|
||||
nil))
|
||||
|
||||
# Elements of a set-like value (phs or sorted-set) as an array, else nil.
|
||||
(defn- eq-set-elems [x]
|
||||
(cond
|
||||
(set? x) (phs-seq x)
|
||||
(core-sorted-set? x) (sorted-entries-arr x)
|
||||
nil))
|
||||
|
||||
(var jolt-equal? nil)
|
||||
(set jolt-equal?
|
||||
(fn [a b]
|
||||
(let [sa (eq-seqable a) sb (eq-seqable b)]
|
||||
(cond
|
||||
# both sequential: compare element-wise (vectors/lists/lazy-seqs equal)
|
||||
(and sa sb)
|
||||
(if (= (length sa) (length sb))
|
||||
(do (var ok true) (var i 0)
|
||||
(while (and ok (< i (length sa)))
|
||||
(unless (jolt-equal? (in sa i) (in sb i)) (set ok false))
|
||||
(++ i))
|
||||
ok)
|
||||
false)
|
||||
(or sa sb) false
|
||||
# sets (phs or sorted-set, in any combination)
|
||||
(or (set? a) (set? b) (core-sorted-set? a) (core-sorted-set? b))
|
||||
# value-based: same size and every element of a is value-equal to some
|
||||
# element of b (so #{ {:a 1} } equals #{ (hash-map :a 1) } regardless of
|
||||
# the elements' underlying representations)
|
||||
(let [ea (eq-set-elems a) eb (eq-set-elems b)]
|
||||
(if (and ea eb (= (length ea) (length eb)))
|
||||
(do
|
||||
(var ok true)
|
||||
(each x ea
|
||||
(unless (some (fn [y] (jolt-equal? x y)) eb) (set ok false)))
|
||||
ok)
|
||||
false))
|
||||
# maps: compare key/value pairs recursively, order-independent
|
||||
true
|
||||
(let [pa (eq-map-pairs a) pb (eq-map-pairs b)]
|
||||
(if (or pa pb)
|
||||
(if (and pa pb (= (length pa) (length pb)))
|
||||
(do (var ok true)
|
||||
(each pair pa
|
||||
(let [k (in pair 0) v (in pair 1)
|
||||
found (do (var fv :jolt/none)
|
||||
(each p2 pb (when (jolt-equal? k (in p2 0)) (set fv (in p2 1))))
|
||||
fv)]
|
||||
(unless (and (not= found :jolt/none) (jolt-equal? v found)) (set ok false))))
|
||||
ok)
|
||||
false)
|
||||
(deep= a b)))))))
|
||||
|
||||
(defn core-= [& args]
|
||||
(if (< (length args) 2) true
|
||||
(do
|
||||
(var ok true)
|
||||
(var i 0)
|
||||
(while (and ok (< i (dec (length args))))
|
||||
(unless (jolt-equal? (args i) (args (+ i 1))) (set ok false))
|
||||
(++ i))
|
||||
ok)))
|
||||
|
||||
# not= lives in the syntax tier (core/00-syntax.clj) — the kernel uses it.
|
||||
|
||||
# Comparisons are variadic: (< a b c) means a < b < c.
|
||||
(defn- chain-cmp [op opname xs]
|
||||
# 1-arity (e.g. (< x)) is true regardless of x and does no type check.
|
||||
(when (>= (length xs) 2) (each x xs (need-num x opname)))
|
||||
(var ok true) (var i 0)
|
||||
(while (and ok (< i (dec (length xs))))
|
||||
(unless (op (in xs i) (in xs (+ i 1))) (set ok false))
|
||||
(++ i))
|
||||
ok)
|
||||
(defn core-< [& xs] (chain-cmp < "<" xs))
|
||||
(defn core-> [& xs] (chain-cmp > ">" xs))
|
||||
(defn core-<= [& xs] (chain-cmp <= "<=" xs))
|
||||
(defn core->= [& xs] (chain-cmp >= ">=" xs))
|
||||
|
||||
# ============================================================
|
||||
Loading…
Add table
Add a link
Reference in a new issue