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]
(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]
"Normalize a seqable to a Janet array/tuple for iteration: pvec -> array,
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)))
(+= i 2))
(if (tuple? m) (tuple/slice (tuple ;result)) 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))))
# map (struct/table). If any key is a collection, a Janet struct/table keys
# it by identity — promote to a phm so such keys compare by value.
(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]
(if (phm? m)
@ -985,18 +1015,19 @@
(if (jvec? coll) (make-vec result) result)))))
(defn core-group-by [f coll]
(var result @{})
(var c (realize-for-iteration coll))
(each x c
# phm base so collection keys group by value
(var result (make-phm))
(each x (realize-for-iteration coll)
(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)
(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)
(put result x (+ 1 (get result x 0))))
(table/to-struct result))
(set result (phm-assoc result x (+ 1 (phm-get result x 0)))))
result)
(defn core-partition
"(partition n coll) or (partition n step coll). Only complete partitions of

View file

@ -1295,7 +1295,8 @@
(if (= :jolt/char (form :jolt/type))
form
(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))
(let [tag (form :tag)
data-readers (get (ctx :env) :data-readers)
@ -1312,7 +1313,19 @@
(each k (keys form)
(array/push kvs (eval-form ctx bindings 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)
(if (= 0 (length form))
@[]

View file

@ -101,6 +101,15 @@
(write-value k 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)))
(do (push-str buf "#\"") (push-str buf (v :source)) (push-str buf "\""))

View file

@ -7,27 +7,44 @@
(and (table? x)
(= "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]
(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]
(var i 0) (var n (length bucket)) (var found nil)
(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))
found)
(defn phm-bucket-contains? [bucket k]
(var i 0) (var n (length bucket)) (var found false)
(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))
found)
(defn- phm-bucket-assoc [bucket k v]
(var i 0) (var n (length bucket)) (var found-i nil)
(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))
(if (not (nil? found-i))
(let [nb @[]] (var j 0)
@ -39,7 +56,7 @@
(defn- phm-bucket-dissoc [bucket k]
(var i 0) (var n (length bucket)) (var found-i nil)
(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))
(if (nil? found-i) bucket
(if (= n 2) nil