core: Stage 3 — leaf batch 4: sort-by + the rand family + char tables to the overlay
sort-by, rand-int, shuffle, random-uuid, char-escape-string, and char-name-string move to 20-coll over the two host seams that stay (rand and sort — they ARE the randomness/ordering primitives). Canonical upgrades ride along: sort-by defaults its comparator to compare, so nil sorts FIRST (the kernel fn used host ordering and put nil last); rand-int truncates toward zero via int (the kernel fn floored, wrong for negative n); shuffle is a pure-functional Fisher-Yates over vector assoc and rejects non-collections (a string is seqable but not shuffleable, as on the JVM — the honest gate caught that one); random-uuid builds over rand-int and validates through parse-uuid; the char tables are char-keyed Clojure maps (Clojure's shape — the seed keeps its private code-keyed copies for pr-render). 22 new spec rows. Gate: jpm test exit 0 verified, suite 4698 >= 4660, bench parity with main back-to-back (4733 vs 4817).
This commit is contained in:
Yogthos
parent
17f2474be2
commit
3d7de8ff90
3 changed files with 85 additions and 43 deletions
|
|
@ -342,6 +342,54 @@
|
|||
(defn println-str [& xs] (__with-out-str (fn* [] (apply println xs))))
|
||||
(defn prn-str [& xs] (__with-out-str (fn* [] (apply prn xs))))
|
||||
|
||||
;; --- Phase 2 leaf batch 4 (jolt-ded): over the rand / sort host seams --------
|
||||
|
||||
;; Canonical truncation toward zero via int (the kernel fn floored, which is
|
||||
;; wrong for a negative n).
|
||||
(defn rand-int [n] (int (rand n)))
|
||||
|
||||
;; Pure-functional Fisher-Yates over vector assoc; returns a vector, as in
|
||||
;; Clojure. Collections only — a string is seqable but not shuffleable, as on
|
||||
;; the JVM (Collections/shuffle wants a Collection).
|
||||
(defn shuffle [coll]
|
||||
(when-not (coll? coll)
|
||||
(throw (ex-info (str "shuffle requires a collection, got: " coll) {})))
|
||||
(loop [v (vec coll) i (dec (count v))]
|
||||
(if (pos? i)
|
||||
(let [j (rand-int (inc i))
|
||||
t (nth v i)]
|
||||
(recur (assoc (assoc v i (nth v j)) j t) (dec i)))
|
||||
v)))
|
||||
|
||||
;; Canonical sort-by: the default comparator is compare (so nil sorts first,
|
||||
;; like Clojure — the kernel fn used host ordering, which put nil last); the
|
||||
;; comparator compares KEYS and may be 3-way or a boolean predicate (the host
|
||||
;; sort seam normalizes).
|
||||
(defn sort-by
|
||||
([keyfn coll] (sort-by keyfn compare coll))
|
||||
([keyfn comp coll]
|
||||
(sort (fn [x y] (comp (keyfn x) (keyfn y))) coll)))
|
||||
|
||||
;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version
|
||||
;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid.
|
||||
(defn random-uuid []
|
||||
(let [hx4 (fn [] (format "%04x" (rand-int 0x10000)))
|
||||
hx3 (fn [] (format "%03x" (rand-int 0x1000)))]
|
||||
(parse-uuid (str (hx4) (hx4) "-" (hx4) "-4" (hx3)
|
||||
"-" (format "%x" (+ 8 (rand-int 4))) (hx3)
|
||||
"-" (hx4) (hx4) (hx4)))))
|
||||
|
||||
;; The char escape/name tables, as char-keyed maps (Clojure's shape).
|
||||
(def ^:private char-escape-strings
|
||||
{\newline "\\n" \tab "\\t" \return "\\r" \formfeed "\\f"
|
||||
\backspace "\\b" \" "\\\"" \\ "\\\\"})
|
||||
(defn char-escape-string [c] (get char-escape-strings c))
|
||||
|
||||
(def ^:private char-name-strings
|
||||
{\newline "newline" \tab "tab" \return "return" \formfeed "formfeed"
|
||||
\backspace "backspace" \space "space"})
|
||||
(defn char-name-string [c] (get char-name-strings c))
|
||||
|
||||
;; Random selection over the host rand primitives.
|
||||
(defn rand-nth [coll]
|
||||
(let [v (vec coll)] (nth v (rand-int (count v)))))
|
||||
|
|
|
|||
|
|
@ -297,7 +297,8 @@
|
|||
|
||||
|
||||
(defn core-rand [& n] (let [r (math/random)] (if (empty? n) r (* r (in n 0)))))
|
||||
(defn core-rand-int [n] (math/floor (* (math/random) n)))
|
||||
# rand-int / shuffle / random-uuid now live in the Clojure collection tier
|
||||
# over the rand host seam (canonical: rand-int truncates toward zero).
|
||||
|
||||
# ============================================================
|
||||
# Comparison
|
||||
|
|
@ -1287,19 +1288,8 @@
|
|||
|
||||
# (sort-by keyfn coll) or (sort-by keyfn comparator coll). The comparator (when
|
||||
# given) compares the KEYS and may return a boolean or a Clojure-style number.
|
||||
(defn core-sort-by [keyfn & rest]
|
||||
(def keyfn (as-fn keyfn))
|
||||
(let [has-cmp (> (length rest) 1)
|
||||
coll (if has-cmp (in rest 1) (first rest))]
|
||||
(if (nil? coll) (tuple)
|
||||
(let [c (realize-for-iteration coll)
|
||||
arr (if (tuple? c) (array/slice c) (array/slice c))]
|
||||
(if has-cmp
|
||||
(let [cmp (first rest)]
|
||||
(sort arr (fn [x y] (let [r (cmp (keyfn x) (keyfn y))]
|
||||
(if (number? r) (< r 0) (truthy? r))))))
|
||||
(sort-by keyfn arr))
|
||||
(tuple/slice (tuple ;arr))))))
|
||||
# sort-by now lives in the Clojure collection tier — canonical: compare-
|
||||
# defaulted (nil sorts first), comparator over KEYS, via the host sort seam.
|
||||
|
||||
# distinct now lives in the Clojure lazy tier (core/40-lazy.clj).
|
||||
# group-by / frequencies now live in the Clojure collection tier
|
||||
|
|
@ -2349,16 +2339,7 @@
|
|||
(core-sorted? coll) ((sorted-op coll :rseq) coll)
|
||||
(error (string "rseq requires a vector or sorted collection, got " (type coll)))))
|
||||
|
||||
(defn core-shuffle [coll]
|
||||
(when (not (core-coll? coll)) (error (string "shuffle requires a collection, got " (type coll))))
|
||||
(let [c (array/slice (realize-for-iteration coll))]
|
||||
(var i (- (length c) 1))
|
||||
(while (> i 0)
|
||||
(let [j (math/floor (* (math/random) (+ i 1)))
|
||||
tmp (in c i)]
|
||||
(put c i (in c j)) (put c j tmp))
|
||||
(-- i))
|
||||
(tuple/slice (tuple ;c))))
|
||||
|
||||
|
||||
# some-fn now lives in the Clojure collection tier (core/20-coll.clj).
|
||||
|
||||
|
|
@ -2439,10 +2420,9 @@
|
|||
{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"})
|
||||
(defn core-char-escape-string [c]
|
||||
(get char-escapes (if (core-char? c) (char-code c) c)))
|
||||
(defn core-char-name-string [c]
|
||||
(get char-names (if (core-char? c) (char-code c) c)))
|
||||
# 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),
|
||||
|
|
@ -2632,15 +2612,7 @@
|
|||
|
||||
(defn core-prefers [mm-var] (or (get mm-var :jolt/prefers) {}))
|
||||
|
||||
(defn core-random-uuid
|
||||
"A random version-4 UUID value: zero-padded hex groups (8-4-4-4-12), version
|
||||
nibble 4, variant nibble 8-b (RFC 4122)."
|
||||
[]
|
||||
(defn hx4 [] (string/format "%04x" (math/floor (* (math/random) 0x10000))))
|
||||
(defn hx3 [] (string/format "%03x" (math/floor (* (math/random) 0x1000))))
|
||||
(def variant (string/format "%x" (+ 8 (math/floor (* (math/random) 4)))))
|
||||
(make-uuid (string (hx4) (hx4) "-" (hx4) "-4" (hx3)
|
||||
"-" variant (hx3) "-" (hx4) (hx4) (hx4))))
|
||||
|
||||
|
||||
(defn- hex-digit? [c]
|
||||
(or (and (>= c 48) (<= c 57)) # 0-9
|
||||
|
|
@ -2703,7 +2675,6 @@
|
|||
"rem" core-rem
|
||||
"quot" core-quot
|
||||
"rand" core-rand
|
||||
"rand-int" core-rand-int
|
||||
"=" core-=
|
||||
"not=" core-not=
|
||||
"<" core-<
|
||||
|
|
@ -2774,7 +2745,6 @@
|
|||
"hash-ordered-coll" core-hash-ordered-coll
|
||||
"hash-unordered-coll" core-hash-unordered-coll
|
||||
"prefers" core-prefers
|
||||
"random-uuid" core-random-uuid
|
||||
"gensym" gensym
|
||||
"int?" core-integer?
|
||||
"compare" core-compare
|
||||
|
|
@ -2803,7 +2773,6 @@
|
|||
"reduced" core-reduced
|
||||
"reduced?" core-reduced?
|
||||
"rseq" core-rseq
|
||||
"shuffle" core-shuffle
|
||||
"ifn?" core-ifn?
|
||||
"ex-info" core-ex-info
|
||||
"__with-out-str" core-with-out-str
|
||||
|
|
@ -2816,7 +2785,6 @@
|
|||
"concat" core-concat
|
||||
"nth" core-nth
|
||||
"sort" core-sort
|
||||
"sort-by" core-sort-by
|
||||
"partition" core-partition
|
||||
"range" core-range
|
||||
"identity" core-identity
|
||||
|
|
@ -2929,8 +2897,6 @@
|
|||
"construct-proxy" core-construct-proxy
|
||||
"init-proxy" core-init-proxy
|
||||
"get-proxy-class" core-get-proxy-class
|
||||
"char-escape-string" core-char-escape-string
|
||||
"char-name-string" core-char-name-string
|
||||
# Bit operations
|
||||
"bit-and" core-bit-and
|
||||
"bit-or" core-bit-or
|
||||
|
|
|
|||
|
|
@ -134,3 +134,31 @@
|
|||
["take-nth lazy" "(quote (0 3 6))" "(take 3 (take-nth 3 (range)))"]
|
||||
["take-nth xform" "[1 3 5]" "(vec (sequence (take-nth 2) [1 2 3 4 5 6]))"]
|
||||
["take-nth into" "[1 4]" "(into [] (take-nth 3) [1 2 3 4 5])"])
|
||||
|
||||
# Phase 2 leaf batch 4 (jolt-ded): sort-by (canonical: compare-defaulted, over
|
||||
# the host sort seam), rand-int (canonical truncation via int), pure
|
||||
# Fisher-Yates shuffle, random-uuid over parse-uuid, char tables as
|
||||
# char-keyed Clojure maps. rand and sort stay: they ARE the host seams.
|
||||
(defspec "clojure.core / leaf batch 4"
|
||||
["sort-by keyfn" "[[1 :b] [2 :a]]" "(sort-by first [[2 :a] [1 :b]])"]
|
||||
["sort-by string keys" "(quote (\"a\" \"bb\" \"ccc\"))" "(sort-by count [\"ccc\" \"a\" \"bb\"])"]
|
||||
["sort-by comparator" "[3 2 1]" "(sort-by identity > [1 3 2])"]
|
||||
["sort-by 3way cmp" "[3 2 1]" "(sort-by identity (fn [a b] (- b a)) [1 3 2])"]
|
||||
["sort-by mixed nil" "[nil 1 2]" "(sort-by identity [2 nil 1])"]
|
||||
["sort-by empty" "()" "(sort-by first [])"]
|
||||
["sort-by nil coll" "()" "(sort-by first nil)"]
|
||||
["rand-int range" "true" "(every? (fn [_] (let [r (rand-int 5)] (and (int? r) (<= 0 r 4)))) (range 50))"]
|
||||
["rand-int zero" "0" "(rand-int 1)"]
|
||||
["shuffle is permutation" "true" "(= (sort (shuffle [5 3 1 4 2])) [1 2 3 4 5])"]
|
||||
["shuffle returns vector" "true" "(vector? (shuffle [1 2 3]))"]
|
||||
["shuffle empty" "[]" "(shuffle [])"]
|
||||
["shuffle non-coll throws" :throws "(shuffle 5)"]
|
||||
["random-uuid is uuid" "true" "(uuid? (random-uuid))"]
|
||||
["random-uuid v4 shape" "true" "(boolean (re-matches #\"[0-9a-f]{8}-[0-9a-f]{4}-4[0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}\" (str (random-uuid))))"]
|
||||
["random-uuid distinct" "true" "(not= (random-uuid) (random-uuid))"]
|
||||
["char-escape newline" "\"\\\\n\"" "(char-escape-string \\newline)"]
|
||||
["char-escape quote" "true" "(= 2 (count (char-escape-string \\\")))"]
|
||||
["char-escape none" "nil" "(char-escape-string \\a)"]
|
||||
["char-name space" "\"space\"" "(char-name-string \\space)"]
|
||||
["char-name newline" "\"newline\"" "(char-name-string \\newline)"]
|
||||
["char-name none" "nil" "(char-name-string \\a)"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue