diff --git a/src/jolt/core.janet b/src/jolt/core.janet index b5a9fcb..12bdc63 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -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 diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 392c247..e3fe5d1 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -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)) @[] diff --git a/src/jolt/main.janet b/src/jolt/main.janet index 8206e8b..1bfd558 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -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 "\"")) diff --git a/src/jolt/phm.janet b/src/jolt/phm.janet index bc4e4a2..2a1e1ee 100644 --- a/src/jolt/phm.janet +++ b/src/jolt/phm.janet @@ -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 diff --git a/test/spec/maps-spec.janet b/test/spec/maps-spec.janet index 99ad019..ee01523 100644 --- a/test/spec/maps-spec.janet +++ b/test/spec/maps-spec.janet @@ -54,3 +54,11 @@ ["count of nil map" "0" "(count nil)"] ["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})))"]) + +(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)]))"]) diff --git a/test/spec/sets-spec.janet b/test/spec/sets-spec.janet index 587fe58..db707fa 100644 --- a/test/spec/sets-spec.janet +++ b/test/spec/sets-spec.janet @@ -23,6 +23,13 @@ ["set as fn present" "2" "(#{1 2 3} 2)"] ["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" ["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}))"]