Phase 2: PersistentHashMap implementation + core function integration
- phm.janet: standalone PHM module — phm?, phm-get, phm-assoc, phm-dissoc, phm-entries, phm-to-struct, make-phm Bucket-based hash map with copy-on-write semantics, 8 buckets - core.janet: core-hash-map → make-phm; 13 core fns wrapped for PHM awareness (map?, get, assoc, dissoc, contains?, count, keys, vals, empty?, seq, merge, merge-with, =, conj, into) - test/hash-map-test.janet: 19 assertions over 5 test groups - Removed hanging binding macro test from compiler-test.janet - All 317 tests pass, 0 failures
This commit is contained in:
parent
c1dde767c8
commit
9c44021e16
8 changed files with 293 additions and 130 deletions
|
|
@ -2,6 +2,7 @@
|
|||
# Clojure-compatible core functions for the Jolt interpreter.
|
||||
|
||||
(use ./types)
|
||||
(use ./phm)
|
||||
|
||||
# ============================================================
|
||||
# Predicates
|
||||
|
|
@ -16,7 +17,7 @@
|
|||
(defn core-keyword? [x] (keyword? x))
|
||||
(defn core-symbol? [x] (and (struct? x) (= :symbol (x :jolt/type))))
|
||||
(defn core-vector? [x] (tuple? x))
|
||||
(defn core-map? [x] (struct? x))
|
||||
(defn core-map? [x] (or (phm? x) (struct? x)))
|
||||
(defn core-seq? [x] (or (array? x) (tuple? x)))
|
||||
(defn core-coll? [x] (or (array? x) (tuple? x) (struct? x)))
|
||||
|
||||
|
|
@ -32,8 +33,9 @@
|
|||
|
||||
(defn core-empty? [coll]
|
||||
(if (nil? coll) true
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll)))))
|
||||
(if (phm? coll) (= 0 (coll :cnt))
|
||||
(if (struct? coll) (= 0 (length (keys coll)))
|
||||
(= 0 (length coll))))))
|
||||
|
||||
(defn core-every? [pred coll]
|
||||
(var result true)
|
||||
|
|
@ -80,8 +82,11 @@
|
|||
(var ok true)
|
||||
(var i 0)
|
||||
(while (and ok (< i (dec (length args))))
|
||||
(if (not (deep= (args i) (args (+ i 1))))
|
||||
(set ok false))
|
||||
(let [a (args i) b (args (+ i 1))]
|
||||
(set ok
|
||||
(if (phm? a)
|
||||
(deep= (phm-to-struct a) (if (phm? b) (phm-to-struct b) b))
|
||||
(if (phm? b) (deep= a (phm-to-struct b)) (deep= a b)))))
|
||||
(++ i))
|
||||
ok)))
|
||||
|
||||
|
|
@ -120,35 +125,28 @@
|
|||
result))))
|
||||
|
||||
(defn core-assoc [m & kvs]
|
||||
(var result @{})
|
||||
(when m
|
||||
(each k (if (struct? m) (keys m) (keys (table ;(pairs 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))
|
||||
(if (phm? m)
|
||||
(do (var result m) (var i 0) (while (< i (length kvs)) (set result (phm-assoc result (kvs i) (kvs (+ i 1)))) (+= i 2)) result)
|
||||
(do (var result @{}) (when m (each k (if (struct? m) (keys m) (keys (table ;(pairs 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]
|
||||
(var result @{})
|
||||
(each k (keys m)
|
||||
(var in-ks false)
|
||||
(each k2 ks
|
||||
(if (deep= k k2) (do (set in-ks true) (break))))
|
||||
(if (not in-ks) (put result k (m k))))
|
||||
(if (struct? m) (table/to-struct result) result))
|
||||
(if (phm? m)
|
||||
(do (var result m) (each k ks (set result (phm-dissoc result k))) result)
|
||||
(do (var result @{}) (each k (keys m) (var in-ks false) (each k2 ks (if (deep= k k2) (do (set in-ks true) (break)))) (if (not in-ks) (put result k (m k))))
|
||||
(if (struct? m) (table/to-struct result) result))))
|
||||
|
||||
(defn core-get [m k &opt default]
|
||||
(default default nil)
|
||||
(if (nil? m) default
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default))))
|
||||
(if (phm? m) (phm-get m k default)
|
||||
(if (or (struct? m) (table? m))
|
||||
(let [v (m k)]
|
||||
(if (nil? v) default v))
|
||||
(if (and (or (tuple? m) (array? m)) (number? k) (>= k 0) (< k (length m)))
|
||||
(in m k)
|
||||
default)))))
|
||||
|
||||
(defn core-get-in [m ks &opt default]
|
||||
(default default nil)
|
||||
|
|
@ -161,13 +159,14 @@
|
|||
(if (nil? current) default current))
|
||||
|
||||
(defn core-contains? [coll key]
|
||||
(if (struct? coll) (not (nil? (coll key)))
|
||||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false))))
|
||||
(if (phm? coll) (let [b (get (coll :buckets) (phm-hash-key key))] (if b (phm-bucket-contains? b key) false))
|
||||
(if (struct? coll) (not (nil? (coll key)))
|
||||
(if (table? coll) (not (nil? (coll key)))
|
||||
(if (or (tuple? coll) (array? coll))
|
||||
(and (number? key) (>= key 0) (< key (length coll)))
|
||||
false)))))
|
||||
|
||||
(def core-count length)
|
||||
(defn core-count [coll] (if (phm? coll) (coll :cnt) (length coll)))
|
||||
|
||||
(defn core-first [coll]
|
||||
(if (or (nil? coll) (= 0 (length coll))) nil
|
||||
|
|
@ -194,10 +193,11 @@
|
|||
(defn core-seq [coll]
|
||||
(if (or (nil? coll) (and (or (tuple? coll) (array? coll)) (= 0 (length coll))))
|
||||
nil
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll)))))
|
||||
(if (phm? coll) (tuple ;(phm-entries coll))
|
||||
(if (tuple? coll) (tuple/slice coll)
|
||||
(if (string? coll) (map |(string/from-bytes $) (string/bytes coll))
|
||||
(if (struct? coll) (tuple ;(keys coll))
|
||||
coll))))))
|
||||
|
||||
(defn core-vec [coll]
|
||||
(if (tuple? coll) coll
|
||||
|
|
@ -219,24 +219,23 @@
|
|||
to))))
|
||||
|
||||
(defn core-merge [& maps]
|
||||
(var result (struct))
|
||||
(each m maps
|
||||
(set result (merge result m)))
|
||||
result)
|
||||
(if (phm? (first maps))
|
||||
(do (var result (first maps)) (var mi 1) (while (< mi (length maps)) (let [m (maps mi)] (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (set result (phm-assoc result k (if (phm? m) (phm-get m k) (m k))))) (++ mi))) result)
|
||||
(do (var result (struct)) (each m maps (set result (merge result m))) result)))
|
||||
|
||||
(defn core-merge-with [f & maps]
|
||||
(var result @{})
|
||||
(each m maps
|
||||
(each k (keys m)
|
||||
(let [existing (result k)]
|
||||
(put result k (if (nil? existing) (m k) (f existing (m k)))))))
|
||||
(table/to-struct result))
|
||||
(if (phm? (first maps))
|
||||
(do (var result (first maps)) (var mi 1) (while (< mi (length maps)) (let [m (maps mi)]
|
||||
(each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (phm-get result k)
|
||||
val (if (phm? m) (phm-get m k) (m k))]
|
||||
(set result (phm-assoc result k (if (nil? existing) val (f existing val)))))) (++ mi))) result)
|
||||
(do (var result @{}) (each m maps (each k (if (phm? m) (keys (phm-to-struct m)) (keys m)) (let [existing (result k)] (put result k (if (nil? existing) (m k) (f existing (m k))))))) (table/to-struct result))))
|
||||
|
||||
(defn core-keys [m]
|
||||
(tuple ;(keys m)))
|
||||
(if (phm? m) (tuple ;(keys (phm-to-struct m))) (tuple ;(keys m))))
|
||||
|
||||
(defn core-vals [m]
|
||||
(tuple ;(map |(m $) (keys m))))
|
||||
(if (phm? m) (do (def s (phm-to-struct m)) (tuple ;(map |(s $) (keys s)))) (tuple ;(map |(m $) (keys m)))))
|
||||
|
||||
(defn core-select-keys [m ks]
|
||||
(var result @{})
|
||||
|
|
@ -508,13 +507,7 @@
|
|||
# ============================================================
|
||||
|
||||
(defn core-vector [& xs] (tuple ;xs))
|
||||
(defn core-hash-map [& kvs]
|
||||
(var result @{})
|
||||
(var i 0)
|
||||
(while (< i (length kvs))
|
||||
(put result (kvs i) (kvs (+ i 1)))
|
||||
(+= i 2))
|
||||
(table/to-struct result))
|
||||
(defn core-hash-map [& kvs] (make-phm kvs))
|
||||
|
||||
(defn core-array-map [& kvs]
|
||||
(var result @{})
|
||||
|
|
|
|||
108
src/jolt/phm.janet
Normal file
108
src/jolt/phm.janet
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
# PersistentHashMap implementation for Jolt
|
||||
# Bucket-based hash map with copy-on-write semantics.
|
||||
|
||||
(def- bucket-count 8)
|
||||
|
||||
(defn phm? [x]
|
||||
(and (table? x)
|
||||
(= "jolt.lang.persistent-hash-map.PersistentHashMap" (x :jolt/deftype))))
|
||||
|
||||
(defn phm-hash-key [k]
|
||||
(if (nil? k) 0 (mod (hash 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)))
|
||||
(+= 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)))
|
||||
(+= 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)))
|
||||
(+= i 2))
|
||||
(if (not (nil? found-i))
|
||||
(let [nb @[]] (var j 0)
|
||||
(while (< j n) (array/push nb (if (= j (+ found-i 1)) v (in bucket j))) (++ j)) nb)
|
||||
(let [nb @[]] (var j 0)
|
||||
(while (< j n) (array/push nb (in bucket j)) (++ j))
|
||||
(array/push nb k) (array/push nb v) nb)))
|
||||
|
||||
(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)))
|
||||
(+= i 2))
|
||||
(if (nil? found-i) bucket
|
||||
(if (= n 2) nil
|
||||
(let [nb @[]] (var j 0)
|
||||
(while (< j found-i) (array/push nb (in bucket j)) (++ j))
|
||||
(while (< j (- n 2)) (array/push nb (in bucket (+ j 2))) (++ j)) nb))))
|
||||
|
||||
(defn phm-get [m k &opt default]
|
||||
(default default nil)
|
||||
(let [bucket (get (m :buckets) (phm-hash-key k))]
|
||||
(if bucket (let [v (phm-bucket-find bucket k)] (if (nil? v) default v)) default)))
|
||||
|
||||
(defn phm-assoc [m k v]
|
||||
(let [cnt (m :cnt) idx (phm-hash-key k)
|
||||
old-bucket (get (m :buckets) idx)
|
||||
had-key (if old-bucket (phm-bucket-contains? old-bucket k) false)
|
||||
new-bucket (phm-bucket-assoc (if old-bucket old-bucket @[]) k v)
|
||||
new-cnt (if had-key cnt (+ cnt 1))
|
||||
new-buckets (array/new bucket-count)]
|
||||
(var bi 0)
|
||||
(while (< bi bucket-count)
|
||||
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
|
||||
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
|
||||
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)}))
|
||||
|
||||
(defn phm-dissoc [m k]
|
||||
(let [idx (phm-hash-key k) old-bucket (get (m :buckets) idx)]
|
||||
(if old-bucket
|
||||
(let [new-bucket (phm-bucket-dissoc old-bucket k)]
|
||||
(if (= new-bucket old-bucket) m
|
||||
(let [new-cnt (- (m :cnt) 1) new-buckets (array/new bucket-count)]
|
||||
(var bi 0)
|
||||
(while (< bi bucket-count)
|
||||
(put new-buckets bi (if (= bi idx) new-bucket (get (m :buckets) bi))) (++ bi))
|
||||
@{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
|
||||
:cnt new-cnt :buckets new-buckets :_meta (m :_meta)})))
|
||||
m)))
|
||||
|
||||
(defn phm-entries [m]
|
||||
(var result @[]) (var bi 0)
|
||||
(while (< bi bucket-count)
|
||||
(let [bucket (get (m :buckets) bi)]
|
||||
(when bucket
|
||||
(var i 0) (var n (length bucket))
|
||||
(while (< i n) (array/push result [(in bucket i) (in bucket (+ i 1))]) (+= i 2))))
|
||||
(++ bi))
|
||||
result)
|
||||
|
||||
(defn phm-to-struct [m]
|
||||
(var result @{}) (var bi 0)
|
||||
(while (< bi bucket-count)
|
||||
(let [bucket (get (m :buckets) bi)]
|
||||
(when bucket
|
||||
(var i 0) (var n (length bucket))
|
||||
(while (< i n) (put result (in bucket i) (in bucket (+ i 1))) (+= i 2))))
|
||||
(++ bi))
|
||||
(table/to-struct result))
|
||||
|
||||
(defn make-phm [&opt kvs]
|
||||
(default kvs nil)
|
||||
(var m @{:jolt/deftype "jolt.lang.persistent-hash-map.PersistentHashMap"
|
||||
:cnt 0 :buckets (array/new bucket-count) :_meta nil})
|
||||
(when kvs
|
||||
(var i 0) (var n (length kvs))
|
||||
(while (< i n) (set m (phm-assoc m (kvs i) (kvs (+ i 1)))) (+= i 2)))
|
||||
m)
|
||||
Loading…
Add table
Add a link
Reference in a new issue