Clojure 1.13 parity: req!, checked-keys destructuring, keyword array maps
Bring the language up to the 1.13.0-alpha1 changes that apply off the JVM: - req! (CLJ-2949): a get-variant that throws "Expected key: k" on a missing key, without nil-punning. The primitive behind checked destructuring. - Checked-keys destructuring (CLJ-2961): :keys!/:syms!/:strs! bind and throw when a key is absent; keys after & are declared-only (required for the ! variants, accepted otherwise) and create no binding. - & is no longer a legal local binding in let/loop (CLJ-2954). - Keyword-only array maps grow to 64 entries before going hash (was 8), across the literal, assoc, and transient paths, so the common keyword map keeps insertion order up to 64. Skipped CLJ-2891 (JVM __init bytecode, JVM-only). 1.13 is still alpha, so this tracks alpha1 and may shift. Regression tests in test/chez/unit.edn (ahead of the JVM 1.12.5 the corpus certifies against). Seed re-minted.
This commit is contained in:
parent
1ed9656a0c
commit
403c3f302f
7 changed files with 600 additions and 508 deletions
|
|
@ -298,8 +298,21 @@
|
|||
(define empty-pmap-hash (make-pmap empty-hnode 0 #f)) ; hash-order backing (sets)
|
||||
(define pmap-absent (list 'absent)) ; unique missing-key sentinel
|
||||
;; PersistentArrayMap threshold: assoc of a new key promotes to hash mode once the
|
||||
;; map already holds 8 entries (array.length >= 16 in the reference).
|
||||
;; map already holds 8 entries (array.length >= 16 in the reference). Clojure 1.13
|
||||
;; raised the limit to 64 for maps whose keys are ALL keywords (the common
|
||||
;; keyword-map case); mixed-key maps still cap at 8.
|
||||
(define array-map-limit 8)
|
||||
(define array-map-limit-kw 64)
|
||||
(define (all-keywords? ks)
|
||||
(or (null? ks) (and (keyword? (car ks)) (all-keywords? (cdr ks)))))
|
||||
;; Should a map of `cnt` entries with insertion order `ord` stay in array mode
|
||||
;; when key `k` is added? Under 8 always; a keyword-only map (existing keys + the
|
||||
;; new key all keywords) grows to 64; otherwise it caps at 8.
|
||||
(define (pmap-array-keep? cnt ord k)
|
||||
(cond ((fx<? cnt array-map-limit) #t)
|
||||
((fx>=? cnt array-map-limit-kw) #f)
|
||||
((and (keyword? k) (all-keywords? ord)) #t)
|
||||
(else #f)))
|
||||
(define (append-key ord k) (append ord (list k)))
|
||||
(define (remove-key ord k) (let loop ((o ord)) (cond ((null? o) '()) ((jolt= (car o) k) (cdr o)) (else (cons (car o) (loop (cdr o)))))))
|
||||
|
||||
|
|
@ -310,7 +323,7 @@
|
|||
(let* ((added (box #f)) (r (node-assoc (pmap-root m) 0 (key-hash k) k v added))
|
||||
(cnt (pmap-cnt m)) (ord (pmap-order m)))
|
||||
(if (unbox added)
|
||||
(if (and ord (fx<? cnt array-map-limit))
|
||||
(if (and ord (pmap-array-keep? cnt ord k))
|
||||
(make-pmap r (fx+ cnt 1) (append-key ord k))
|
||||
(make-pmap r (fx+ cnt 1) #f))
|
||||
(make-pmap r cnt ord))))
|
||||
|
|
@ -352,10 +365,14 @@
|
|||
(let loop ((ks ord) (a acc))
|
||||
(if (null? ks) a (loop (cdr ks) (proc (car ks) (pmap-get m (car ks) jolt-nil) a))))
|
||||
(node-fold (pmap-root m) proc acc))))
|
||||
;; map LITERAL ({...}): array map up to 8 entries, hash map beyond (RT.map).
|
||||
;; map LITERAL ({...}): array map up to 8 entries (64 if keyword-only, per 1.13),
|
||||
;; hash map beyond (RT.map).
|
||||
(define (jolt-hash-map . kvs)
|
||||
(let loop ((m empty-pmap) (kvs kvs))
|
||||
(cond ((null? kvs) (if (fx>? (pmap-cnt m) array-map-limit) (pmap->hash m) m))
|
||||
(cond ((null? kvs)
|
||||
(let ((cnt (pmap-cnt m)) (ord (pmap-order m)))
|
||||
(if (fx>? cnt (if (all-keywords? ord) array-map-limit-kw array-map-limit))
|
||||
(pmap->hash m) m)))
|
||||
((null? (cdr kvs)) (error 'hash-map "odd number of map literal entries"))
|
||||
(else (loop (pmap-put-ordered m (car kvs) (cadr kvs)) (cddr kvs))))))
|
||||
;; array-map ctor: insertion-ordered regardless of size (createAsIfByAssoc).
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
|
@ -86,7 +86,11 @@
|
|||
(if (fx<? i cnt) (begin (vector-set! out i (vector-ref buf i)) (loop (fx+ i 1)))
|
||||
(make-pvec out)))))))
|
||||
((map)
|
||||
(let* ((ht (jolt-transient-buf t)) (cnt (hashtable-size ht)) (cap (jolt-transient-n t)))
|
||||
(let* ((ht (jolt-transient-buf t)) (cnt (hashtable-size ht)) (cap (jolt-transient-n t))
|
||||
;; Clojure 1.13: a keyword-only map stays an array map up to 64 entries,
|
||||
;; so a keyword map built through a transient (into {} …) keeps insertion
|
||||
;; order to 64, matching the literal/assoc paths.
|
||||
(cap (if (all-keywords? (jolt-transient-ord t)) (fxmax array-map-limit-kw cap) cap)))
|
||||
(if (fx>? cnt cap)
|
||||
;; promoted past the array capacity: hash order
|
||||
(let ((m empty-pmap-hash))
|
||||
|
|
|
|||
|
|
@ -188,9 +188,23 @@
|
|||
[false nil]
|
||||
(if or-map (keys or-map) [])))
|
||||
amp? (fn* [x] (and (symbol? x) (= "&" (name x))))
|
||||
;; split a :keys/:syms/:strs name list at & into [sym bind?] pairs. Names
|
||||
;; before & bind normally (bind? true); names after & are declared-only
|
||||
;; (bind? false) — accepted keys (:keys) or required keys (:keys!), per
|
||||
;; CLJ-2961.
|
||||
classify
|
||||
(fn* [names]
|
||||
(nth (reduce (fn* [st x]
|
||||
(if (amp? x)
|
||||
[(nth st 0) false]
|
||||
[(conj (nth st 0) [x (nth st 1)]) (nth st 1)]))
|
||||
[[] true] names)
|
||||
0))
|
||||
proc
|
||||
(fn* proc [pat init acc]
|
||||
(cond
|
||||
;; CLJ-2954: & is reserved for destructuring rest, never a binding.
|
||||
(amp? pat) (throw (new IllegalArgumentException "Can't use & as a local binding"))
|
||||
(symbol? pat) (conj (conj acc pat) init)
|
||||
(vector? pat)
|
||||
(let* [g (symbol (str (gensym)))
|
||||
|
|
@ -231,30 +245,45 @@
|
|||
;; group binds a :keys/:strs/:syms list. dnsp is the destructuring
|
||||
;; namespace from a qualified key like :ns/keys — it both prefixes
|
||||
;; the lookup key and overrides a bare symbol's namespace.
|
||||
;; group binds a :keys/:strs/:syms list. checked? marks the
|
||||
;; :keys!/:strs!/:syms! variants (CLJ-2961): lookups use req!
|
||||
;; (throw on missing) instead of get. A pair is [sym bind?];
|
||||
;; bind? false (names after &) is declared-only — for checked
|
||||
;; groups it still runs req! (bound to a throwaway gensym) to
|
||||
;; enforce the key, for unchecked groups it's a no-op.
|
||||
group
|
||||
(fn* group [a names kind dnsp]
|
||||
(fn* group [a names kind dnsp checked?]
|
||||
(if names
|
||||
(reduce
|
||||
;; s is a symbol (a b) or a keyword (:a :b); name/
|
||||
;; namespace handle both, so :keys [:major] binds
|
||||
;; `major` looking up :major (str would keep the colon).
|
||||
(fn* [aa s]
|
||||
(let* [local (name s)
|
||||
(fn* [aa pair]
|
||||
(let* [s (nth pair 0)
|
||||
bind? (nth pair 1)
|
||||
local (name s)
|
||||
nsp (or (namespace s) dnsp)
|
||||
keyform (cond
|
||||
(= kind :kw) (keyword (if nsp (str nsp "/" local) local))
|
||||
(= kind :str) local
|
||||
:else `(quote ~(symbol nsp local)))
|
||||
fo (find-or or-map local)]
|
||||
(conj (conj aa (symbol local))
|
||||
(if (nth fo 0)
|
||||
`(get ~gm ~keyform ~(nth fo 1))
|
||||
`(get ~gm ~keyform)))))
|
||||
a names)
|
||||
fo (find-or or-map local)
|
||||
lookup (cond
|
||||
checked? `(req! ~gm ~keyform)
|
||||
(nth fo 0) `(get ~gm ~keyform ~(nth fo 1))
|
||||
:else `(get ~gm ~keyform))]
|
||||
(cond
|
||||
bind? (conj (conj aa (symbol local)) lookup)
|
||||
checked? (conj (conj aa (symbol (str (gensym)))) lookup)
|
||||
:else aa)))
|
||||
a (classify names))
|
||||
a))
|
||||
g1 (group base (get pat :keys) :kw nil)
|
||||
g2 (group g1 (get pat :strs) :str nil)
|
||||
g3 (group g2 (get pat :syms) :sym nil)]
|
||||
g1 (group base (get pat :keys) :kw nil false)
|
||||
g2 (group g1 (get pat :strs) :str nil false)
|
||||
g3 (group g2 (get pat :syms) :sym nil false)
|
||||
g4 (group g3 (get pat :keys!) :kw nil true)
|
||||
g5 (group g4 (get pat :strs!) :str nil true)
|
||||
g6 (group g5 (get pat :syms!) :sym nil true)]
|
||||
;; remaining keys: a qualified :ns/keys|:ns/strs|:ns/syms groups under
|
||||
;; its namespace; any other keyword is skipped; a non-keyword is a
|
||||
;; nested binding pattern.
|
||||
|
|
@ -262,9 +291,12 @@
|
|||
(if (keyword? k)
|
||||
(let* [kn (name k) kns (namespace k)]
|
||||
(cond
|
||||
(and kns (= kn "keys")) (group a (get pat k) :kw kns)
|
||||
(and kns (= kn "strs")) (group a (get pat k) :str kns)
|
||||
(and kns (= kn "syms")) (group a (get pat k) :sym kns)
|
||||
(and kns (= kn "keys")) (group a (get pat k) :kw kns false)
|
||||
(and kns (= kn "strs")) (group a (get pat k) :str kns false)
|
||||
(and kns (= kn "syms")) (group a (get pat k) :sym kns false)
|
||||
(and kns (= kn "keys!")) (group a (get pat k) :kw kns true)
|
||||
(and kns (= kn "strs!")) (group a (get pat k) :str kns true)
|
||||
(and kns (= kn "syms!")) (group a (get pat k) :sym kns true)
|
||||
:else a))
|
||||
;; a direct binding {x :x}: apply its :or default
|
||||
;; (keyed by the local symbol) when the key is absent.
|
||||
|
|
@ -273,7 +305,7 @@
|
|||
`(get ~gm ~(get pat k) ~(nth fo 1))
|
||||
`(get ~gm ~(get pat k)))
|
||||
a))))
|
||||
g3 (keys pat)))
|
||||
g6 (keys pat)))
|
||||
:else (throw (str "unsupported destructuring pattern: " (pr-str pat)))))
|
||||
ploop
|
||||
(fn* ploop [i acc]
|
||||
|
|
|
|||
|
|
@ -89,6 +89,21 @@
|
|||
(recur nxt (next ks))))
|
||||
m)))))
|
||||
|
||||
(defn req!
|
||||
"Returns the value mapped to key k in map m, like `get`, but throws
|
||||
IllegalArgumentException when k is not present. Unlike `get`, does not nil-pun:
|
||||
a key present with a nil value returns nil, an absent key throws. The primitive
|
||||
behind checked-keys destructuring (:keys! / :syms! / :strs!)."
|
||||
{:added "1.13"}
|
||||
[m k]
|
||||
;; a fresh map is its own identity, so a present-but-nil value is distinguished
|
||||
;; from an absent key (same trick as get-in's sentinel).
|
||||
(let [sentinel (hash-map)
|
||||
v (get m k sentinel)]
|
||||
(if (identical? sentinel v)
|
||||
(throw (new IllegalArgumentException (str "Expected key: " k)))
|
||||
v)))
|
||||
|
||||
;; find-based, so nil RESULTS are cached too; args canonicalize as a collection key.
|
||||
(defn memoize [f]
|
||||
(let [mem (atom (hash-map))]
|
||||
|
|
|
|||
|
|
@ -576,4 +576,26 @@
|
|||
{:suite "deftype-method" :expr "(do (defprotocol P (m [_ o])) (defrecord R [n] P (m [_ _] n)) (m (->R 5) :x))" :expected "5"}
|
||||
{:suite "deftype-method" :expr "(do (defprotocol P2 (m2 [_ o])) (deftype T [n] P2 (m2 [_ _] n)) (m2 (->T 7) :x))" :expected "7"}
|
||||
{:suite "protocol-host" :expr "(do (defprotocol Q (e [_])) (extend-protocol Q clojure.lang.Var (e [_] :var)) [(satisfies? Q (var map)) (e (var map))])" :expected "[true :var]"}
|
||||
|
||||
;; Clojure 1.13 (1.13.0-alpha1) parity. Ahead of the JVM 1.12.5 the corpus
|
||||
;; certifies against, so these live here rather than as certified corpus rows.
|
||||
{:suite "clj-1.13 req!" :expr "(req! {:a 1} :a)" :expected "1"}
|
||||
{:suite "clj-1.13 req!" :expr "(req! [10 20 30] 1)" :expected "20"}
|
||||
{:suite "clj-1.13 req!" :expr "(nil? (req! {:a nil} :a))" :expected "true"}
|
||||
{:suite "clj-1.13 req!" :expr "(req! {:a 1} :b)" :expected :throws}
|
||||
{:suite "clj-1.13 amp-binding" :expr "(let [& 42] &)" :expected :throws}
|
||||
{:suite "clj-1.13 amp-binding" :expr "(loop [& 42] &)" :expected :throws}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a b]} {:a 1 :b 2}] [a b])" :expected "[1 2]"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a b]} {:a 1}] [a b])" :expected :throws}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(nil? (let [{:keys! [a]} {:a nil}] a))" :expected "true"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:strs! [a]} {\"a\" 5}] a)" :expected "5"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a & b]} {:a 1 :b 2}] a)" :expected "1"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:keys! [a & b]} {:a 1}] a)" :expected :throws}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:keys [a & b]} {:a 1 :b 2}] a)" :expected "1"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:foo/keys! [a]} {:foo/a 7}] a)" :expected "7"}
|
||||
{:suite "clj-1.13 checked-keys" :expr "(let [{:foo/keys! [a]} {}] a)" :expected :throws}
|
||||
{:suite "clj-1.13 array-map-64" :expr "(keys {:a 1 :b 2 :c 3 :d 4 :e 5 :f 6 :g 7 :h 8 :i 9 :j 10})" :expected "(:a :b :c :d :e :f :g :h :i :j)"}
|
||||
{:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 20)) (keys (into {} (map (fn [i] [(keyword (str \"k\" i)) i]) (range 20)))))" :expected "true"}
|
||||
{:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 64)) (keys (reduce (fn [m i] (assoc m (keyword (str \"k\" i)) i)) {} (range 64))))" :expected "true"}
|
||||
{:suite "clj-1.13 array-map-64" :expr "(= (map (fn [i] (keyword (str \"k\" i))) (range 65)) (keys (into {} (map (fn [i] [(keyword (str \"k\" i)) i]) (range 65)))))" :expected "false"}
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue