fix: value-semantics for collection keys/elements; set literals evaluate

Close jolt-do7. Maps/sets keyed by a collection (a map, vector, ...) now compare
by value instead of Janet identity:
- PHM/PHS hash and compare keys through an injected canonicalizer (collection
  keys -> value-hashable struct/tuple); keys are still stored as-is
- map literals and core-assoc promote to a phm when a key is a collection
- frequencies/group-by use a phm base so collection elements/keys dedup by value
- set equality is value-based (from earlier)

Real bugs found and fixed along the way:
- set literals #{(inc 1)} did not evaluate their elements (stored raw forms!)
- the REPL printer rendered phm maps as {} (they hit the deftype branch); now a
  phm branch prints entries

Added spec cases (maps/collection-keys, sets/literals & value elements).
conformance 218/218, jpm test green.
This commit is contained in:
Yogthos 2026-06-05 01:02:00 -04:00
parent ad5539b0de
commit 0db7eb6ac8
6 changed files with 102 additions and 17 deletions

View file

@ -40,6 +40,25 @@
[xs] [xs]
(if mutable? (array ;xs) (pv-from-indexed xs))) (if mutable? (array ;xs) (pv-from-indexed xs)))
# 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))
(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)
(defn realize-for-iteration [c] (defn realize-for-iteration [c]
"Normalize a seqable to a Janet array/tuple for iteration: pvec -> array, "Normalize a seqable to a Janet array/tuple for iteration: pvec -> array,
set -> seq, lazy-seq -> realized array; others pass through. Warning: will set -> seq, lazy-seq -> realized array; others pass through. Warning: will
@ -306,9 +325,20 @@
(if (= idx (length result)) (array/push result v) (put result idx v))) (if (= idx (length result)) (array/push result v) (put result idx v)))
(+= i 2)) (+= i 2))
(if (tuple? m) (tuple/slice (tuple ;result)) result)) (if (tuple? m) (tuple/slice (tuple ;result)) result))
(do (var result @{}) (when m (each k (keys m) (put result k (get m k)))) # map (struct/table). If any key is a collection, a Janet struct/table keys
(var i 0) (while (< i (length kvs)) (let [k (kvs i) v (kvs (+ i 1))] (put result k v) (+= i 2))) # it by identity — promote to a phm so such keys compare by value.
(if (struct? m) (table/to-struct result) result)))) (let [coll-key (do (var c false) (var i 0)
(while (< i (length kvs))
(when (let [k (in kvs i)] (or (table? k) (array? k))) (set c true))
(+= i 2)) c)]
(if coll-key
(do (var result (make-phm))
(when m (each k (keys m) (set result (phm-assoc result k (get m k)))))
(var i 0) (while (< i (length kvs)) (set result (phm-assoc result (in kvs i) (in kvs (+ i 1)))) (+= i 2))
result)
(do (var result @{}) (when m (each k (keys m) (put result k (get m k))))
(var i 0) (while (< i (length kvs)) (let [k (kvs i) v (kvs (+ i 1))] (put result k v) (+= i 2)))
(if (struct? m) (table/to-struct result) result))))))
(defn core-dissoc [m & ks] (defn core-dissoc [m & ks]
(if (phm? m) (if (phm? m)
@ -985,18 +1015,19 @@
(if (jvec? coll) (make-vec result) result))))) (if (jvec? coll) (make-vec result) result)))))
(defn core-group-by [f coll] (defn core-group-by [f coll]
(var result @{}) # phm base so collection keys group by value
(var c (realize-for-iteration coll)) (var result (make-phm))
(each x c (each x (realize-for-iteration coll)
(let [k (f x)] (let [k (f x)]
(put result k (array/push (core-get result k @[]) x)))) (set result (phm-assoc result k (array/push (phm-get result k @[]) x)))))
result) result)
(defn core-frequencies [coll] (defn core-frequencies [coll]
(var result @{}) # phm base so collection elements are counted by value
(var result (make-phm))
(each x (realize-for-iteration coll) (each x (realize-for-iteration coll)
(put result x (+ 1 (get result x 0)))) (set result (phm-assoc result x (+ 1 (phm-get result x 0)))))
(table/to-struct result)) result)
(defn core-partition (defn core-partition
"(partition n coll) or (partition n step coll). Only complete partitions of "(partition n coll) or (partition n step coll). Only complete partitions of

View file

@ -1295,7 +1295,8 @@
(if (= :jolt/char (form :jolt/type)) (if (= :jolt/char (form :jolt/type))
form form
(if (= :jolt/set (form :jolt/type)) (if (= :jolt/set (form :jolt/type))
(apply make-phs (form :value)) # evaluate each element (set literals like #{(inc 1)} must compute)
(apply make-phs (map |(eval-form ctx bindings $) (form :value)))
(if (= :jolt/tagged (form :jolt/type)) (if (= :jolt/tagged (form :jolt/type))
(let [tag (form :tag) (let [tag (form :tag)
data-readers (get (ctx :env) :data-readers) data-readers (get (ctx :env) :data-readers)
@ -1312,7 +1313,19 @@
(each k (keys form) (each k (keys form)
(array/push kvs (eval-form ctx bindings k)) (array/push kvs (eval-form ctx bindings k))
(array/push kvs (eval-form ctx bindings (get form k)))) (array/push kvs (eval-form ctx bindings (get form k))))
(struct ;kvs))))))) # If any key is a collection (a Janet table/array — phm/pvec/plist/
# record/list), a Janet struct would key it by identity; use a phm so
# such keys compare by value.
(var coll-key false)
(var ki 0)
(while (< ki (length kvs))
(let [kk (in kvs ki)] (when (or (table? kk) (array? kk)) (set coll-key true)))
(+= ki 2))
(if coll-key
(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))))))))
(array? form) (array? form)
(if (= 0 (length form)) (if (= 0 (length form))
@[] @[]

View file

@ -101,6 +101,15 @@
(write-value k buf)) (write-value k buf))
(push-str buf "}")) (push-str buf "}"))
(phm? v)
(do
(push-str buf "{")
(var first? true)
(each pair (phm-entries v)
(if first? (set first? false) (push-str buf ", "))
(write-value (in pair 0) buf) (push-str buf " ") (write-value (in pair 1) buf))
(push-str buf "}"))
(and (table? v) (= :jolt/regex (v :jolt/type))) (and (table? v) (= :jolt/regex (v :jolt/type)))
(do (push-str buf "#\"") (push-str buf (v :source)) (push-str buf "\"")) (do (push-str buf "#\"") (push-str buf (v :source)) (push-str buf "\""))

View file

@ -7,27 +7,44 @@
(and (table? x) (and (table? x)
(= "jolt.lang.persistent-hash-map.PersistentHashMap" (x :jolt/deftype)))) (= "jolt.lang.persistent-hash-map.PersistentHashMap" (x :jolt/deftype))))
# Keys are hashed and compared by VALUE. Scalars (keywords/strings/numbers) are
# value-hashable in Janet already, but collection keys (a phm/pvec/plist map or
# vector) are Janet tables hashed by identity — so they're canonicalized to a
# value-hashable struct/tuple first. `canonicalize-key` is injected by core (which
# knows the pvec/plist/phm types); phm stays dependency-free. Keys are still
# *stored* as-is, so retrieval and iteration return the original key objects.
(var canonicalize-key nil)
(defn set-canonicalize-key!
"Install the value-canonicalizer for collection keys (called by core)."
[f]
(set canonicalize-key f))
(defn- ck [k]
(if (and canonicalize-key (or (table? k) (struct? k) (array? k) (tuple? k)))
(canonicalize-key k)
k))
(defn- key= [a b] (= (ck a) (ck b)))
(defn phm-hash-key [k] (defn phm-hash-key [k]
(if (nil? k) 0 (mod (hash k) bucket-count))) (if (nil? k) 0 (mod (hash (ck k)) bucket-count)))
(defn- phm-bucket-find [bucket k] (defn- phm-bucket-find [bucket k]
(var i 0) (var n (length bucket)) (var found nil) (var i 0) (var n (length bucket)) (var found nil)
(while (< i n) (while (< i n)
(if (= k (in bucket i)) (do (set found (in bucket (+ i 1))) (break))) (if (key= k (in bucket i)) (do (set found (in bucket (+ i 1))) (break)))
(+= i 2)) (+= i 2))
found) found)
(defn phm-bucket-contains? [bucket k] (defn phm-bucket-contains? [bucket k]
(var i 0) (var n (length bucket)) (var found false) (var i 0) (var n (length bucket)) (var found false)
(while (< i n) (while (< i n)
(if (= k (in bucket i)) (do (set found true) (break))) (if (key= k (in bucket i)) (do (set found true) (break)))
(+= i 2)) (+= i 2))
found) found)
(defn- phm-bucket-assoc [bucket k v] (defn- phm-bucket-assoc [bucket k v]
(var i 0) (var n (length bucket)) (var found-i nil) (var i 0) (var n (length bucket)) (var found-i nil)
(while (< i n) (while (< i n)
(if (= k (in bucket i)) (do (set found-i i) (break))) (if (key= k (in bucket i)) (do (set found-i i) (break)))
(+= i 2)) (+= i 2))
(if (not (nil? found-i)) (if (not (nil? found-i))
(let [nb @[]] (var j 0) (let [nb @[]] (var j 0)
@ -39,7 +56,7 @@
(defn- phm-bucket-dissoc [bucket k] (defn- phm-bucket-dissoc [bucket k]
(var i 0) (var n (length bucket)) (var found-i nil) (var i 0) (var n (length bucket)) (var found-i nil)
(while (< i n) (while (< i n)
(if (= k (in bucket i)) (do (set found-i i) (break))) (if (key= k (in bucket i)) (do (set found-i i) (break)))
(+= i 2)) (+= i 2))
(if (nil? found-i) bucket (if (nil? found-i) bucket
(if (= n 2) nil (if (= n 2) nil

View file

@ -54,3 +54,11 @@
["count of nil map" "0" "(count nil)"] ["count of nil map" "0" "(count nil)"]
["get from nil" "nil" "(get nil :a)"] ["get from nil" "nil" "(get nil :a)"]
["immutability" "true" "(let [m {:a 1} n (assoc m :b 2)] (and (= m {:a 1}) (= n {:a 1 :b 2})))"]) ["immutability" "true" "(let [m {:a 1} n (assoc m :b 2)] (and (= m {:a 1}) (= n {:a 1 :b 2})))"])
(defspec "map / collection keys (by value)"
["vector key literal" ":v" "(get {[1 2] :v} [1 2])"]
["map key literal" ":v" "(get {(hash-map :a 1) :v} {:a 1})"]
["assoc vector key" ":v" "(get (assoc {} [1 2] :v) [1 2])"]
["key across repr" ":v" "(get (assoc {} (vec [1 2]) :v) [1 2])"]
["frequencies of maps" "2" "(get (frequencies [{:a 1} (hash-map :a 1)]) {:a 1})"]
["group-by collection key" "1" "(count (group-by identity [{:a 1} (hash-map :a 1)]))"])

View file

@ -23,6 +23,13 @@
["set as fn present" "2" "(#{1 2 3} 2)"] ["set as fn present" "2" "(#{1 2 3} 2)"]
["set as fn missing" "nil" "(#{1 2 3} 9)"]) ["set as fn missing" "nil" "(#{1 2 3} 9)"])
(defspec "set / literals & value elements"
["literal evaluates elements" "#{2 4}" "#{(inc 1) (* 2 2)}"]
["map elements by value" "true" "(= #{{:a 1}} #{(hash-map :a 1)})"]
["contains? map by value" "true" "(contains? #{(hash-map :x 1)} {:x 1})"]
["dedup equal maps" "1" "(count (set [{:a 1} (hash-map :a 1)]))"]
["vector elements" "true" "(contains? #{[1 2]} (vec [1 2]))"])
(defspec "clojure.set" (defspec "clojure.set"
["union" "#{1 2 3 4}" "(do (require (quote [clojure.set :as s])) (s/union #{1 2} #{3 4}))"] ["union" "#{1 2 3 4}" "(do (require (quote [clojure.set :as s])) (s/union #{1 2} #{3 4}))"]
["intersection" "#{2}" "(do (require (quote [clojure.set :as s])) (s/intersection #{1 2} #{2 3}))"] ["intersection" "#{2}" "(do (require (quote [clojure.set :as s])) (s/intersection #{1 2} #{2 3}))"]