diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/library/lux/data/collection/array.lux | 425 | ||||
-rw-r--r-- | stdlib/source/library/lux/data/collection/dictionary.lux | 216 | ||||
-rw-r--r-- | stdlib/source/library/lux/data/collection/sequence.lux | 181 |
3 files changed, 274 insertions, 548 deletions
diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux index 437c80bfa..cef8b64c0 100644 --- a/stdlib/source/library/lux/data/collection/array.lux +++ b/stdlib/source/library/lux/data/collection/array.lux @@ -1,424 +1,149 @@ (.using [library [lux {"-" list} - ["@" target] [abstract [monoid {"+" Monoid}] [functor {"+" Functor}] [equivalence {"+" Equivalence}] [mix {"+" Mix}] [predicate {"+" Predicate}]] - [control - ["[0]" maybe]] [data - ["[0]" product] [collection - ["[0]" list ("[1]#[0]" mix)]]] - [math - [number - ["n" nat]]]]]) + ["[0]" list]]]]] + ["!" \\unsafe]) (def: .public type_name - "#Array") + !.type) -(type: .public (Array a) - {.#Primitive ..type_name {.#Item a {.#End}}}) +(type: .public Array + !.Array) -(with_expansions [<index_type> (Primitive "java.lang.Long") - <elem_type> (Primitive "java.lang.Object") - <array_type> (type (Array <elem_type>))] - (for [@.jvm - (template: (!int value) - [(|> value - (:as <index_type>) - "jvm object cast" - "jvm conversion long-to-int")])] - (as_is)) - - (def: .public (empty size) - (All (_ a) (-> Nat (Array a))) - (for [@.old - (:expected ("jvm anewarray" "(java.lang.Object )" size)) - - @.jvm - (|> size - !int - "jvm array new object" - (: <array_type>) - :expected) - - @.js ("js array new" size) - @.python ("python array new" size) - @.lua ("lua array new" size) - @.ruby ("ruby array new" size) - @.php ("php array new" size) - @.scheme ("scheme array new" size)])) - - (def: .public (size array) - (All (_ a) (-> (Array a) Nat)) - (for [@.old - ("jvm arraylength" array) - - @.jvm - (|> array - (:as <array_type>) - "jvm array length object" - "jvm conversion int-to-long" - "jvm object cast" - (: <index_type>) - (:as Nat)) - - @.js ("js array length" array) - @.python ("python array length" array) - @.lua ("lua array length" array) - @.ruby ("ruby array length" array) - @.php ("php array length" array) - @.scheme ("scheme array length" array)])) - - (template: (!read! <read!> <null?>) - [(let [output (<read!> index array)] - (if (<null?> output) - {.#None} - {.#Some output}))]) - - (def: .public (read! index array) - (All (_ a) - (-> Nat (Array a) (Maybe a))) - (if (n.< (size array) index) - (for [@.old - (let [value ("jvm aaload" array index)] - (if ("jvm object null?" value) - {.#None} - {.#Some value})) - - @.jvm - (let [value (|> array - (:as <array_type>) - ("jvm array read object" (!int index)))] - (if ("jvm object null?" value) - {.#None} - {.#Some (:expected value)})) - - @.js (!read! "js array read" "js object undefined?") - @.python (!read! "python array read" "python object none?") - @.lua (!read! "lua array read" "lua object nil?") - @.ruby (!read! "ruby array read" "ruby object nil?") - @.php (!read! "php array read" "php object null?") - @.scheme (!read! "scheme array read" "scheme object nil?")]) - {.#None})) - - (def: .public (write! index value array) - (All (_ a) - (-> Nat a (Array a) (Array a))) - (for [@.old - ("jvm aastore" array index value) +(def: .public empty + (All (_ a) (-> Nat (Array a))) + (|>> !.empty)) - @.jvm - (|> array - (:as <array_type>) - ("jvm array write object" (!int index) (:as <elem_type> value)) - :expected) +(def: .public size + (All (_ a) (-> (Array a) Nat)) + (|>> !.size)) - @.js ("js array write" index value array) - @.python ("python array write" index value array) - @.lua ("lua array write" index value array) - @.ruby ("ruby array write" index value array) - @.php ("php array write" index value array) - @.scheme ("scheme array write" index value array)])) +(def: .public (read! index array) + (All (_ a) + (-> Nat (Array a) (Maybe a))) + (if (!.lacks? index array) + {.#None} + {.#Some (!.item index array)})) - (def: .public (delete! index array) - (All (_ a) - (-> Nat (Array a) (Array a))) - (if (n.< (size array) index) - (for [@.old - (write! index (:expected ("jvm object null")) array) +(def: .public (write! index value array) + (All (_ a) + (-> Nat a (Array a) (Array a))) + (!.has! index value array)) - @.jvm - (write! index (:expected (: <elem_type> ("jvm object null"))) array) +(def: .public (delete! index array) + (All (_ a) + (-> Nat (Array a) (Array a))) + (!.lacks! index array)) - @.js ("js array delete" index array) - @.python ("python array delete" index array) - @.lua ("lua array delete" index array) - @.ruby ("ruby array delete" index array) - @.php ("php array delete" index array) - @.scheme ("scheme array delete" index array)]) - array)) - ) +(def: .public (lacks? index array) + (All (_ a) + (-> Nat (Array a) Bit)) + (!.lacks? index array)) (def: .public (contains? index array) (All (_ a) (-> Nat (Array a) Bit)) - (case (..read! index array) - {.#Some _} - true - - _ - false)) + (not (!.lacks? index array))) -(def: .public (update! index transform array) +(def: .public (update! index $ array) (All (_ a) (-> Nat (-> a a) (Array a) (Array a))) - (case (read! index array) - {.#None} - array - - {.#Some value} - (write! index (transform value) array))) + (!.revised! index $ array)) (def: .public (upsert! index default transform array) (All (_ a) (-> Nat a (-> a a) (Array a) (Array a))) - (write! index - (|> array (read! index) (maybe.else default) transform) - array)) + (!.upsert! index default transform array)) (def: .public (copy! length src_start src_array dest_start dest_array) (All (_ a) (-> Nat Nat (Array a) Nat (Array a) (Array a))) - (if (n.= 0 length) - dest_array - (list#mix (function (_ offset target) - (case (read! (n.+ offset src_start) src_array) - {.#None} - target - - {.#Some value} - (write! (n.+ offset dest_start) value target))) - dest_array - (list.indices length)))) + (!.copy! length src_start src_array dest_start dest_array)) -(def: .public (occupancy array) +(def: .public occupancy (All (_ a) (-> (Array a) Nat)) - (list#mix (function (_ idx count) - (case (read! idx array) - {.#None} - count - - {.#Some _} - (++ count))) - 0 - (list.indices (size array)))) + (|>> !.occupancy)) -(def: .public (vacancy array) +(def: .public vacancy (All (_ a) (-> (Array a) Nat)) - (n.- (..occupancy array) (..size array))) + (|>> !.vacancy)) -(def: .public (filter! p xs) +(def: .public (filter! ? it) (All (_ a) (-> (Predicate a) (Array a) (Array a))) - (list#mix (function (_ idx xs') - (case (read! idx xs) - {.#None} - xs' - - {.#Some x} - (if (p x) - xs' - (delete! idx xs')))) - xs - (list.indices (size xs)))) + (!.only! ? it)) -(def: .public (example p xs) +(def: .public (example ? it) (All (_ a) (-> (Predicate a) (Array a) (Maybe a))) - (let [arr_size (size xs)] - (loop [idx 0] - (if (n.< arr_size idx) - (case (read! idx xs) - {.#None} - (again (++ idx)) - - {.#Some x} - (if (p x) - {.#Some x} - (again (++ idx)))) - {.#None})))) + (!.example ? it)) -(def: .public (example+ p xs) +(def: .public (example+ ? it) (All (_ a) (-> (-> Nat a Bit) (Array a) (Maybe [Nat a]))) - (let [arr_size (size xs)] - (loop [idx 0] - (if (n.< arr_size idx) - (case (read! idx xs) - {.#None} - (again (++ idx)) - - {.#Some x} - (if (p idx x) - {.#Some [idx x]} - (again (++ idx)))) - {.#None})))) + (!.example' ? it)) -(def: .public (clone xs) +(def: .public clone (All (_ a) (-> (Array a) (Array a))) - (let [arr_size (size xs)] - (list#mix (function (_ idx ys) - (case (read! idx xs) - {.#None} - ys + (|>> !.clone)) - {.#Some x} - (write! idx x ys))) - (empty arr_size) - (list.indices arr_size)))) - -(def: .public (of_list xs) +(def: .public of_list (All (_ a) (-> (List a) (Array a))) - (product.right (list#mix (function (_ x [idx arr]) - [(++ idx) (write! idx x arr)]) - [0 (empty (list.size xs))] - xs))) - -(def: underflow - Nat - (-- 0)) - -(def: (list|-default array empty) - (All (_ a) (-> (Array a) (List a) (List a))) - (loop [idx (-- (size array)) - output empty] - (case idx - (^ (static ..underflow)) - output - - _ - (again (-- idx) - (case (read! idx array) - {.#Some head} - {.#Item head output} - - {.#None} - output))))) - -(def: (list|+default default array) - (All (_ a) (-> a (Array a) (List a))) - (loop [idx (-- (size array)) - output (`` (: (List (~~ (:of default))) - {.#End}))] - (case idx - (^ (static ..underflow)) - output - - _ - (again (-- idx) - {.#Item (maybe.else default (read! idx array)) - output})))) + (|>> !.of_list)) (def: .public (list default array) (All (_ a) (-> (Maybe a) (Array a) (List a))) - (case default - {.#Some default} - (list|+default default array) - - {.#None} - (list|-default array {.#End}))) + (!.list default array)) -(implementation: .public (equivalence (^open ",#[0]")) +(implementation: .public (equivalence //) (All (_ a) (-> (Equivalence a) (Equivalence (Array a)))) - (def: (= xs ys) - (let [sxs (size xs) - sxy (size ys)] - (and (n.= sxy sxs) - (list#mix (function (_ idx prev) - (and prev - (case [(read! idx xs) (read! idx ys)] - [{.#None} {.#None}] - true - - [{.#Some x} {.#Some y}] - (,#= x y) - - _ - false))) - true - (list.indices sxs)))))) + (def: (= left/* right/*) + (!.= // left/* right/*))) (implementation: .public monoid (All (_ a) (Monoid (Array a))) - (def: identity (empty 0)) + (def: identity (!.empty 0)) - (def: (composite xs ys) - (let [sxs (size xs) - sxy (size ys)] - (|> (empty (n.+ sxy sxs)) - (copy! sxs 0 xs 0) - (copy! sxy 0 ys sxs))))) - -(implementation: .public functor - (Functor Array) - - (def: (each f ma) - (let [arr_size (size ma)] - (if (n.= 0 arr_size) - (empty arr_size) - (list#mix (function (_ idx mb) - (case (read! idx ma) - {.#None} - mb - - {.#Some x} - (write! idx (f x) mb))) - (empty arr_size) - (list.indices arr_size)) - )))) + (def: (composite left/* right/*) + (!.composite left/* right/*))) (implementation: .public mix (Mix Array) - (def: (mix f init xs) - (let [arr_size (size xs)] - (loop [so_far init - idx 0] - (if (n.< arr_size idx) - (case (read! idx xs) - {.#None} - (again so_far (++ idx)) + (def: (mix $ init it) + (!.mix (function (_ index partial total) + ($ partial total)) + init + it))) - {.#Some value} - (again (f value so_far) (++ idx))) - so_far))))) +(implementation: .public functor + (Functor Array) + + (def: (each $ input) + (!.each $ input))) -(template [<name> <init> <op>] - [(def: .public (<name> predicate) - (All (_ a) - (-> (Predicate a) (Predicate (Array a)))) - (function (_ array) - (let [size (..size array)] - (loop [idx 0] - (if (n.< size idx) - (case (..read! idx array) - {.#Some value} - (<op> (predicate value) - (again (++ idx))) - - {.#None} - (again (++ idx))) - <init>)))))] +(def: .public (every? ? it) + (All (_ a) + (-> (Predicate a) (Predicate (Array a)))) + (!.every? ? it)) - [every? true and] - [any? false or] - ) +(def: .public (any? ? it) + (All (_ a) + (-> (Predicate a) (Predicate (Array a)))) + (!.any? ? it)) -(def: .public (one check items) +(def: .public (one ? it) (All (_ a b) (-> (-> a (Maybe b)) (Array a) (Maybe b))) - (let [size (..size items)] - (loop [idx 0] - (if (n.< size idx) - (with_expansions [<again> (again (++ idx))] - (case (..read! idx items) - {.#Some input} - (case (check input) - {.#None} - <again> - - output - output) - - {.#None} - <again>)) - {.#None})))) + (!.one ? it)) diff --git a/stdlib/source/library/lux/data/collection/dictionary.lux b/stdlib/source/library/lux/data/collection/dictionary.lux index ee7b7cb7d..e61a79230 100644 --- a/stdlib/source/library/lux/data/collection/dictionary.lux +++ b/stdlib/source/library/lux/data/collection/dictionary.lux @@ -1,23 +1,24 @@ (.using - [library - [lux "*" - [abstract - [hash {"+" Hash}] - [equivalence {"+" Equivalence}] - [functor {"+" Functor}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" mix functor monoid)] - ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] - [math - ["[0]" number - ["n" nat] - ["[0]" i64]]]]]) + [library + [lux "*" + [abstract + [hash {"+" Hash}] + [equivalence {"+" Equivalence}] + [functor {"+" Functor}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" mix functor monoid)] + ["[0]" array "_" + ["[1]" \\unsafe {"+" Array}]]]] + [math + ["[0]" number + ["n" nat] + ["[0]" i64]]]]]) ... This implementation of Hash Array Mapped Trie (HAMT) is based on ... Clojure's PersistentHashMap implementation. @@ -136,20 +137,20 @@ (let [old_size (array.size old_array)] (|> (array.empty (++ old_size)) (array.copy! idx 0 old_array 0) - (array.write! idx value) + (array.has! idx value) (array.copy! (n.- idx old_size) idx old_array (++ idx))))) ... Creates a copy of an array with an index set to a particular value. (def: (array#revised idx value array) (All (_ a) (-> Index a (Array a) (Array a))) - (|> array array.clone (array.write! idx value))) + (|> array array.clone (array.has! idx value))) ... Creates a clone of the array, with an empty position at index. (def: (array#clear idx array) (All (_ a) (-> Index (Array a) (Array a))) (|> array array.clone - (array.delete! idx))) + (array.lacks! idx))) ... Shrinks a copy of the array by removing the space at index. (def: (array#lacks idx array) @@ -229,7 +230,7 @@ (def: (collision_index key_hash key colls) (All (_ k v) (-> (Hash k) k (Collisions k v) (Maybe Index))) (# maybe.monad each product.left - (array.example+ (function (_ idx [key' val']) + (array.example' (function (_ idx [key' val']) (# key_hash = key key')) colls))) @@ -239,14 +240,13 @@ (All (_ k v) (-> Index (Hierarchy k v) [Bit_Map (Base k v)])) (product.right (list#mix (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) - [insertion_idx node] - [(++ insertion_idx) - [(with_bit_position (to_bit_position idx) bitmap) - (array.write! insertion_idx {.#Left sub_node} base)]]) - ))) + (if (array.lacks? idx h_array) + [insertion_idx node] + (if (n.= except_idx idx) + [insertion_idx node] + [(++ insertion_idx) + [(with_bit_position (to_bit_position idx) bitmap) + (array.has! insertion_idx {.#Left (array.item idx h_array)} base)]])))) [0 [clean_bitmap (array.empty (-- h_size))]] (list.indices (array.size h_array))))) @@ -267,17 +267,14 @@ (if (with_bit_position? (to_bit_position hierarchy_idx) bitmap) [(++ base_idx) - (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 - (node#has (level_up level) (# key_hash hash key') key' val' key_hash empty_node) - h_array) - - {.#None} - (undefined))] + (case (array.item base_idx base) + {.#Left sub_node} + (array.has! hierarchy_idx sub_node h_array) + + {.#Right [key' val']} + (array.has! hierarchy_idx + (node#has (level_up level) (# key_hash hash key') key' val' key_hash ..empty_node) + h_array))] default)) [0 (array.empty hierarchy_nodes_size)] @@ -302,12 +299,9 @@ ... a sub-node. If impossible, introduce 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] - - _ - [(++ _size) empty_node])] + [_size' sub_node] (if (not (array.lacks? idx hierarchy)) + [_size (array.item idx hierarchy)] + [(++ _size) ..empty_node])] {#Hierarchy _size' (array#revised idx (node#has (level_up level) hash key val key_hash sub_node) hierarchy)}) @@ -319,19 +313,19 @@ (if (with_bit_position? bit bitmap) ... If so... (let [idx (base_index bit bitmap)] - (case (array.read! idx base) - ... If it's being used by a node, add the KV to it. - {.#Some {.#Left sub_node}} - (let [sub_node' (node#has (level_up level) hash key val key_hash sub_node)] - {#Base bitmap (array#revised idx {.#Left sub_node'} base)}) - - ... Otherwise, if it's being used by a KV, compare the keys. - {.#Some {.#Right key' val'}} - (if (# key_hash = key key') - ... If the same key is found, replace the value. - {#Base bitmap (array#revised idx {.#Right key val} base)} - ... Otherwise, compare the hashes of the keys. - {#Base bitmap (array#revised idx + {#Base bitmap (case (array.item idx base) + ... If it's being used by a node, add the KV to it. + {.#Left sub_node} + (let [sub_node' (node#has (level_up level) hash key val key_hash sub_node)] + (array#revised idx {.#Left sub_node'} base)) + + ... Otherwise, if it's being used by a KV, compare the keys. + {.#Right key' val'} + (array#revised idx + (if (# key_hash = key key') + ... If the same key is found, replace the value. + {.#Right key val} + ... Otherwise, compare the hashes of the keys. {.#Left (let [hash' (# key_hash hash key')] (if (n.= hash hash') ... If the hashes are @@ -339,21 +333,18 @@ ... #Collisions node ... is added. {#Collisions hash (|> (array.empty 2) - (array.write! 0 [key' val']) - (array.write! 1 [key val]))} + (array.has! 0 [key' val']) + (array.has! 1 [key val]))} ... Otherwise, one can ... just keep using ... #Base nodes, so ... add both KV-pairs ... to the empty one. (let [next_level (level_up level)] - (|> empty_node + (|> ..empty_node (node#has next_level hash' key' val' key_hash) - (node#has next_level hash key val key_hash)))))} - base)}) - - {.#None} - (undefined))) + (node#has next_level hash key val key_hash)))))}) + base))}) ... However, if the Bit_Position has not been used yet, check ... whether this #Base node is ready for a promotion. (let [base_count (bitmap_size bitmap)] @@ -365,10 +356,11 @@ ... Otherwise, promote it to a #Hierarchy node, and add the new ... KV-pair as a singleton node to it. {#Hierarchy (++ base_count) - (|> base - (promotion node#has key_hash level bitmap) - (array.write! (level_index level hash) - (node#has (level_up level) hash key val key_hash empty_node)))})))) + (let [... TODO: These bindings were established to get around a compilation error. Fix and inline! + index (level_index level hash) + item (node#has (level_up level) hash key val key_hash ..empty_node) + array (promotion node#has key_hash level bitmap base)] + (array.has! index item array))})))) ... For #Collisions nodes, compare the hashes. {#Collisions _hash _colls} @@ -388,7 +380,7 @@ ... contains the old #Collisions node, plus the new KV-pair. (|> {#Base (level_bit_position level _hash) (|> (array.empty 1) - (array.write! 0 {.#Left node}))} + (array.has! 0 {.#Left node}))} (node#has level hash key val key_hash))) )) @@ -399,14 +391,12 @@ ... the Hash-Code. {#Hierarchy h_size h_array} (let [idx (level_index level hash)] - (case (array.read! idx h_array) + (if (array.lacks? idx h_array) ... If not, there's nothing to remove. - {.#None} node - ... But if there is, try to remove the key from the sub-node. - {.#Some sub_node} - (let [sub_node' (node#lacks (level_up level) hash key key_hash sub_node)] + (let [sub_node (array.item idx h_array) + sub_node' (node#lacks (level_up level) hash key key_hash sub_node)] ... Then check if a removal was actually done. (if (same? sub_node sub_node') ... If not, then there's nothing to change here either. @@ -428,10 +418,10 @@ (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) (let [idx (base_index bit bitmap)] - (case (array.read! idx base) + (case (array.item idx base) ... If set, check if it's a sub_node, and remove the KV ... from it. - {.#Some {.#Left sub_node}} + {.#Left sub_node} (let [sub_node' (node#lacks (level_up level) hash key key_hash sub_node)] ... Verify that it was removed. (if (same? sub_node sub_node') @@ -442,7 +432,7 @@ ...# ... figure out whether that's the only position left. (if (only_bit_position? bit bitmap) ... If so, removing it leaves this node empty too. - empty_node + ..empty_node ... But if not, then just unset the position and ... remove the node. {#Base (without_bit_position bit bitmap) @@ -453,17 +443,14 @@ (array#revised idx {.#Left sub_node'} base)}))) ... If, however, there was a KV-pair instead of a sub-node. - {.#Some {.#Right [key' val']}} + {.#Right [key' val']} ... Check if the keys match. (if (# key_hash = key key') ... If so, remove the KV-pair and unset the Bit_Position. {#Base (without_bit_position bit bitmap) (array#lacks idx base)} ... Otherwise, there's nothing to remove. - node) - - {.#None} - (undefined))) + node))) ... If the Bit_Position is not set, there's nothing to remove. node)) @@ -479,7 +466,7 @@ (if (n.= 1 (array.size _colls)) ... If there's only one left, then removing it leaves us with ... an empty node. - empty_node + ..empty_node ... Otherwise, just shrink the array by removing the KV-pair. {#Collisions _hash (array#lacks idx _colls)})) )) @@ -489,25 +476,23 @@ (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} (node#value (level_up level) hash key key_hash sub_node)) + (let [index (level_index level hash)] + (if (array.lacks? index hierarchy) + {.#None} + (node#value (level_up level) hash key key_hash (array.item index hierarchy)))) ... For #Base nodes, check the leaves, and recursively check the branches. {#Base bitmap base} (let [bit (level_bit_position level hash)] (if (with_bit_position? bit bitmap) - (case (array.read! (base_index bit bitmap) base) - {.#Some {.#Left sub_node}} + (case (array.item (base_index bit bitmap) base) + {.#Left sub_node} (node#value (level_up level) hash key key_hash sub_node) - {.#Some {.#Right [key' val']}} + {.#Right [key' val']} (if (# key_hash = key key') {.#Some val'} - {.#None}) - - {.#None} - (undefined)) + {.#None})) {.#None})) ... For #Collisions nodes, do a linear scan of all the known KV-pairs. @@ -521,14 +506,20 @@ (All (_ k v) (-> (Node k v) Nat)) (case node {#Hierarchy _size hierarchy} - (array#mix n.+ 0 (array#each node#size hierarchy)) + (array.mix (function (_ _ item total) + (n.+ item total)) + 0 + (array.each node#size hierarchy)) {#Base _ base} - (array#mix n.+ 0 (array#each (function (_ sub_node') - (case sub_node' - {.#Left sub_node} (node#size sub_node) - {.#Right _} 1)) - base)) + (array.mix (function (_ _ item total) + (n.+ item total)) + 0 + (array.each (function (_ sub_node') + (case sub_node' + {.#Left sub_node} (node#size sub_node) + {.#Right _} 1)) + base)) {#Collisions hash colls} (array.size colls) @@ -538,13 +529,13 @@ (All (_ k v a) (-> (-> [k v] a a) a (Node k v) a)) (case node {#Hierarchy _size hierarchy} - (array#mix (function (_ sub_node current) + (array.mix (function (_ _ sub_node current) (node#mix f current sub_node)) init hierarchy) {#Base bitmap base} - (array#mix (function (_ branch current) + (array.mix (function (_ _ branch current) (case branch {.#Left sub_node} (node#mix f current sub_node) @@ -555,7 +546,10 @@ base) {#Collisions hash colls} - (array#mix f init colls))) + (array.mix (function (_ _ item total) + (f item total)) + init + colls))) (def: node#entries (All (_ k v) (-> (Node k v) (List [k v]))) @@ -575,7 +569,7 @@ (def: .public (empty key_hash) (All (_ k v) (-> (Hash k) (Dictionary k v))) [#hash key_hash - #root empty_node]) + #root ..empty_node]) (def: .public (has key val dict) (All (_ k v) (-> k v (Dictionary k v) (Dictionary k v))) @@ -714,10 +708,10 @@ (def: (each f fa) (case fa {#Hierarchy size hierarchy} - {#Hierarchy size (array#each (each f) hierarchy)} + {#Hierarchy size (array.each (each f) hierarchy)} {#Base bitmap base} - {#Base bitmap (array#each (function (_ either) + {#Base bitmap (array.each (function (_ either) (case either {.#Left fa'} {.#Left (each f fa')} @@ -727,7 +721,7 @@ base)} {#Collisions hash collisions} - {#Collisions hash (array#each (function (_ [k v]) + {#Collisions hash (array.each (function (_ [k v]) [k (f v)]) collisions)}))) diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux index 746654c57..01a33b7c7 100644 --- a/stdlib/source/library/lux/data/collection/sequence.lux +++ b/stdlib/source/library/lux/data/collection/sequence.lux @@ -14,7 +14,7 @@ [mix {"+" Mix}] [predicate {"+" Predicate}]] [control - ["[0]" maybe] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}] ["<>" parser @@ -23,7 +23,8 @@ ["[0]" product] [collection ["[0]" list ("[1]#[0]" mix functor monoid)] - ["[0]" array {"+" Array} ("[1]#[0]" functor mix)]]] + ["[0]" array "_" + ["[1]" \\unsafe {"+" Array}]]]] [macro [syntax {"+" syntax:}] ["[0]" code]] @@ -95,13 +96,13 @@ (if (n.= 0 level) {#Base tail} (|> (empty_hierarchy []) - (array.write! 0 (path (level_down level) tail)) + (array.has! 0 (path (level_down level) tail)) {#Hierarchy}))) (def: (tail singleton) (All (_ a) (-> a (Base a))) (|> (array.empty 1) - (array.write! 0 singleton))) + (array.has! 0 singleton))) (def: (with_tail size level tail parent) (All (_ a) (-> Nat Level (Base a) (Hierarchy a) (Hierarchy a))) @@ -111,41 +112,40 @@ ... Just add the tail to it {#Base tail} ... Otherwise, check whether there's a vacant spot - (case (array.read! sub_idx parent) + (if (array.lacks? sub_idx parent) ... If so, set the path to the tail - {.#None} (..path (level_down level) tail) - ... If not, push the tail onto the sub_node. - {.#Some {#Hierarchy sub_node}} - {#Hierarchy (with_tail size (level_down level) tail sub_node)} + (case (array.item sub_idx parent) + ... If not, push the tail onto the sub_node. + {#Hierarchy sub_node} + {#Hierarchy (with_tail size (level_down level) tail sub_node)} - _ - (undefined)) - )] + _ + (undefined))))] (|> (array.clone parent) - (array.write! sub_idx sub_node)))) + (array.has! sub_idx sub_node)))) (def: (expanded_tail val tail) (All (_ a) (-> a (Base a) (Base a))) (let [tail_size (array.size tail)] (|> (array.empty (++ tail_size)) (array.copy! tail_size 0 tail 0) - (array.write! tail_size val)))) + (array.has! tail_size val)))) (def: (hierarchy#has level idx val hierarchy) (All (_ a) (-> Level Index a (Hierarchy a) (Hierarchy a))) (let [sub_idx (branch_idx (i64.right_shifted level idx))] - (case (array.read! sub_idx hierarchy) - {.#Some {#Hierarchy sub_node}} + (case (array.item sub_idx hierarchy) + {#Hierarchy sub_node} (|> (array.clone hierarchy) - (array.write! sub_idx {#Hierarchy (hierarchy#has (level_down level) idx val sub_node)})) + (array.has! sub_idx {#Hierarchy (hierarchy#has (level_down level) idx val sub_node)})) - (^multi {.#Some {#Base base}} + (^multi {#Base base} (n.= 0 (level_down level))) (|> (array.clone hierarchy) - (array.write! sub_idx (|> (array.clone base) - (array.write! (branch_idx idx) val) - {#Base}))) + (array.has! sub_idx (|> (array.clone base) + (array.has! (branch_idx idx) val) + {#Base}))) _ (undefined)))) @@ -157,21 +157,21 @@ {.#None} (n.> branching_exponent level) - (do maybe.monad - [base|hierarchy (array.read! sub_idx hierarchy) - sub (case base|hierarchy - {#Hierarchy sub} - (without_tail size (level_down level) sub) - - {#Base _} - (undefined))] - (|> (array.clone hierarchy) - (array.write! sub_idx {#Hierarchy sub}) - {.#Some})) + (if (array.lacks? sub_idx hierarchy) + {.#None} + (maybe#each (function (_ sub) + (|> (array.clone hierarchy) + (array.has! sub_idx {#Hierarchy sub}))) + (case (array.item sub_idx hierarchy) + {#Hierarchy sub} + (without_tail size (level_down level) sub) + + {#Base _} + (undefined)))) ... Else... (|> (array.clone hierarchy) - (array.delete! sub_idx) + (array.lacks! sub_idx) {.#Some}) ))) @@ -226,8 +226,8 @@ (|> sequence (with@ #root (|> (`` (: (Hierarchy (~~ (:of val))) (empty_hierarchy []))) - (array.write! 0 {#Hierarchy (value@ #root sequence)}) - (array.write! 1 (..path (value@ #level sequence) (value@ #tail sequence))))) + (array.has! 0 {#Hierarchy (value@ #root sequence)}) + (array.has! 1 (..path (value@ #level sequence) (value@ #tail sequence))))) (revised@ #level level_up)) ... Otherwise, just push the current tail onto the root. (|> sequence @@ -257,32 +257,30 @@ (if (n.< (tail_off (value@ #size sequence)) idx) (loop [level (value@ #level sequence) hierarchy (value@ #root sequence)] - (case [(n.> branching_exponent level) - (array.read! (branch_idx (i64.right_shifted level idx)) hierarchy)] - [#1 {.#Some {#Hierarchy sub}}] - (again (level_down level) sub) - - [#0 {.#Some {#Base base}}] - {try.#Success base} - - [_ {.#None}] - (exception.except ..base_was_not_found []) - - _ - (exception.except ..incorrect_sequence_structure []))) + (let [index (branch_idx (i64.right_shifted level idx))] + (if (array.lacks? index hierarchy) + (exception.except ..base_was_not_found []) + (case [(n.> branching_exponent level) + (array.item index hierarchy)] + [#1 {#Hierarchy sub}] + (again (level_down level) sub) + + [#0 {#Base base}] + {try.#Success base} + + _ + (exception.except ..incorrect_sequence_structure []))))) {try.#Success (value@ #tail sequence)}) (exception.except ..index_out_of_bounds [sequence idx]))) (def: .public (item idx sequence) (All (_ a) (-> Nat (Sequence a) (Try a))) (do try.monad - [base (base_for idx sequence)] - (case (array.read! (branch_idx idx) base) - {.#Some value} - {try.#Success value} - - {.#None} - (exception.except ..incorrect_sequence_structure [])))) + [base (base_for idx sequence) + .let [index (branch_idx idx)]] + (if (array.lacks? index base) + (exception.except ..incorrect_sequence_structure []) + {try.#Success (array.item index base)}))) (def: .public (has idx val sequence) (All (_ a) (-> Nat a (Sequence a) (Try (Sequence a)))) @@ -293,7 +291,7 @@ sequence) (revised@ #tail (`` (: (-> (Base (~~ (:of val))) (Base (~~ (:of val)))) - (|>> array.clone (array.write! (branch_idx idx) val)))) + (|>> array.clone (array.has! (branch_idx idx) val)))) sequence))} (exception.except ..index_out_of_bounds [sequence idx])))) @@ -327,17 +325,20 @@ (loop [level init_level root (maybe.else (empty_hierarchy []) (without_tail sequence_size init_level (value@ #root sequence)))] - (if (n.> branching_exponent level) - (case [(array.read! 1 root) (array.read! 0 root)] - [{.#None} {.#Some {#Hierarchy sub_node}}] - (again (level_down level) sub_node) - - ... [{.#None} {.#Some {#Base _}}] - ... (undefined) - - _ - [level root]) - [level root])))]] + (with_expansions [<else> [level root]] + (if (n.> branching_exponent level) + (if (array.lacks? 1 root) + (case (array.item 0 root) + {#Hierarchy sub_node} + (again (level_down level) sub_node) + + ... {#Base _} + ... (undefined) + + _ + <else>) + <else>) + <else>))))]] (in (|> sequence (revised@ #size --) (with@ #level level') @@ -365,26 +366,26 @@ (syntax: .public (sequence [elems (<>.some <code>.any)]) (in (.list (` (..of_list (.list (~+ elems))))))) -(implementation: (node_equivalence Equivalence<a>) +(implementation: (node_equivalence //#=) (All (_ a) (-> (Equivalence a) (Equivalence (Node a)))) (def: (= v1 v2) (case [v1 v2] [{#Base b1} {#Base b2}] - (# (array.equivalence Equivalence<a>) = b1 b2) + (array.= //#= b1 b2) [{#Hierarchy h1} {#Hierarchy h2}] - (# (array.equivalence (node_equivalence Equivalence<a>)) = h1 h2) + (array.= (node_equivalence //#=) h1 h2) _ #0))) -(implementation: .public (equivalence Equivalence<a>) +(implementation: .public (equivalence //#=) (All (_ a) (-> (Equivalence a) (Equivalence (Sequence a)))) (def: (= v1 v2) (and (n.= (value@ #size v1) (value@ #size v2)) - (let [(^open "node#[0]") (node_equivalence Equivalence<a>)] + (let [(^open "node#[0]") (node_equivalence //#=)] (and (node#= {#Base (value@ #tail v1)} {#Base (value@ #tail v2)}) (node#= {#Hierarchy (value@ #root v1)} @@ -393,23 +394,25 @@ (implementation: node_mix (Mix Node) - (def: (mix f init xs) + (def: (mix $ init xs) (case xs {#Base base} - (array#mix f init base) + (array.mix (function (_ _ item output) ($ item output)) + init + base) {#Hierarchy hierarchy} - (array#mix (function (_ node init') (mix f init' node)) + (array.mix (function (_ _ node init') (mix $ init' node)) init hierarchy)))) (implementation: .public mix (Mix Sequence) - (def: (mix f init xs) + (def: (mix $ init xs) (let [(^open "[0]") node_mix] - (mix f - (mix f + (mix $ + (mix $ init {#Hierarchy (value@ #root xs)}) {#Base (value@ #tail xs)})))) @@ -425,22 +428,24 @@ (implementation: node_functor (Functor Node) - (def: (each f xs) + (def: (each $ xs) (case xs {#Base base} - {#Base (array#each f base)} + {#Base (array.each $ base)} {#Hierarchy hierarchy} - {#Hierarchy (array#each (each f) hierarchy)}))) + {#Hierarchy (array.each (each $) hierarchy)}))) (implementation: .public functor (Functor Sequence) - (def: (each f xs) + (def: (each $ xs) [#level (value@ #level xs) #size (value@ #size xs) - #root (|> xs (value@ #root) (array#each (# node_functor each f))) - #tail (|> xs (value@ #tail) (array#each f))])) + #root (let [... TODO: This binding was established to get around a compilation error. Fix and inline! + $ (# node_functor each $)] + (|> xs (value@ #root) (array.each $))) + #tail (|> xs (value@ #tail) (array.each $))])) (implementation: .public apply (Apply Sequence) @@ -518,9 +523,11 @@ (def: .public (one check items) (All (_ a b) (-> (-> a (Maybe b)) (Sequence a) (Maybe b))) - (case (|> items - (value@ #root) - (array.one (one|node check))) + (case (let [... TODO: This binding was established to get around a compilation error. Fix and inline! + check (..one|node check)] + (|> items + (value@ #root) + (array.one check))) {.#None} (|> items (value@ #tail) |