diff options
Diffstat (limited to 'stdlib/source/lux/data/coll/dict.lux')
| -rw-r--r-- | stdlib/source/lux/data/coll/dict.lux | 248 |
1 files changed, 124 insertions, 124 deletions
diff --git a/stdlib/source/lux/data/coll/dict.lux b/stdlib/source/lux/data/coll/dict.lux index 5ab078e28..5b61830d5 100644 --- a/stdlib/source/lux/data/coll/dict.lux +++ b/stdlib/source/lux/data/coll/dict.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control hash [eq #+ Eq]) @@ -97,58 +97,58 @@ ## which is 1/4 of the branching factor (or a left-shift 2). (def: demotion-threshold Nat - (bit;shift-left (n/- +2 branching-exponent) +1)) + (bit.shift-left (n/- +2 branching-exponent) +1)) ## The threshold on which #Base nodes are promoted to #Hierarchy nodes, ## which is 1/2 of the branching factor (or a left-shift 1). (def: promotion-threshold Nat - (bit;shift-left (n/- +1 branching-exponent) +1)) + (bit.shift-left (n/- +1 branching-exponent) +1)) ## The size of hierarchy-nodes, which is 2^(branching-exponent). (def: hierarchy-nodes-size Nat - (bit;shift-left branching-exponent +1)) + (bit.shift-left branching-exponent +1)) ## The cannonical empty node, which is just an empty #Base node. (def: empty Node - (#Base clean-bitmap (array;new +0))) + (#Base clean-bitmap (array.new +0))) ## Expands a copy of the array, to have 1 extra slot, which is used ## for storing the value. (def: (insert! idx value old-array) (All [a] (-> Index a (Array a) (Array a))) - (let [old-size (array;size old-array)] - (|> ## (array;new (n/inc old-size)) + (let [old-size (array.size old-array)] + (|> ## (array.new (n/inc old-size)) (: (Array ($ +0)) - (array;new (n/inc old-size))) - (array;copy idx +0 old-array +0) - (array;write idx value) - (array;copy (n/- idx old-size) idx old-array (n/inc idx))))) + (array.new (n/inc old-size))) + (array.copy idx +0 old-array +0) + (array.write idx value) + (array.copy (n/- idx old-size) idx old-array (n/inc idx))))) ## Creates a copy of an array with an index set to a particular value. (def: (update! idx value array) (All [a] (-> Index a (Array a) (Array a))) - (|> array array;clone (array;write idx value))) + (|> array array.clone (array.write idx value))) ## Creates a clone of the array, with an empty position at index. (def: (vacant! idx array) (All [a] (-> Index (Array a) (Array a))) - (|> array array;clone (array;delete idx))) + (|> array array.clone (array.delete idx))) ## Shrinks a copy of the array by removing the space at index. (def: (remove! idx array) (All [a] (-> Index (Array a) (Array a))) - (let [new-size (n/dec (array;size array))] - (|> (array;new new-size) - (array;copy idx +0 array +0) - (array;copy (n/- idx new-size) (n/inc idx) array idx)))) + (let [new-size (n/dec (array.size array))] + (|> (array.new new-size) + (array.copy idx +0 array +0) + (array.copy (n/- idx new-size) (n/inc idx) array idx)))) ## Given a top-limit for indices, produces all indices in [0, R). (def: indices-for (-> Nat (List Index)) - (|>> n/dec (list;n/range +0))) + (|>> n/dec (list.n/range +0))) ## Increases the level-shift by the branching-exponent, to explore ## levels further down the tree. @@ -162,13 +162,13 @@ ## to a particular level, and uses that as an index into the array. (def: (level-index level hash) (-> Level Hash-Code Index) - (bit;and hierarchy-mask - (bit;shift-right level hash))) + (bit.and hierarchy-mask + (bit.shift-right level hash))) ## A mechanism to go from indices to bit-positions. (def: (->bit-position index) (-> Index BitPosition) - (bit;shift-left index +1)) + (bit.shift-left index +1)) ## The bit-position within a base that a given hash-code would have. (def: (bit-position level hash) @@ -177,7 +177,7 @@ (def: (bit-position-is-set? bit bitmap) (-> BitPosition BitMap Bool) - (not (n/= clean-bitmap (bit;and bit bitmap)))) + (not (n/= clean-bitmap (bit.and bit bitmap)))) ## Figures out whether a bitmap only contains a single bit-position. (def: only-bit-position? @@ -186,17 +186,17 @@ (def: (set-bit-position bit bitmap) (-> BitPosition BitMap BitMap) - (bit;or bit bitmap)) + (bit.or bit bitmap)) (def: unset-bit-position (-> BitPosition BitMap BitMap) - bit;xor) + bit.xor) ## Figures out the size of a bitmap-indexed array by counting all the ## 1s within the bitmap. (def: bitmap-size (-> BitMap Nat) - bit;count) + bit.count) ## A mask that, for a given bit position, only allows all the 1s prior ## to it, which would indicate the bitmap-size (and, thus, index) @@ -208,14 +208,14 @@ ## The index on the base array, based on it's bit-position. (def: (base-index bit-position bitmap) (-> BitPosition BitMap Index) - (bitmap-size (bit;and (bit-position-mask bit-position) + (bitmap-size (bit.and (bit-position-mask bit-position) bitmap))) ## Produces the index of a KV-pair within a #Collisions node. (def: (collision-index Hash<k> key colls) (All [k v] (-> (Hash k) k (Collisions k v) (Maybe Index))) - (:: Monad<Maybe> map product;left - (array;find+ (function [idx [key' val']] + (:: Monad<Maybe> map product.left + (array.find+ (function [idx [key' val']] (:: Hash<k> = key key')) colls))) @@ -223,22 +223,22 @@ ## nodes to save space. (def: (demote-hierarchy except-idx [h-size h-array]) (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)])) - (product;right (list/fold (function [idx [insertion-idx node]] + (product.right (list/fold (function [idx [insertion-idx node]] (let [[bitmap base] node] - (case (array;read idx h-array) - #;None [insertion-idx node] - (#;Some sub-node) (if (n/= except-idx idx) + (case (array.read idx h-array) + #.None [insertion-idx node] + (#.Some sub-node) (if (n/= except-idx idx) [insertion-idx node] [(n/inc insertion-idx) [(set-bit-position (->bit-position idx) bitmap) - (array;write insertion-idx (#;Left sub-node) base)]]) + (array.write insertion-idx (#.Left sub-node) base)]]) ))) [+0 [clean-bitmap - ## (array;new (n/dec h-size)) + ## (array.new (n/dec h-size)) (: (Base ($ +0) ($ +1)) - (array;new (n/dec h-size))) + (array.new (n/dec h-size))) ]] - (list;indices (array;size h-array))))) + (list.indices (array.size h-array))))) ## When #Base nodes grow too large, they're promoted to #Hierarchy to ## add some depth to the tree and help keep it's balance. @@ -250,26 +250,26 @@ (Hash k) Level BitMap (Base k v) (Array (Node k v)))) - (product;right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] + (product.right (list/fold (function [hierarchy-idx (^@ default [base-idx h-array])] (if (bit-position-is-set? (->bit-position hierarchy-idx) bitmap) [(n/inc base-idx) - (case (array;read base-idx base) - (#;Some (#;Left sub-node)) - (array;write hierarchy-idx sub-node h-array) + (case (array.read base-idx base) + (#.Some (#.Left sub-node)) + (array.write hierarchy-idx sub-node h-array) - (#;Some (#;Right [key' val'])) - (array;write hierarchy-idx + (#.Some (#.Right [key' val'])) + (array.write hierarchy-idx (put' (level-up level) (:: Hash<k> hash key') key' val' Hash<k> empty) h-array) - #;None + #.None (undefined))] default)) [+0 - ## (array;new hierarchy-nodes-size) + ## (array.new hierarchy-nodes-size) (: (Array (Node ($ +0) ($ +1))) - (array;new hierarchy-nodes-size)) + (array.new hierarchy-nodes-size)) ] hierarchy-indices))) @@ -279,7 +279,7 @@ (def: (empty?' node) (All [k v] (-> (Node k v) Bool)) (case node - (^~ (#Base ;;clean-bitmap _)) + (^~ (#Base ..clean-bitmap _)) true _ @@ -292,15 +292,15 @@ ## a sub-node. If impossible, I introduced a new singleton sub-node. (#Hierarchy _size hierarchy) (let [idx (level-index level hash) - ## [_size' sub-node] (case (array;read idx hierarchy) - ## (#;Some sub-node) + ## [_size' sub-node] (case (array.read idx hierarchy) + ## (#.Some sub-node) ## [_size sub-node] ## _ ## [(n/inc _size) empty]) [_size' sub-node] (: [Nat (Node ($ +0) ($ +1))] - (case (array;read idx hierarchy) - (#;Some sub-node) + (case (array.read idx hierarchy) + (#.Some sub-node) [_size sub-node] _ @@ -317,33 +317,33 @@ (if (bit-position-is-set? bit bitmap) ## If so... (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If it's being used by a node, I add the KV to it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (put' (level-up level) hash key val Hash<k> sub-node)] - (#Base bitmap (update! idx (#;Left sub-node') base))) + (#Base bitmap (update! idx (#.Left sub-node') base))) ## Otherwise, if it's being used by a KV, I compare the keys. - (#;Some (#;Right key' val')) + (#.Some (#.Right key' val')) (if (:: Hash<k> = key key') ## If the same key is found, I replace the value. - (#Base bitmap (update! idx (#;Right key val) base)) + (#Base bitmap (update! idx (#.Right key val) base)) ## Otherwise, I compare the hashes of the keys. (#Base bitmap (update! idx - (#;Left (let [hash' (:: Hash<k> hash key')] + (#.Left (let [hash' (:: Hash<k> hash key')] (if (n/= hash hash') ## If the hashes are ## the same, a new ## #Collisions node ## is added. - (#Collisions hash (|> ## (array;new +2) + (#Collisions hash (|> ## (array.new +2) (: (Array [($ +0) ($ +1)]) - (array;new +2)) - (array;write +0 [key' val']) - (array;write +1 [key val]))) + (array.new +2)) + (array.write +0 [key' val']) + (array.write +1 [key val]))) ## Otherwise, I can ## just keep using ## #Base nodes, so I @@ -362,12 +362,12 @@ ## KV-pair as a singleton node to it. (#Hierarchy (n/inc base-count) (|> (promote-base put' Hash<k> level bitmap base) - (array;write (level-index level hash) + (array.write (level-index level hash) (put' (level-up level) hash key val Hash<k> empty)))) ## Otherwise, I just resize the #Base node to accommodate the ## new KV-pair. (#Base (set-bit-position bit bitmap) - (insert! (base-index bit bitmap) (#;Right [key val]) base)))))) + (insert! (base-index bit bitmap) (#.Right [key val]) base)))))) ## For #Collisions nodes, I compare the hashes. (#Collisions _hash _colls) @@ -377,19 +377,19 @@ (case (collision-index Hash<k> key _colls) ## If the key was already present in the collisions-list, it's ## value gets updated. - (#;Some coll-idx) + (#.Some coll-idx) (#Collisions _hash (update! coll-idx [key val] _colls)) ## Otherwise, the KV-pair is added to the collisions-list. - #;None - (#Collisions _hash (insert! (array;size _colls) [key val] _colls))) + #.None + (#Collisions _hash (insert! (array.size _colls) [key val] _colls))) ## If the hashes are not equal, I create a new #Base node that ## contains the old #Collisions node, plus the new KV-pair. (|> (#Base (bit-position level _hash) - (|> ## (array;new +1) + (|> ## (array.new +1) (: (Base ($ +0) ($ +1)) - (array;new +1)) - (array;write +0 (#;Left node)))) + (array.new +1)) + (array.write +0 (#.Left node)))) (put' level hash key val Hash<k>))) )) @@ -400,13 +400,13 @@ ## the Hash-Code. (#Hierarchy h-size h-array) (let [idx (level-index level hash)] - (case (array;read idx h-array) + (case (array.read idx h-array) ## If not, there's nothing to remove. - #;None + #.None node ## But if there is, try to remove the key from the sub-node. - (#;Some sub-node) + (#.Some sub-node) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Then check if a removal was actually done. (if (is sub-node sub-node') @@ -429,13 +429,13 @@ (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) (let [idx (base-index bit bitmap)] - (case (array;read idx base) - #;None + (case (array.read idx base) + #.None (undefined) ## If set, check if it's a sub-node, and remove the KV ## from it. - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (let [sub-node' (remove' (level-up level) hash key Hash<k> sub-node)] ## Verify that it was removed. (if (is sub-node sub-node') @@ -454,10 +454,10 @@ ## But, if it did not come out empty, then the ## position is kept, and the node gets updated. (#Base bitmap - (update! idx (#;Left sub-node') base))))) + (update! idx (#.Left sub-node') base))))) ## If, however, there was a KV-pair instead of a sub-node. - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) ## Check if the keys match. (if (:: Hash<k> = key key') ## If so, remove the KV-pair and unset the BitPosition. @@ -472,12 +472,12 @@ (#Collisions _hash _colls) (case (collision-index Hash<k> key _colls) ## If not, then there's nothing to remove. - #;None + #.None node ## But if so, then check the size of the collisions list. - (#;Some idx) - (if (n/= +1 (array;size _colls)) + (#.Some idx) + (if (n/= +1 (array.size _colls)) ## If there's only one left, then removing it leaves us with ## an empty node. empty @@ -490,31 +490,31 @@ (case node ## For #Hierarchy nodes, just look-up the key on its children. (#Hierarchy _size hierarchy) - (case (array;read (level-index level hash) hierarchy) - #;None #;None - (#;Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) + (case (array.read (level-index level hash) hierarchy) + #.None #.None + (#.Some sub-node) (get' (level-up level) hash key Hash<k> sub-node)) ## For #Base nodes, check the leaves, and recursively check the branches. (#Base bitmap base) (let [bit (bit-position level hash)] (if (bit-position-is-set? bit bitmap) - (case (array;read (base-index bit bitmap) base) - #;None + (case (array.read (base-index bit bitmap) base) + #.None (undefined) - (#;Some (#;Left sub-node)) + (#.Some (#.Left sub-node)) (get' (level-up level) hash key Hash<k> sub-node) - (#;Some (#;Right [key' val'])) + (#.Some (#.Right [key' val'])) (if (:: Hash<k> = key key') - (#;Some val') - #;None)) - #;None)) + (#.Some val') + #.None)) + #.None)) ## For #Collisions nodes, do a linear scan of all the known KV-pairs. (#Collisions _hash _colls) - (:: Monad<Maybe> map product;right - (array;find (|>> product;left (:: Hash<k> = key)) + (:: Monad<Maybe> map product.right + (array.find (|>> product.left (:: Hash<k> = key)) _colls)) )) @@ -527,12 +527,12 @@ (#Base _ base) (array/fold n/+ +0 (array/map (function [sub-node'] (case sub-node' - (#;Left sub-node) (size' sub-node) - (#;Right _) +1)) + (#.Left sub-node) (size' sub-node) + (#.Right _) +1)) base)) (#Collisions hash colls) - (array;size colls) + (array.size colls) )) (def: (entries' node) @@ -540,28 +540,28 @@ (case node (#Hierarchy _size hierarchy) (array/fold (function [sub-node tail] (list/compose (entries' sub-node) tail)) - #;Nil + #.Nil hierarchy) (#Base bitmap base) (array/fold (function [branch tail] (case branch - (#;Left sub-node) + (#.Left sub-node) (list/compose (entries' sub-node) tail) - (#;Right [key' val']) - (#;Cons [key' val'] tail))) - #;Nil + (#.Right [key' val']) + (#.Cons [key' val'] tail))) + #.Nil base) (#Collisions hash colls) - (array/fold (function [[key' val'] tail] (#;Cons [key' val'] tail)) - #;Nil + (array/fold (function [[key' val'] tail] (#.Cons [key' val'] tail)) + #.Nil colls))) ## [Exports] (type: #export (Dict k v) - {#;doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} + {#.doc "A dictionary implemented as a Hash-Array Mapped Trie (HAMT)."} {#hash (Hash k) #root (Node k v)}) @@ -588,29 +588,29 @@ (def: #export (contains? key dict) (All [k v] (-> k (Dict k v) Bool)) (case (get key dict) - #;None false - (#;Some _) true)) + #.None false + (#.Some _) true)) (def: #export (put~ key val dict) - {#;doc "Only puts the KV-pair if the key is not already present."} + {#.doc "Only puts the KV-pair if the key is not already present."} (All [k v] (-> k v (Dict k v) (Dict k v))) (if (contains? key dict) dict (put key val dict))) (def: #export (update key f dict) - {#;doc "Transforms the value located at key (if available), using the given function."} + {#.doc "Transforms the value located at key (if available), using the given function."} (All [k v] (-> k (-> v v) (Dict k v) (Dict k v))) (case (get key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (put key (f val) dict))) (def: #export size (All [k v] (-> (Dict k v) Nat)) - (|>> product;right size')) + (|>> product.right size')) (def: #export empty? (All [k v] (-> (Dict k v) Bool)) @@ -618,7 +618,7 @@ (def: #export (entries dict) (All [k v] (-> (Dict k v) (List [k v]))) - (entries' (product;right dict))) + (entries' (product.right dict))) (def: #export (from-list Hash<k> kvs) (All [k v] (-> (Hash k) (List [k v]) (Dict k v))) @@ -632,12 +632,12 @@ (All [k v] (-> (Dict k v) (List <elem-type>))) (|> dict entries (list/map <side>)))] - [keys k product;left] - [values v product;right] + [keys k product.left] + [values v product.right] ) (def: #export (merge dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.doc "Merges 2 dictionaries. If any collisions with keys occur, the values of dict2 will overwrite those of dict1."} (All [k v] (-> (Dict k v) (Dict k v) (Dict k v))) @@ -646,16 +646,16 @@ (entries dict2))) (def: #export (merge-with f dict2 dict1) - {#;doc "Merges 2 dictionaries. + {#.doc "Merges 2 dictionaries. If any collisions with keys occur, a new value will be computed by applying 'f' to the values of dict2 and dict1."} (All [k v] (-> (-> v v v) (Dict k v) (Dict k v) (Dict k v))) (list/fold (function [[key val2] dict] (case (get key dict) - #;None + #.None (put key val2 dict) - (#;Some val1) + (#.Some val1) (put key (f val2 val1) dict))) dict1 (entries dict2))) @@ -663,22 +663,22 @@ (def: #export (re-bind from-key to-key dict) (All [k v] (-> k k (Dict k v) (Dict k v))) (case (get from-key dict) - #;None + #.None dict - (#;Some val) + (#.Some val) (|> dict (remove from-key) (put to-key val)))) (def: #export (select keys dict) - {#;doc "Creates a sub-set of the given dict, with only the specified keys."} + {#.doc "Creates a sub-set of the given dict, with only the specified keys."} (All [k v] (-> (List k) (Dict k v) (Dict k v))) (let [[Hash<k> _] dict] (list/fold (function [key new-dict] (case (get key dict) - #;None new-dict - (#;Some val) (put key val new-dict))) + #.None new-dict + (#.Some val) (put key val new-dict))) (new Hash<k>) keys))) @@ -687,9 +687,9 @@ (def: (= test subject) (and (n/= (size test) (size subject)) - (list;every? (function [k] + (list.every? (function [k] (case [(get k test) (get k subject)] - [(#;Some tk) (#;Some sk)] + [(#.Some tk) (#.Some sk)] (:: Eq<v> = tk sk) _ |