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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue