core: Stage 3 — sorted collections are pure Clojure (canonical port)
sorted-map/sorted-map-by/sorted-set/sorted-set-by/sorted?/sorted-map?/
sorted-set?/subseq/rsubseq now live in their own overlay tier (25-sorted.clj).
A sorted coll is a tagged host table with a comparator-ordered :entries
vector, a 3-way :cmp, and the tier's op implementations ATTACHED to the value
(:ops map): the seed's conj/assoc/get/seq/count/... branches are each a
one-line call through (coll :ops), so the ops travel with the value — correct
across contexts, forks, and AOT images, no module-level hooks to re-wire.
The host surface grows by three minimal value primitives: jolt.host/
tagged-table, ref-put! (already there), and ref-get — a raw field read,
because plain get on a sorted coll IS the comparator lookup and reading
:entries with it recurses.
This fixes a pile of Clojure-correctness gaps the Janet kernel had:
- lookup/membership now go through the COMPARATOR: (contains? (sorted-set 1)
1.0) was a deep= scan, (conj (sorted-set 1) 1.0) and assoc of a
comparator-equal key now no-op/replace as in Clojure
- equality is representation-agnostic: (= (sorted-map :a 1) {:a 1}) and
(= (sorted-set 1 2) #{1 2}) were false
- iteration was broken: (map inc (sorted-set 3 1 2)) errored
(realize-for-iteration and coll->cells had no sorted branches)
- empty?/empty saw the host wrapper, not the collection: (empty? (sorted-map))
was false, (empty sc) returned a bare table; it now keeps the comparator
- sorted colls canonicalize as map keys; comparator fns may be boolean
predicates or 3-way (Clojure's fn->comparator)
- sorted-map throws on odd kv count; conj nil is a no-op
Also fixes jolt-h86 en passant: into-conj had no branch for sets (or sorted
colls) and silently returned the target unchanged — (into #{} [:a :b]) was
#{}. The fallback now folds conj. Regression rows in sets-spec.
sorted-spec grows to 77 rows (comparator-based membership, equality,
empty/rseq/printing, seq-fn interop, subseq/rsubseq on maps). Gate green:
conformance 326x3, suite 4577 (vs 4566 prior — the battery gained rows),
sorted+sets specs, full jpm test, bench at parity with main back-to-back
(4521ms vs 4619ms TOTAL under identical load).
This commit is contained in:
Yogthos
parent
d6c5552fda
commit
55a3ebf93f
9 changed files with 400 additions and 143 deletions
205
jolt-core/clojure/core/25-sorted.clj
Normal file
205
jolt-core/clojure/core/25-sorted.clj
Normal file
|
|
@ -0,0 +1,205 @@
|
|||
;; clojure.core — sorted collections tier (stage 3, jolt-0lj).
|
||||
;;
|
||||
;; A sorted-map / sorted-set is a tagged host table
|
||||
;; {:jolt/type :jolt/sorted-map|:jolt/sorted-set
|
||||
;; :entries VECTOR ; comparator-ordered: [k v] pairs / elements
|
||||
;; :cmp FN-or-nil ; 3-way comparator; nil = natural order (compare)
|
||||
;; :ops {op-kw fn}} ; this tier's implementations, attached to the value
|
||||
;;
|
||||
;; ALL the semantics live here in Clojure. The Janet seed keeps only its
|
||||
;; dispatch branches (conj/assoc/get/seq/count/…), each a one-line call through
|
||||
;; the value's own :ops table — so the ops travel WITH the value (correct
|
||||
;; across contexts, forks, and AOT images; no module-level hooks to re-wire).
|
||||
;; The wrapper table itself is minted and read through the minimal host value
|
||||
;; primitives: jolt.host/tagged-table + jolt.host/ref-put! + jolt.host/ref-get.
|
||||
;;
|
||||
;; Clojure semantics this port fixes vs the old Janet kernel: lookup and
|
||||
;; membership go through the COMPARATOR ((contains? (sorted-set 1) 1.0) was a
|
||||
;; deep= scan; assoc/conj of a comparator-equal key replaces/no-ops), equality
|
||||
;; is representation-agnostic ((= (sorted-map :a 1) {:a 1})), empty?/empty see
|
||||
;; the collection rather than the wrapper, (empty sc) keeps the comparator,
|
||||
;; iteration (map/reduce/filter) works, and sorted colls canonicalize as map
|
||||
;; keys. Entries keep the FIRST-inserted key on replace, as Clojure's
|
||||
;; PersistentTreeMap does.
|
||||
|
||||
;; Raw field read on the wrapper (host primitive). Plain `get` on a sorted coll
|
||||
;; IS the comparator lookup — it dispatches back into these ops, so reading
|
||||
;; :entries/:cmp/:ops with it would recurse forever.
|
||||
(defn- sfield [sc k] (jolt.host/ref-get sc k))
|
||||
|
||||
;; Clojure's fn->comparator: a comparator fn may return a number (3-way) or a
|
||||
;; boolean less-than predicate.
|
||||
(defn- fn->cmp [f]
|
||||
(fn [a b]
|
||||
(let [r (f a b)]
|
||||
(if (number? r)
|
||||
r
|
||||
(if r -1 (if (f b a) 1 0))))))
|
||||
|
||||
(defn- the-cmp [sc] (or (sfield sc :cmp) compare))
|
||||
|
||||
;; Lowest index in [0, n) whose key is >= k under cmp (n when none).
|
||||
(defn- lower-bound [es keyf cmp k]
|
||||
(loop [lo 0 hi (count es)]
|
||||
(if (< lo hi)
|
||||
(let [mid (quot (+ lo hi) 2)]
|
||||
(if (neg? (cmp (keyf (nth es mid)) k))
|
||||
(recur (inc mid) hi)
|
||||
(recur lo mid)))
|
||||
lo)))
|
||||
|
||||
;; Index of the comparator-equal entry, or -1.
|
||||
(defn- find-idx [sc keyf k]
|
||||
(let [es (sfield sc :entries)
|
||||
cmp (the-cmp sc)
|
||||
i (lower-bound es keyf cmp k)]
|
||||
(if (and (< i (count es)) (zero? (cmp (keyf (nth es i)) k))) i -1)))
|
||||
|
||||
(defn- make-sorted [tag es cmp ops]
|
||||
(-> (jolt.host/tagged-table tag)
|
||||
(jolt.host/ref-put! :entries es)
|
||||
(jolt.host/ref-put! :cmp cmp)
|
||||
(jolt.host/ref-put! :ops ops)))
|
||||
|
||||
(defn- insert-at [es i x] (into (conj (subvec es 0 i) x) (subvec es i)))
|
||||
(defn- remove-at [es i] (into (subvec es 0 i) (subvec es (inc i))))
|
||||
|
||||
;; --- sorted-map ops ---------------------------------------------------------
|
||||
|
||||
(defn- sm-get [sm k not-found]
|
||||
(let [i (find-idx sm first k)]
|
||||
(if (neg? i) not-found (second (nth (sfield sm :entries) i)))))
|
||||
|
||||
(defn- sm-assoc-1 [sm k v]
|
||||
(let [es (sfield sm :entries)
|
||||
cmp (the-cmp sm)
|
||||
i (lower-bound es first cmp k)
|
||||
found (and (< i (count es)) (zero? (cmp (first (nth es i)) k)))]
|
||||
(make-sorted :jolt/sorted-map
|
||||
(if found
|
||||
(assoc es i [(first (nth es i)) v])
|
||||
(insert-at es i [k v]))
|
||||
(sfield sm :cmp) (sfield sm :ops))))
|
||||
|
||||
(defn- sm-assoc-many [sm kvs]
|
||||
(let [n (count kvs)]
|
||||
(when (odd? n)
|
||||
(throw (ex-info "sorted-map assoc expects an even number of key/values" {:count n})))
|
||||
(loop [m sm i 0]
|
||||
(if (< i n)
|
||||
(recur (sm-assoc-1 m (nth kvs i) (nth kvs (inc i))) (+ i 2))
|
||||
m))))
|
||||
|
||||
(defn- sm-dissoc-many [sm ks]
|
||||
(reduce (fn [m k]
|
||||
(let [i (find-idx m first k)]
|
||||
(if (neg? i)
|
||||
m
|
||||
(make-sorted :jolt/sorted-map (remove-at (sfield m :entries) i)
|
||||
(sfield m :cmp) (sfield m :ops)))))
|
||||
sm ks))
|
||||
|
||||
;; conj on a map: a [k v] pair (2-vector / map-entry) or a map to merge;
|
||||
;; nil is a no-op, as in Clojure.
|
||||
(defn- sm-conj-1 [sm x]
|
||||
(cond
|
||||
(nil? x) sm
|
||||
(map? x) (reduce (fn [m e] (sm-assoc-1 m (first e) (second e))) sm (seq x))
|
||||
(and (vector? x) (= 2 (count x))) (sm-assoc-1 sm (nth x 0) (nth x 1))
|
||||
:else (throw (ex-info "conj on a sorted-map requires a [key value] pair or a map" {}))))
|
||||
|
||||
(defn- sm-conj-many [sm xs] (reduce sm-conj-1 sm xs))
|
||||
|
||||
;; --- sorted-set ops ---------------------------------------------------------
|
||||
|
||||
(defn- ss-get [ss x not-found]
|
||||
(let [i (find-idx ss identity x)]
|
||||
(if (neg? i) not-found (nth (sfield ss :entries) i))))
|
||||
|
||||
(defn- ss-conj-1 [ss x]
|
||||
(let [es (sfield ss :entries)
|
||||
cmp (the-cmp ss)
|
||||
i (lower-bound es identity cmp x)]
|
||||
(if (and (< i (count es)) (zero? (cmp (nth es i) x)))
|
||||
ss
|
||||
(make-sorted :jolt/sorted-set (insert-at es i x) (sfield ss :cmp) (sfield ss :ops)))))
|
||||
|
||||
(defn- ss-conj-many [ss xs] (reduce ss-conj-1 ss xs))
|
||||
|
||||
(defn- ss-disj-many [ss xs]
|
||||
(reduce (fn [s x]
|
||||
(let [i (find-idx s identity x)]
|
||||
(if (neg? i)
|
||||
s
|
||||
(make-sorted :jolt/sorted-set (remove-at (sfield s :entries) i)
|
||||
(sfield s :cmp) (sfield s :ops)))))
|
||||
ss xs))
|
||||
|
||||
;; --- the ops tables the Janet seed dispatches through ------------------------
|
||||
|
||||
(def ^:private sm-ops
|
||||
{:count (fn [sm] (count (sfield sm :entries)))
|
||||
:seq (fn [sm] (seq (sfield sm :entries)))
|
||||
:rseq (fn [sm] (seq (vec (reverse (sfield sm :entries)))))
|
||||
:first (fn [sm] (first (sfield sm :entries)))
|
||||
:keys (fn [sm] (seq (mapv first (sfield sm :entries))))
|
||||
:vals (fn [sm] (seq (mapv second (sfield sm :entries))))
|
||||
:get sm-get
|
||||
:contains (fn [sm k] (not (neg? (find-idx sm first k))))
|
||||
:assoc sm-assoc-many
|
||||
:dissoc sm-dissoc-many
|
||||
:conj sm-conj-many
|
||||
:empty (fn [sm] (make-sorted :jolt/sorted-map [] (sfield sm :cmp) (sfield sm :ops)))})
|
||||
|
||||
(def ^:private ss-ops
|
||||
{:count (fn [ss] (count (sfield ss :entries)))
|
||||
:seq (fn [ss] (seq (sfield ss :entries)))
|
||||
:rseq (fn [ss] (seq (vec (reverse (sfield ss :entries)))))
|
||||
:first (fn [ss] (first (sfield ss :entries)))
|
||||
:get ss-get
|
||||
:contains (fn [ss x] (not (neg? (find-idx ss identity x))))
|
||||
:conj ss-conj-many
|
||||
:disj ss-disj-many
|
||||
:empty (fn [ss] (make-sorted :jolt/sorted-set [] (sfield ss :cmp) (sfield ss :ops)))})
|
||||
|
||||
;; --- constructors + predicates -----------------------------------------------
|
||||
|
||||
(defn sorted-map [& kvs]
|
||||
(sm-assoc-many (make-sorted :jolt/sorted-map [] nil sm-ops) (vec kvs)))
|
||||
|
||||
(defn sorted-map-by [comparator & kvs]
|
||||
(sm-assoc-many (make-sorted :jolt/sorted-map [] (fn->cmp comparator) sm-ops) (vec kvs)))
|
||||
|
||||
(defn sorted-set [& xs]
|
||||
(ss-conj-many (make-sorted :jolt/sorted-set [] nil ss-ops) (vec xs)))
|
||||
|
||||
(defn sorted-set-by [comparator & xs]
|
||||
(ss-conj-many (make-sorted :jolt/sorted-set [] (fn->cmp comparator) ss-ops) (vec xs)))
|
||||
|
||||
(defn sorted-map? [x] (= :jolt/sorted-map (sfield x :jolt/type)))
|
||||
(defn sorted-set? [x] (= :jolt/sorted-set (sfield x :jolt/type)))
|
||||
(defn sorted? [x] (or (sorted-map? x) (sorted-set? x)))
|
||||
|
||||
;; --- subseq / rsubseq ---------------------------------------------------------
|
||||
;; test is one of < <= > >= applied Clojure-style to the comparator result:
|
||||
;; keep entries whose (cmp entry-key k) satisfies (test _ 0). Returns a seq or
|
||||
;; nil, like Clojure.
|
||||
|
||||
(defn- sc-keyf [sc] (if (sorted-map? sc) first identity))
|
||||
|
||||
(defn- sub-filter [sc tests]
|
||||
(let [cmp (the-cmp sc)
|
||||
keyf (sc-keyf sc)]
|
||||
(filterv (fn [e]
|
||||
(every? (fn [[test k]] (test (cmp (keyf e) k) 0)) tests))
|
||||
(sfield sc :entries))))
|
||||
|
||||
(defn subseq
|
||||
([sc test k] (seq (sub-filter sc [[test k]])))
|
||||
([sc start-test start-k end-test end-k]
|
||||
(seq (sub-filter sc [[start-test start-k] [end-test end-k]]))))
|
||||
|
||||
(defn rsubseq
|
||||
([sc test k] (seq (vec (reverse (sub-filter sc [[test k]])))))
|
||||
([sc start-test start-k end-test end-k]
|
||||
(seq (vec (reverse (sub-filter sc [[start-test start-k] [end-test end-k]]))))))
|
||||
|
|
@ -56,6 +56,19 @@ If a moved fn surfaces a latent bug (e.g. nthrest's nil-vs-() result, the
|
|||
if-let/when-let else-scope leak), fix it to match Clojure and add a regression
|
||||
test, rather than preserving the bug.
|
||||
|
||||
## Phase 2 batches landed
|
||||
|
||||
- **Sorted collections (jolt-0lj)** — sorted-map / sorted-map-by / sorted-set /
|
||||
sorted-set-by / sorted? / sorted-map? / sorted-set? / subseq / rsubseq are
|
||||
pure Clojure in their own tier (`25-sorted.clj`). Representation: tagged host
|
||||
table with a comparator-ordered :entries vector and the ops ATTACHED to the
|
||||
value (:ops map) — the seed dispatch branches call through (coll :ops), so no
|
||||
module-level hooks and the ops survive forks/AOT images. Host surface grew by
|
||||
two minimal value primitives: jolt.host/tagged-table and jolt.host/ref-get
|
||||
(raw field read — plain `get` on a sorted coll is the comparator lookup and
|
||||
would recurse). GOTCHA for future attached-ops ports: inside the overlay,
|
||||
NEVER read your own wrapper's fields with `get`.
|
||||
|
||||
## MOVABLE candidates (Phase 2 worklist, 193)
|
||||
>Eduction NaN? abs aclone alength ancestors array-map array-seq assoc! associative? bean bigdec bigint biginteger boolean boolean? booleans byte bytes bytes? cat char char-escape-string char-name-string char? chars chunk chunk-append chunk-buffer chunk-cons chunk-first chunk-next chunk-rest chunked-seq? class clojure-version comparator compare-and-set! completing conj! counted? decimal? deliver denominator derive descendants destructure disj disj! dissoc! distinct? doall dorun double? doubles drop-last eduction empty ensure-reduced enumeration-seq ex-cause ex-data ex-info ex-info? ex-message find float? floats force halt-when hash-combine hash-map hash-ordered-coll hash-set hash-unordered-coll ident? ifn? indexed? infinite? inst-ms inst? integer? ints isa? iterator-seq key keyword keyword-identical? list* list? longs macrofy map-entry? memfn munge nat-int? neg-int? not-any? not-every? nthnext nthrest numerator numeric= object? parents persistent! pop pop! pos-int? pr prefers println-str prn-str promise qualified-ident? qualified-keyword? qualified-symbol? rand rand-nth random-sample ratio? rational? rationalize re-groups re-matcher record? reduce-kv reduced reduced? reductions replace replicate resolve reversible? rseq rsubseq run! seq-to-map-for-destructuring seque set set? short shorts shuffle simple-ident? simple-keyword? simple-symbol? some-search sort sort-by sorted-map sorted-map-by sorted-map? sorted-set sorted-set-by sorted-set? special-symbol? split-at split-with str-join str-replace-all str-replace-first str-split subseq supers symbol tagged-literal tagged-literal? take-last test transduce unchecked-add unchecked-byte unchecked-char unchecked-dec unchecked-divide-int unchecked-double unchecked-float unchecked-inc unchecked-int unchecked-multiply unchecked-negate unchecked-remainder-int unchecked-short unchecked-subtract undefined? underive uri? uuid? val vector volatile! volatile? xml-seq
|
||||
|
||||
|
|
|
|||
|
|
@ -59,6 +59,7 @@
|
|||
{:ns "clojure.core.00-kernel" :kernel true}
|
||||
{:ns "clojure.core.10-seq" :kernel false}
|
||||
{:ns "clojure.core.20-coll" :kernel false}
|
||||
{:ns "clojure.core.25-sorted" :kernel false}
|
||||
{:ns "clojure.core.30-macros" :kernel false}
|
||||
{:ns "clojure.core.40-lazy" :kernel false}])
|
||||
|
||||
|
|
|
|||
|
|
@ -45,6 +45,17 @@
|
|||
[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)))
|
||||
|
||||
# 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!.
|
||||
|
|
@ -56,6 +67,10 @@
|
|||
(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))
|
||||
|
|
@ -104,6 +119,8 @@
|
|||
(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
|
||||
|
|
@ -218,6 +235,7 @@
|
|||
|
||||
(defn core-empty? [coll]
|
||||
(if (nil? coll) true
|
||||
(if (core-sorted? coll) (= 0 (length (sorted-entries-arr coll)))
|
||||
(if (set? coll) (= 0 (coll :cnt))
|
||||
(if (phm? coll) (= 0 (coll :cnt))
|
||||
(if (pvec? coll) (= 0 (pv-count coll))
|
||||
|
|
@ -228,7 +246,7 @@
|
|||
(let [cell (realize-ls coll)]
|
||||
(or (nil? cell) (= :jolt/pending cell) (= 0 (length cell))))
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll))))))))))
|
||||
(= 0 (length coll)))))))))))
|
||||
|
||||
(defn core-every? [pred coll]
|
||||
# Short-circuit on the first false — and pull lazily so an infinite seq with an
|
||||
|
|
@ -309,15 +327,26 @@
|
|||
nil))
|
||||
|
||||
(defn- eq-map-pairs
|
||||
"Return [k v] pairs for a map-like value (phm/struct/table), else nil."
|
||||
"Return [k v] pairs for a map-like value (phm/sorted-map/struct/table), else nil."
|
||||
[x]
|
||||
(cond
|
||||
(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]
|
||||
|
|
@ -333,18 +362,19 @@
|
|||
ok)
|
||||
false)
|
||||
(or sa sb) false
|
||||
# sets
|
||||
(or (set? a) (set? b))
|
||||
# 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)
|
||||
(if (and (set? a) (set? b) (= (a :cnt) (b :cnt)))
|
||||
(let [eb (phs-seq b)]
|
||||
(var ok true)
|
||||
(each x (phs-seq a)
|
||||
(unless (some (fn [y] (jolt-equal? x y)) eb) (set ok false)))
|
||||
ok)
|
||||
false)
|
||||
(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)]
|
||||
|
|
@ -396,51 +426,17 @@
|
|||
(or (phm? x) (and (struct? x) (nil? (get x :jolt/type)))))
|
||||
|
||||
# --- Sorted collections (sorted-map / sorted-set) -------------------------------
|
||||
# Defined here (before the collection fns) so conj/assoc/get/contains?/keys/vals/
|
||||
# disj can branch on them. A sorted-map is {:jolt/type :jolt/sorted-map :map STRUCT};
|
||||
# a sorted-set is {:jolt/type :jolt/sorted-set :items SORTED-ARRAY}. Keys/elements
|
||||
# are assumed Comparable scalars (the premise of a sorted coll); ops return a fresh
|
||||
# wrapper (persistent — source unchanged). A wrapper may carry an optional :cmp
|
||||
# (set by the by-comparator constructors) that all derived colls propagate.
|
||||
(defn core-sorted-map? [x] (and (table? x) (= :jolt/sorted-map (x :jolt/type))))
|
||||
(defn core-sorted-set? [x] (and (table? x) (= :jolt/sorted-set (x :jolt/type))))
|
||||
(defn core-sorted? [x] (or (core-sorted-map? x) (core-sorted-set? x)))
|
||||
# A sorted coll may carry a :cmp — a Janet 2-arg comparator returning a Clojure
|
||||
# compare result (neg/0/pos). nil means natural order (Janet's < via sort). The
|
||||
# by-comparator constructors install one (built from the user IFn); all derived
|
||||
# colls (assoc/conj/...) propagate it so ordering stays consistent.
|
||||
# A Clojure comparator is either a (neg/0/pos)-returning fn or a boolean predicate
|
||||
# (true => a sorts before b, like <). Reduce both to a strict less-than for sort.
|
||||
(defn- cmp-lt? [cmp a b]
|
||||
(let [r (cmp a b)]
|
||||
(if (boolean? r) r (if (number? r) (< r 0) (truthy? r)))))
|
||||
(defn- sorted-by [cmp arr] (if cmp (sort arr (fn [a b] (cmp-lt? cmp a b))) (sort arr)))
|
||||
(defn sm-make [m &opt cmp] @{:jolt/type :jolt/sorted-map :map m :cmp cmp})
|
||||
(defn ss-make [items &opt cmp] @{:jolt/type :jolt/sorted-set :items items :cmp cmp})
|
||||
(defn core-sorted-map [& kvs]
|
||||
(var m @{}) (var i 0)
|
||||
(while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
|
||||
(sm-make (table/to-struct m)))
|
||||
(defn core-sorted-set [& xs]
|
||||
(var seen @{}) (each x xs (put seen x true))
|
||||
(ss-make (sorted-by nil (array ;(keys seen)))))
|
||||
(defn sorted-map-keys [sm] (sorted-by (sm :cmp) (array ;(keys (sm :map)))))
|
||||
(defn sorted-map-entries [sm] (let [m (sm :map)] (map (fn [k] [k (get m k)]) (sorted-map-keys sm))))
|
||||
(defn sm-assoc-many [sm kvs]
|
||||
(var m @{}) (each k (keys (sm :map)) (put m k (get (sm :map) k)))
|
||||
(var i 0) (while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
|
||||
(sm-make (table/to-struct m) (sm :cmp)))
|
||||
(defn sm-dissoc-many [sm ks]
|
||||
(def rm @{}) (each x ks (put rm x true))
|
||||
(var m @{}) (each k (keys (sm :map)) (unless (get rm k) (put m k (get (sm :map) k))))
|
||||
(sm-make (table/to-struct m) (sm :cmp)))
|
||||
(defn ss-contains? [ss x] (var f false) (each e (ss :items) (when (deep= e x) (set f true) (break))) f)
|
||||
(defn ss-conj-many [ss xs]
|
||||
(var seen @{}) (each e (ss :items) (put seen e true)) (each x xs (put seen x true))
|
||||
(ss-make (sorted-by (ss :cmp) (array ;(keys seen))) (ss :cmp)))
|
||||
(defn ss-disj-many [ss xs]
|
||||
(def rm @{}) (each x xs (put rm x true))
|
||||
(ss-make (filter (fn [e] (not (get rm e))) (ss :items)) (ss :cmp)))
|
||||
# Pure Clojure now (stage 3, jolt-0lj — jolt-core/clojure/core/25-sorted.clj).
|
||||
# A sorted coll is a tagged table {:jolt/type .. :entries SORTED-VECTOR :cmp
|
||||
# :ops {kw fn}} whose ops travel WITH the value, so the seed's dispatch
|
||||
# branches below are each a one-line call through (coll :ops) — no module-level
|
||||
# hooks, correct across contexts/forks/AOT images. The tag predicates and the
|
||||
# entries view live near the top of this module (canon-key/empty?/equality
|
||||
# need them); only this dispatch accessor is left here.
|
||||
(defn sorted-op
|
||||
"The overlay-attached implementation of `op` for sorted coll `coll`."
|
||||
[coll op]
|
||||
(get (coll :ops) op))
|
||||
|
||||
(defn core-conj [& args]
|
||||
(if (= 0 (length args)) (make-vec @[]) # (conj) -> []
|
||||
|
|
@ -448,16 +444,8 @@
|
|||
(if (nil? coll)
|
||||
# conj onto nil builds a list (prepends): (conj nil 1 2) -> (2 1)
|
||||
(do (var result nil) (each x xs (set result (pl-cons x result))) result)
|
||||
(if (core-sorted-map? coll)
|
||||
# conj a [k v] entry (or merge a map) into a sorted-map
|
||||
(do (var m coll)
|
||||
(each x xs
|
||||
(if (map-value? x)
|
||||
(each e (map-entries-of x) (set m (sm-assoc-many m [(in e 0) (in e 1)])))
|
||||
(set m (sm-assoc-many m [(vnth x 0) (vnth x 1)]))))
|
||||
m)
|
||||
(if (core-sorted-set? coll)
|
||||
(ss-conj-many coll xs)
|
||||
(if (core-sorted? coll)
|
||||
((sorted-op coll :conj) coll xs)
|
||||
(if (pvec? coll)
|
||||
(do (var result coll) (each x xs (set result (pv-conj result x))) result)
|
||||
(if (plist? coll)
|
||||
|
|
@ -491,18 +479,18 @@
|
|||
(each e (map-entries-of x)
|
||||
(set result (map-assoc1 result (in e 0) (in e 1))))
|
||||
(set result (map-assoc1 result (vnth x 0) (vnth x 1)))))
|
||||
result)))))))))))))
|
||||
result))))))))))))
|
||||
|
||||
(defn core-assoc [m & kvs]
|
||||
(when (odd? (length kvs))
|
||||
(error "assoc expects an even number of key/value arguments"))
|
||||
# assoc is defined on maps, vectors and nil; reject other shapes
|
||||
(when (or (number? m) (string? m) (buffer? m) (keyword? m) (boolean? m)
|
||||
(plist? m) (set? m) (core-transient? m)
|
||||
(plist? m) (set? m) (core-transient? m) (core-sorted-set? m)
|
||||
(and (struct? m) (get m :jolt/type)))
|
||||
(error (string "assoc requires a map or vector, got " (type m))))
|
||||
(cond
|
||||
(core-sorted-map? m) (sm-assoc-many m kvs)
|
||||
(core-sorted-map? m) ((sorted-op m :assoc) m kvs)
|
||||
(phm? m)
|
||||
(do (var result m) (var i 0) (while (< i (length kvs)) (set result (phm-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
|
||||
(pvec? m)
|
||||
|
|
@ -544,7 +532,7 @@
|
|||
(defn core-dissoc [m & ks]
|
||||
(cond
|
||||
(nil? m) nil
|
||||
(core-sorted-map? m) (sm-dissoc-many m ks)
|
||||
(core-sorted-map? m) ((sorted-op m :dissoc) m ks)
|
||||
(phm? m) (do (var result m) (each k ks (set result (phm-dissoc result k))) result)
|
||||
# reject clearly non-map values (scalars, sequences, sets, symbol/char structs)
|
||||
(or (number? m) (string? m) (buffer? m) (keyword? m) (boolean? m)
|
||||
|
|
@ -558,8 +546,7 @@
|
|||
(defn core-get [m k &opt default]
|
||||
(default default nil)
|
||||
(if (nil? m) default
|
||||
(if (core-sorted-map? m) (let [v (get (m :map) k)] (if (nil? v) default v))
|
||||
(if (core-sorted-set? m) (if (ss-contains? m k) k default)
|
||||
(if (core-sorted? m) ((sorted-op m :get) m k default)
|
||||
(if (core-transient? m)
|
||||
(case (m :kind)
|
||||
:vector (if (and (number? k) (>= k 0) (< k (length (m :arr)))) (in (m :arr) k) default)
|
||||
|
|
@ -574,7 +561,7 @@
|
|||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default))))))))))
|
||||
default)))))))))
|
||||
|
||||
# Runtime invoke dispatch for COMPILED code (interpreter uses evaluator's
|
||||
# jolt-invoke). Handles real functions plus Clojure IFn collections.
|
||||
|
|
@ -583,8 +570,7 @@
|
|||
(or (function? f) (cfunction? f)) (apply f args)
|
||||
(keyword? f) (core-get (get args 0) f (get args 1))
|
||||
(and (struct? f) (= :symbol (f :jolt/type))) (core-get (get args 0) f (get args 1))
|
||||
(core-sorted-map? f) (let [v (get (f :map) (get args 0))] (if (nil? v) (get args 1) v))
|
||||
(core-sorted-set? f) (if (ss-contains? f (get args 0)) (get args 0) (get args 1))
|
||||
(core-sorted? f) ((sorted-op f :get) f (get args 0) (get args 1))
|
||||
(phm? f) (phm-get f (get args 0) (get args 1))
|
||||
(set? f) (if (phs-contains? f (get args 0)) (get args 0) (get args 1))
|
||||
(pvec? f)
|
||||
|
|
@ -634,8 +620,7 @@
|
|||
(if missing default current))
|
||||
|
||||
(defn core-contains? [coll key]
|
||||
(if (core-sorted-map? coll) (not (nil? (get (coll :map) key)))
|
||||
(if (core-sorted-set? coll) (ss-contains? coll key)
|
||||
(if (core-sorted? coll) (if ((sorted-op coll :contains) coll key) true false)
|
||||
(if (core-transient? coll)
|
||||
(case (coll :kind)
|
||||
:vector (and (number? key) (>= key 0) (< key (length (coll :arr))))
|
||||
|
|
@ -647,7 +632,7 @@
|
|||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false))))))))))
|
||||
false)))))))))
|
||||
|
||||
# Coerce a Clojure IFn value to a Janet-callable fn for higher-order fns
|
||||
# (map/filter/sort-by/group-by/...). Janet functions pass through; a keyword or
|
||||
|
|
@ -671,8 +656,7 @@
|
|||
(cond
|
||||
(nil? coll) 0
|
||||
(core-transient? coll) (length (if (= :vector (coll :kind)) (coll :arr) (coll :tbl)))
|
||||
(core-sorted-map? coll) (length (keys (coll :map)))
|
||||
(core-sorted-set? coll) (length (coll :items))
|
||||
(core-sorted? coll) ((sorted-op coll :count) coll)
|
||||
(lazy-seq? coll) (ls-count coll)
|
||||
(pvec? coll) (pv-count coll)
|
||||
(plist? coll) (pl-count coll)
|
||||
|
|
@ -685,8 +669,7 @@
|
|||
|
||||
(defn core-first [coll]
|
||||
(cond
|
||||
(core-sorted-map? coll) (let [e (sorted-map-entries coll)] (if (empty? e) nil (in e 0)))
|
||||
(core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (in i 0)))
|
||||
(core-sorted? coll) ((sorted-op coll :first) coll)
|
||||
(lazy-seq? coll) (ls-first coll)
|
||||
(pvec? coll) (if (= 0 (pv-count coll)) nil (pv-nth coll 0))
|
||||
(plist? coll) (if (pl-empty? coll) nil (pl-first coll))
|
||||
|
|
@ -745,8 +728,7 @@
|
|||
|
||||
(defn core-seq [coll]
|
||||
(cond
|
||||
(core-sorted-map? coll) (let [e (sorted-map-entries coll)] (if (empty? e) nil (tuple ;e)))
|
||||
(core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (tuple ;i)))
|
||||
(core-sorted? coll) ((sorted-op coll :seq) coll)
|
||||
(or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll)))) nil
|
||||
# Cell-based emptiness, NOT (nil? (ls-first)): a lazy-seq whose first element
|
||||
# is legitimately nil is non-empty, so (seq (cons nil ...)) must not be nil.
|
||||
|
|
@ -787,7 +769,10 @@
|
|||
(do (each x items (array/push to x)) to) # vector: append
|
||||
(do (var result (array/slice to)) (each x items (array/insert result 0 x)) result)) # list: prepend
|
||||
(tuple? to) (tuple/slice (tuple ;(array/concat (array/slice to) (array/slice items))))
|
||||
to))
|
||||
# everything else conj-able (sets, sorted colls): fold conj — previously
|
||||
# this fell through to `to` unchanged, silently dropping all elements
|
||||
# ((into #{} [:a :b]) was #{}, jolt-h86)
|
||||
(do (var result to) (each x items (set result (core-conj result x))) result)))
|
||||
|
||||
(defn core-merge [& maps]
|
||||
# Clojure: (when (some identity maps) (reduce conj (or (first maps) {}) (rest maps)))
|
||||
|
|
@ -845,11 +830,11 @@
|
|||
|
||||
(defn core-keys [m]
|
||||
# phm-entries (not phm-to-struct) so keys mapped to nil values are not dropped.
|
||||
(if (core-sorted-map? m) (tuple ;(sorted-map-keys m))
|
||||
(if (core-sorted-map? m) ((sorted-op m :keys) m)
|
||||
(if (phm? m) (tuple ;(map |(in $ 0) (phm-entries m))) (tuple ;(keys m)))))
|
||||
|
||||
(defn core-vals [m]
|
||||
(if (core-sorted-map? m) (tuple ;(map |(in $ 1) (sorted-map-entries m)))
|
||||
(if (core-sorted-map? m) ((sorted-op m :vals) m)
|
||||
(if (phm? m) (tuple ;(map |(in $ 1) (phm-entries m))) (tuple ;(map |(m $) (keys m))))))
|
||||
|
||||
(defn core-select-keys [m ks]
|
||||
|
|
@ -1044,9 +1029,9 @@
|
|||
(if (and (= 2 (length c)) (function? (in c 1)))
|
||||
c # already a cell [val, rest-thunk]
|
||||
@[(in c 0) (fn [] (coll->cells (array/slice c 1)))]))
|
||||
# Other concrete seqables (set/map/string/buffer): coerce to a tuple
|
||||
# seq via core-seq, then recurse. (lazy/indexed handled above.)
|
||||
(if (or (set? c) (phm? c) (buffer? c) (string? c)
|
||||
# Other concrete seqables (set/map/sorted coll/string/buffer): coerce
|
||||
# to a tuple seq via core-seq, then recurse. (lazy/indexed above.)
|
||||
(if (or (set? c) (phm? c) (buffer? c) (string? c) (core-sorted? c)
|
||||
(and (struct? c) (nil? (get c :jolt/type))))
|
||||
(coll->cells (core-seq c))
|
||||
nil)))))))))
|
||||
|
|
@ -1575,7 +1560,7 @@
|
|||
(defn core-set? [x] (set? x))
|
||||
(defn core-disj [s & ks]
|
||||
(cond
|
||||
(core-sorted-set? s) (ss-disj-many s ks)
|
||||
(core-sorted-set? s) ((sorted-op s :disj) s ks)
|
||||
(set? s) (apply phs-disj s ks)
|
||||
(error "disj expects a set")))
|
||||
|
||||
|
|
@ -1677,8 +1662,9 @@
|
|||
(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))
|
||||
(core-sorted-map? v) (pr-render-pairs buf (sorted-map-entries v))
|
||||
(core-sorted-set? v) (pr-render-seq buf (v :items) "#{" "}")
|
||||
(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))
|
||||
|
|
@ -2070,17 +2056,8 @@
|
|||
(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).
|
||||
# The user comparator is a Clojure IFn; wrap it as a Janet 2-arg fn returning the
|
||||
# numeric compare result, then thread it through the sorted wrapper.
|
||||
(defn core-sorted-map-by [cmp & kvs]
|
||||
(let [jc (fn [a b] (jolt-call cmp a b))]
|
||||
(var m @{}) (var i 0)
|
||||
(while (< i (length kvs)) (put m (kvs i) (kvs (+ i 1))) (+= i 2))
|
||||
(sm-make (table/to-struct m) jc)))
|
||||
(defn core-sorted-set-by [cmp & xs]
|
||||
(let [jc (fn [a b] (jolt-call cmp a b))]
|
||||
(var seen @{}) (each x xs (put seen x true))
|
||||
(ss-make (sorted-by jc (array ;(keys seen))) jc)))
|
||||
# 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).
|
||||
(defn core-array-seq [arr & _] (core-seq arr))
|
||||
(defn core-seque [& args] (in args (- (length args) 1)))
|
||||
(defn core-supers [x] (make-phs))
|
||||
|
|
@ -2513,6 +2490,8 @@
|
|||
|
||||
(defn core-empty [coll]
|
||||
(cond
|
||||
# an empty sorted coll of the same kind, KEEPING the comparator (Clojure)
|
||||
(core-sorted? coll) ((sorted-op coll :empty) coll)
|
||||
(phm? coll) (make-phm)
|
||||
(set? coll) (make-phs)
|
||||
(plist? coll) EMPTY-PLIST
|
||||
|
|
@ -2529,8 +2508,7 @@
|
|||
(defn core-rseq [coll]
|
||||
(cond
|
||||
(pvec? coll) (tuple/slice (tuple ;(reverse (pv->array coll))))
|
||||
(core-sorted-map? coll) (tuple/slice (tuple ;(reverse (sorted-map-entries coll))))
|
||||
(core-sorted-set? coll) (tuple/slice (tuple ;(reverse (coll :items))))
|
||||
(core-sorted? coll) ((sorted-op coll :rseq) coll)
|
||||
(error (string "rseq requires a vector or sorted collection, got " (type coll)))))
|
||||
|
||||
(defn core-shuffle [coll]
|
||||
|
|
@ -2629,22 +2607,8 @@
|
|||
(get char-names (if (core-char? c) (char-code c) c)))
|
||||
|
||||
# subseq / rsubseq over sorted collections
|
||||
(defn- sorted-entries [sc]
|
||||
(cond
|
||||
(core-sorted-map? sc) (sorted-map-entries sc)
|
||||
(core-sorted-set? sc) (map (fn [x] x) (sc :items))
|
||||
(realize-for-iteration sc)))
|
||||
(defn- sorted-key-of [sc e] (if (core-sorted-map? sc) (in e 0) e))
|
||||
(defn core-subseq [sc & args]
|
||||
(let [es (sorted-entries sc)]
|
||||
(tuple ;(filter
|
||||
(fn [e] (let [k (sorted-key-of sc e)]
|
||||
(if (= 2 (length args))
|
||||
(truthy? ((args 0) k (args 1)))
|
||||
(and (truthy? ((args 0) k (args 1))) (truthy? ((args 2) k (args 3)))))))
|
||||
es))))
|
||||
(defn core-rsubseq [sc & args]
|
||||
(tuple ;(reverse (apply core-subseq sc args))))
|
||||
# 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
|
||||
|
|
@ -3017,9 +2981,6 @@
|
|||
"keyword" core-keyword
|
||||
"symbol" core-symbol
|
||||
"namespace" core-namespace
|
||||
"sorted-map" core-sorted-map
|
||||
"sorted-set" core-sorted-set
|
||||
"sorted?" core-sorted?
|
||||
"reduced" core-reduced
|
||||
"reduced?" core-reduced?
|
||||
"take-nth" core-take-nth
|
||||
|
|
@ -3136,8 +3097,6 @@
|
|||
"cat" core-cat
|
||||
"disj!" core-disj!
|
||||
"reader-conditional" core-reader-conditional
|
||||
"sorted-map-by" core-sorted-map-by
|
||||
"sorted-set-by" core-sorted-set-by
|
||||
"array-seq" core-array-seq
|
||||
"seque" core-seque
|
||||
"supers" core-supers
|
||||
|
|
@ -3165,8 +3124,6 @@
|
|||
"get-proxy-class" core-get-proxy-class
|
||||
"char-escape-string" core-char-escape-string
|
||||
"char-name-string" core-char-name-string
|
||||
"subseq" core-subseq
|
||||
"rsubseq" core-rsubseq
|
||||
# Bit operations
|
||||
"bit-and" core-bit-and
|
||||
"bit-or" core-bit-or
|
||||
|
|
|
|||
|
|
@ -102,10 +102,10 @@
|
|||
(keyword? f) (coll-lookup (get args 0) f (get args 1))
|
||||
(and (struct? f) (= :symbol (f :jolt/type)))
|
||||
(coll-lookup (get args 0) f (get args 1))
|
||||
(and (table? f) (= :jolt/sorted-map (f :jolt/type)))
|
||||
(let [v (get (f :map) (get args 0))] (if (nil? v) (get args 1) v))
|
||||
(and (table? f) (= :jolt/sorted-set (f :jolt/type)))
|
||||
(if (some |(deep= $ (get args 0)) (f :items)) (get args 0) (get args 1))
|
||||
(and (table? f) (or (= :jolt/sorted-map (f :jolt/type))
|
||||
(= :jolt/sorted-set (f :jolt/type))))
|
||||
# the overlay-attached :get op (comparator-based lookup, like Clojure)
|
||||
((get (f :ops) :get) f (get args 0) (get args 1))
|
||||
(phm? f) (phm-get f (get args 0) (get args 1))
|
||||
(set? f) (if (phs-contains? f (get args 0)) (get args 0) (get args 1))
|
||||
(pvec? f)
|
||||
|
|
|
|||
|
|
@ -162,9 +162,22 @@
|
|||
# table so callers can thread; overlay wrappers return the Clojure-meaningful value.
|
||||
(defn h-ref-put! [tab key val] (put tab key val) tab)
|
||||
|
||||
# Runtime host primitive: mint a fresh tagged host table — the value-layer
|
||||
# constructor the overlay uses to define host-dispatched values (sorted colls).
|
||||
# Fields are attached with ref-put!.
|
||||
(defn h-tagged-table [kw] @{:jolt/type kw})
|
||||
|
||||
# Raw field read on a host table, BYPASSING collection semantics. The overlay
|
||||
# needs this to read its own wrappers' fields: plain (get sorted-coll k) is the
|
||||
# comparator lookup (it dispatches back into the overlay), so reading :entries
|
||||
# with it would recurse forever.
|
||||
(defn h-ref-get [tab key] (get tab key))
|
||||
|
||||
(def- exports
|
||||
{"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns
|
||||
"ref-put!" h-ref-put!
|
||||
"ref-get" h-ref-get
|
||||
"tagged-table" h-tagged-table
|
||||
"form-sym-meta" h-sym-meta
|
||||
"form-list?" h-list? "form-vec?" h-vector? "form-map?" h-map?
|
||||
"form-set?" h-set? "form-char?" h-char? "form-literal?" h-literal?
|
||||
|
|
|
|||
|
|
@ -127,20 +127,24 @@
|
|||
(and (table? v) (= :jolt/regex (v :jolt/type)))
|
||||
(do (push-str buf "#\"") (push-str buf (v :source)) (push-str buf "\""))
|
||||
|
||||
# sorted colls: their comparator-ordered :entries vector (a pvec in
|
||||
# immutable mode, an array in mutable mode) is all the printer reads.
|
||||
(and (table? v) (= :jolt/sorted-map (v :jolt/type)))
|
||||
(do
|
||||
(push-str buf "{")
|
||||
(var first? true)
|
||||
(each k (sort (array ;(keys (v :map))))
|
||||
(each e (let [es (v :entries)] (if (pvec? es) (pv->array es) es))
|
||||
(if first? (set first? false) (push-str buf ", "))
|
||||
(write-value k buf) (push-str buf " ") (write-value (get (v :map) k) buf))
|
||||
(write-value (if (pvec? e) (pv-nth e 0) (in e 0)) buf)
|
||||
(push-str buf " ")
|
||||
(write-value (if (pvec? e) (pv-nth e 1) (in e 1)) buf))
|
||||
(push-str buf "}"))
|
||||
|
||||
(and (table? v) (= :jolt/sorted-set (v :jolt/type)))
|
||||
(do
|
||||
(push-str buf "#{")
|
||||
(var first? true)
|
||||
(each x (v :items)
|
||||
(each x (let [es (v :entries)] (if (pvec? es) (pv->array es) es))
|
||||
(if first? (set first? false) (push-str buf " "))
|
||||
(write-value x buf))
|
||||
(push-str buf "}"))
|
||||
|
|
|
|||
|
|
@ -9,7 +9,10 @@
|
|||
["set? true" "true" "(set? #{1})"]
|
||||
["set? false on vector" "false" "(set? [1])"]
|
||||
["count dedups" "3" "(count (set [1 1 2 3]))"]
|
||||
["equality order-indep" "true" "(= #{1 2 3} #{3 2 1})"])
|
||||
["equality order-indep" "true" "(= #{1 2 3} #{3 2 1})"]
|
||||
# jolt-h86: into-conj had no set branch and returned the set unchanged
|
||||
["into set" "#{:a :b}" "(into #{} [:a :b])"]
|
||||
["into non-empty set" "#{1 2 3}" "(into #{1} [2 3 2])"])
|
||||
|
||||
(defspec "set / operations"
|
||||
["conj adds" "#{1 2 3}" "(conj #{1 2} 3)"]
|
||||
|
|
|
|||
|
|
@ -1,10 +1,13 @@
|
|||
# Specification: sorted collections (sorted-map / sorted-set, subseq/rsubseq).
|
||||
#
|
||||
# sorted collections are first-class for the core ops (jolt-ti9): get/assoc/dissoc/
|
||||
# conj/contains?/keys/vals/disj all work and preserve sort order, and a sorted coll
|
||||
# is callable as a key-lookup fn. STILL TODO: the by-comparator constructors
|
||||
# (sorted-map-by / sorted-set-by) ignore the supplied comparator (jolt-ti9). (vec
|
||||
# coerces a seq to a vector so expecteds are vector literals, not quoted lists.)
|
||||
# Sorted collections are pure Clojure (stage 3, jolt-0lj): the entries live in
|
||||
# a comparator-ordered vector, all ops are overlay Clojure attached to the
|
||||
# value, and the Janet seed only dispatches to them. Semantics match Clojure:
|
||||
# lookup/membership go through the COMPARATOR ((contains? (sorted-set 1) 1.0)
|
||||
# is true), equality is representation-agnostic ((= (sorted-map :a 1) {:a 1})),
|
||||
# empty?/empty see the collection (not the host wrapper) and (empty sc) keeps
|
||||
# the comparator. (vec coerces a seq to a vector so expecteds are vector
|
||||
# literals, not quoted lists.)
|
||||
(use ../support/harness)
|
||||
|
||||
(defspec "sorted / construction & ordering"
|
||||
|
|
@ -56,4 +59,62 @@
|
|||
["subseq >=" "[3 4 5]" "(vec (subseq (sorted-set 1 2 3 4 5) >= 3))"]
|
||||
["subseq <" "[1 2]" "(vec (subseq (sorted-set 1 2 3 4 5) < 3))"]
|
||||
["subseq range" "[2 3 4]" "(vec (subseq (sorted-set 1 2 3 4 5) > 1 < 5))"]
|
||||
["rsubseq <=" "[3 2 1]" "(vec (rsubseq (sorted-set 1 2 3 4 5) <= 3))"])
|
||||
["rsubseq <=" "[3 2 1]" "(vec (rsubseq (sorted-set 1 2 3 4 5) <= 3))"]
|
||||
["subseq on map" "[[2 :b] [3 :c]]" "(vec (subseq (sorted-map 1 :a 2 :b 3 :c) > 1))"]
|
||||
["subseq empty result" "nil" "(subseq (sorted-set 1 2) > 5)"]
|
||||
["rsubseq on map" "[[2 :b] [1 :a]]" "(vec (rsubseq (sorted-map 1 :a 2 :b 3 :c) < 3))"])
|
||||
|
||||
(defspec "sorted / predicates"
|
||||
["sorted-map? true" "true" "(sorted-map? (sorted-map 1 :a))"]
|
||||
["sorted-map? false" "false" "(sorted-map? {:a 1})"]
|
||||
["sorted-set? true" "true" "(sorted-set? (sorted-set 1))"]
|
||||
["sorted-set? false" "false" "(sorted-set? #{1})"]
|
||||
["map? sorted-map" "true" "(map? (sorted-map 1 :a))"]
|
||||
["coll? sorted-set" "true" "(coll? (sorted-set 1))"])
|
||||
|
||||
(defspec "sorted / lookup + membership use the comparator"
|
||||
["get cross-numeric" ":a" "(get (sorted-map 1 :a) 1.0)"]
|
||||
["contains? cross-numeric" "true" "(contains? (sorted-set 1) 1.0)"]
|
||||
["conj equal elem no-op" "1" "(count (conj (sorted-set 1) 1.0))"]
|
||||
["assoc equal key replaces" "[[1 :z]]" "(vec (seq (assoc (sorted-map 1 :a) 1.0 :z)))"]
|
||||
["first sorted-map" "[1 :a]" "(first (sorted-map 2 :b 1 :a))"]
|
||||
["dissoc missing no-op" "2" "(count (dissoc (sorted-map 1 :a 2 :b) 9))"]
|
||||
["conj map merges" "3" "(count (conj (sorted-map 1 :a) {2 :b 3 :c}))"]
|
||||
["conj nil no-op" "1" "(count (conj (sorted-map 1 :a) nil))"]
|
||||
["into sorted-map" "[[1 :a] [2 :b]]" "(vec (seq (into (sorted-map) [[2 :b] [1 :a]])))"]
|
||||
["source unchanged" "[1 2]" "(let [s (sorted-set 1 2)] (conj s 9) (vec (seq s)))"]
|
||||
["sorted-map odd kvs throws" :throws "(sorted-map 1 :a 2)"])
|
||||
|
||||
(defspec "sorted / equality is representation-agnostic"
|
||||
["sorted-map = literal" "true" "(= (sorted-map :a 1 :b 2) {:a 1 :b 2})"]
|
||||
["literal = sorted-map" "true" "(= {:a 1 :b 2} (sorted-map :a 1 :b 2))"]
|
||||
["sorted-map = hash-map" "true" "(= (sorted-map :a 1) (hash-map :a 1))"]
|
||||
["sorted-map != more keys" "false" "(= (sorted-map :a 1) {:a 1 :b 2})"]
|
||||
["sorted-set = literal" "true" "(= (sorted-set 1 2) #{1 2})"]
|
||||
["literal = sorted-set" "true" "(= #{1 2} (sorted-set 2 1))"]
|
||||
["sorted-set != diff" "false" "(= (sorted-set 1 2) #{1 3})"]
|
||||
["two sorted-maps" "true" "(= (sorted-map 1 :a 2 :b) (sorted-map 2 :b 1 :a))"]
|
||||
["cmp irrelevant to =" "true" "(= (sorted-map-by > 1 :a 2 :b) (sorted-map 1 :a 2 :b))"]
|
||||
["sorted-map as map key" ":hit" "(get {(sorted-map :a 1) :hit} {:a 1})"]
|
||||
["sorted-set as map key" ":hit" "(get {(sorted-set 1 2) :hit} #{2 1})"])
|
||||
|
||||
(defspec "sorted / empty + empty? + rseq + printing"
|
||||
["empty? empty map" "true" "(empty? (sorted-map))"]
|
||||
["empty? non-empty" "false" "(empty? (sorted-map 1 :a))"]
|
||||
["empty? empty set" "true" "(empty? (sorted-set))"]
|
||||
["empty keeps sortedness" "true" "(sorted? (empty (sorted-map 1 :a)))"]
|
||||
["empty keeps cmp" "[3 1]" "(vec (seq (into (empty (sorted-set-by > 1 2)) [1 3])))"]
|
||||
["empty set kind" "true" "(sorted-set? (empty (sorted-set 1)))"]
|
||||
["rseq map" "[[2 :b] [1 :a]]" "(vec (rseq (sorted-map 1 :a 2 :b)))"]
|
||||
["rseq set" "[3 2 1]" "(vec (rseq (sorted-set 1 2 3)))"]
|
||||
["pr-str sorted-map" "\"{1 :a, 2 :b}\"" "(pr-str (sorted-map 2 :b 1 :a))"]
|
||||
["pr-str sorted-set" "\"#{1 2 3}\"" "(pr-str (sorted-set 3 1 2))"])
|
||||
|
||||
(defspec "sorted / seq fn interop"
|
||||
["map over sorted-map" "[1 2 3]" "(vec (map first (sorted-map 2 :b 1 :a 3 :c)))"]
|
||||
["map over sorted-set" "[2 3 4]" "(vec (map inc (sorted-set 3 1 2)))"]
|
||||
["filter entries" "[[2 :b]]" "(vec (filter (fn [[k v]] (even? k)) (sorted-map 1 :a 2 :b)))"]
|
||||
["reduce over set" "6" "(reduce + (sorted-set 1 2 3))"]
|
||||
["vec of sorted-set" "[1 2 3]" "(vec (sorted-set 3 1 2))"]
|
||||
["into vec" "[[1 :a] [2 :b]]" "(into [] (sorted-map 2 :b 1 :a))"]
|
||||
["sorted-map-by 3way cmp" "[3 2 1]" "(vec (keys (sorted-map-by (fn [a b] (- b a)) 1 :a 2 :b 3 :c)))"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue