diff options
author | Eduardo Julian | 2022-03-05 04:30:09 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-03-05 04:30:09 -0400 |
commit | a7fc50b1906fa97fb56d5ebe3d3fff7baee276da (patch) | |
tree | c62e695c6dc264533abe4003a6338d4a39e958c0 | |
parent | ab9dc5fd656ef42dbb0192f96d34e1c7b451a430 (diff) |
Optimizations for the pure-Lux JVM compiler. [Part 5]
21 files changed, 1272 insertions, 893 deletions
diff --git a/documentation/bookmark/back_end/c++.md b/documentation/bookmark/back_end/c++.md index b7eb8b3f3..bf1d04548 100644 --- a/documentation/bookmark/back_end/c++.md +++ b/documentation/bookmark/back_end/c++.md @@ -16,3 +16,7 @@ 0. [vcpkg](https://vcpkg.io/en/index.html) +# constexpr + +0. [Your New Mental Model of constexpr - Jason Turner - CppCon 2021](https://www.youtube.com/watch?v=MdrfPSUtMVM) + diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index e46090db0..657bc4faa 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3363,17 +3363,6 @@ {#None} (failure "Wrong syntax for type:"))) -(template [<name> <to>] - [(def: .public (<name> value) - (-> (I64 Any) <to>) - (:as <to> value))] - - [i64 I64] - [nat Nat] - [int Int] - [rev Rev] - ) - (type: Referrals (Variant {#All} @@ -4819,6 +4808,16 @@ {#None} (failure (..wrong_syntax_error (symbol ..template:))))) +(template [<name> <to>] + [(template: .public (<name> it) + [(..|> it (..: (..I64 ..Any)) (..:as <to>))])] + + [i64 ..I64] + [nat ..Nat] + [int ..Int] + [rev ..Rev] + ) + (macro: .public (as_is tokens compiler) {#Right [compiler tokens]}) diff --git a/stdlib/source/library/lux/control/maybe.lux b/stdlib/source/library/lux/control/maybe.lux index 597953a64..af48067c5 100644 --- a/stdlib/source/library/lux/control/maybe.lux +++ b/stdlib/source/library/lux/control/maybe.lux @@ -129,7 +129,7 @@ (case tokens (^ (.list else maybe)) (let [g!temp (: Code [location.dummy {.#Symbol ["" ""]}])] - {.#Right [state (.list (` (case (~ maybe) + {.#Right [state (.list (` (.case (~ maybe) {.#Some (~ g!temp)} (~ g!temp) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index a8e41dcc9..f2b2e7f5d 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -163,7 +163,7 @@ [(`` (def: .public <name> (Parser Binary) (do //.monad - [size (//#each .nat <bits>)] + [size (//#each (|>> .nat) <bits>)] (..segment size))))] [08 binary/8 ..bits/8] diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 8df174ce5..be2a236ea 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -1,7 +1,6 @@ (.using [library [lux "*" - ["@" target] ["[0]" ffi] [abstract [equivalence {"+" Equivalence}] @@ -13,7 +12,8 @@ [text ["%" format]] [collection - ["[0]" array]]] + ["[0]" array + [\\unsafe {"+"}]]]] [math [number ["n" nat]]]]] 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) diff --git a/stdlib/source/library/lux/math/number/i64.lux b/stdlib/source/library/lux/math/number/i64.lux index 403ed07f0..281ea025e 100644 --- a/stdlib/source/library/lux/math/number/i64.lux +++ b/stdlib/source/library/lux/math/number/i64.lux @@ -128,7 +128,7 @@ (def: &equivalence ..equivalence) - (def: hash .nat)) + (def: hash (|>> .nat))) (template [<monoid> <identity> <composite>] [(implementation: .public <monoid> diff --git a/stdlib/source/library/lux/math/number/int.lux b/stdlib/source/library/lux/math/number/int.lux index 3967ca6d9..67c640f22 100644 --- a/stdlib/source/library/lux/math/number/int.lux +++ b/stdlib/source/library/lux/math/number/int.lux @@ -220,7 +220,7 @@ (|> repr ("lux text clip" 1 (-- input_size)) (# <codec> decoded) - (# try.functor each .int)) + (# try.functor each (|>> .int))) (^ (static ..-sign)) (|> repr @@ -242,7 +242,7 @@ (Hash Int) (def: &equivalence ..equivalence) - (def: hash .nat)) + (def: hash (|>> .nat))) (def: .public (right_shifted parameter subject) (-> Nat Int Int) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index 959853be7..86a962e88 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - [abstract - [hash {"+" Hash}] - [enum {"+" Enum}] - [interval {"+" Interval}] - [monoid {"+" Monoid}] - [equivalence {"+" Equivalence}] - [codec {"+" Codec}] - [order {"+" Order}]] - [control - ["[0]" maybe] - ["[0]" try]] - [data - [collection - ["[0]" array {"+" Array}]]]]] - ["[0]" // "_" - ["[1][0]" i64] - ["[1][0]" nat] - ["[1][0]" int]]) + [library + [lux "*" + [abstract + [hash {"+" Hash}] + [enum {"+" Enum}] + [interval {"+" Interval}] + [monoid {"+" Monoid}] + [equivalence {"+" Equivalence}] + [codec {"+" Codec}] + [order {"+" Order}]] + [control + ["[0]" maybe] + ["[0]" try]] + [data + [collection + ["[0]" array {"+" Array}]]]]] + ["[0]" // "_" + ["[1][0]" i64] + ["[1][0]" nat] + ["[1][0]" int]]) (def: .public /1 Rev @@ -186,7 +186,7 @@ (Hash Rev) (def: &equivalence ..equivalence) - (def: hash .nat)) + (def: hash (|>> .nat))) (implementation: .public order (Order Rev) @@ -225,7 +225,7 @@ ("lux text clip" 1 (-- ("lux text size" input)) input)) (template [<struct> <codec> <char_bit_size> <error>] - [(with_expansions [<error_output> (as_is {try.#Failure ("lux text concat" <error> repr)})] + [(with_expansions [<failure> (as_is {try.#Failure ("lux text concat" <error> repr)})] (implementation: .public <struct> (Codec Text Rev) @@ -256,12 +256,12 @@ {try.#Success output} {try.#Success (.rev output)} - _ - <error_output>) + failure + <failure>) - _ - <error_output>) - <error_output>)))))] + else + <failure>) + <failure>)))))] [binary //nat.binary 1 "Invalid binary syntax: "] [octal //nat.octal 3 "Invalid octal syntax: "] diff --git a/stdlib/source/library/lux/math/random.lux b/stdlib/source/library/lux/math/random.lux index 1b3a9426a..7ae9974a8 100644 --- a/stdlib/source/library/lux/math/random.lux +++ b/stdlib/source/library/lux/math/random.lux @@ -126,7 +126,7 @@ (template [<name> <type> <cast>] [(def: .public <name> (Random <type>) - (# ..functor each <cast> ..i64))] + (# ..functor each (|>> <cast>) ..i64))] [nat Nat .nat] [int Int .int] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index 26e21c065..1e285ebb2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -25,8 +25,9 @@ [synthesis ["[0]" case]] ["/[1]" // "_" - ["[1][0]" synthesis {"+" Member Synthesis Path}] ["[1][0]" generation] + ["[1][0]" synthesis {"+" Synthesis Path} + ["[0]" member {"+" Member}]] ["//[1]" /// "_" [reference ["[1][0]" variable {"+" Register}]] @@ -108,13 +109,11 @@ (do ///////phase.monad [valueO (expression archive valueS)] (in (list#mix (function (_ side source) - (.let [method (.case side - (^template [<side> <accessor>] - [{<side> lefts} - (<accessor> (_.int (.int lefts)))]) - ([.#Left //runtime.tuple::left] - [.#Right //runtime.tuple::right]))] - (method source))) + (.let [method (.if (value@ member.#right? side) + //runtime.tuple::right + //runtime.tuple::left)] + (method (_.int (.int (value@ member.#lefts side))) + source))) valueO (list.reversed pathP))))) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index d597ee7da..2f1d82a31 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -581,7 +581,7 @@ (def: file_size (|>> os/path::getsize - (# (try.with io.monad) each .nat))) + (# (try.with io.monad) each (|>> .nat)))) (def: last_modified (|>> os/path::getmtime diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index 656c94c2a..0985eb5ed 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -75,7 +75,7 @@ (def: encoded (|>> .nat (# nat_codec encoded))) (def: decoded - (|>> (# nat_codec decoded) (# try.functor each .int)))) + (|>> (# nat_codec decoded) (# try.functor each (|>> .int))))) ... Builds a JSON generator for potentially inexistent values. (def: (nullable writer) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 7ee6a59e6..0a2f2fbeb 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -1,37 +1,37 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - ["[0]" monad {"+" do}]] - [control - [pipe {"+" case>}] - ["<>" parser] - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" bit] - ["[0]" text] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat] - ["[0]" i64] - ["[0]" frac]]] - [meta - ["[0]" symbol]] - [tool - [compiler - [reference {"+" } - ["[0]" variable {"+" Variable}]] - [language - [lux - [analysis {"+" Environment}] - ["[0]" synthesis {"+" Synthesis}]]]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}]] + [control + [pipe {"+" case>}] + ["<>" parser] + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" bit] + ["[0]" text] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat] + ["[0]" i64] + ["[0]" frac]]] + [meta + ["[0]" symbol]] + [tool + [compiler + [reference {"+" } + ["[0]" variable {"+" Variable}]] + [language + [lux + [analysis {"+" Environment}] + ["[0]" synthesis {"+" Synthesis}]]]]]]] + [\\library + ["[0]" /]]) (template: (!expect <pattern> <value>) [(case <value> @@ -80,7 +80,7 @@ ))] [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (# ! each .i64 random.nat) synthesis.i64 i64.equivalence] + [/.i64 /.i64! random.i64 synthesis.i64 i64.equivalence] [/.f64 /.f64! random.safe_frac synthesis.f64 frac.equivalence] [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] @@ -94,7 +94,7 @@ ($_ _.and (do [! random.monad] [expected_bit random.bit - expected_i64 (# ! each .i64 random.nat) + expected_i64 random.i64 expected_f64 random.safe_frac expected_text (random.unicode 1)] (_.cover [/.tuple] @@ -165,7 +165,7 @@ (_.for [/.Parser]) ($_ _.and (do [! random.monad] - [expected (# ! each (|>> synthesis.i64) random.nat)] + [expected (# ! each (|>> synthesis.i64) random.i64)] (_.cover [/.result /.any] (|> (/.result /.any (list expected)) (!expect (^multi {try.#Success actual} @@ -175,13 +175,13 @@ (!expect (^multi {try.#Failure error} (exception.match? /.empty_input error))))) (do [! random.monad] - [expected (# ! each (|>> synthesis.i64) random.nat)] + [expected (# ! each (|>> synthesis.i64) random.i64)] (_.cover [/.unconsumed_input] (|> (/.result /.any (list expected expected)) (!expect (^multi {try.#Failure error} (exception.match? /.unconsumed_input error)))))) (do [! random.monad] - [dummy (# ! each (|>> synthesis.i64) random.nat)] + [dummy (# ! each (|>> synthesis.i64) random.i64)] (_.cover [/.end! /.expected_empty_input] (and (|> (/.result /.end! (list)) (!expect {try.#Success _})) @@ -189,7 +189,7 @@ (!expect (^multi {try.#Failure error} (exception.match? /.expected_empty_input error))))))) (do [! random.monad] - [dummy (# ! each (|>> synthesis.i64) random.nat)] + [dummy (# ! each (|>> synthesis.i64) random.i64)] (_.cover [/.end?] (and (|> (/.result /.end? (list)) (!expect {try.#Success #1})) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index e2072944f..d179058fd 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -14,8 +14,9 @@ ["[0]" exception {"+" Exception}]] [data [collection - [array {"+"}] - ["[0]" list ("[1]#[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)] + [array + [\\unsafe {"+"}]]]] [math ["[0]" random {"+" Random}] [number diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 2eca1688b..b0daba12a 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -3,14 +3,17 @@ [lux "*" ["_" test {"+" Test}] [abstract + [functor {"+"}] [monad {"+" do}] + ["[0]" monoid + ["$[1]" \\specification]] + ["[0]" mix {"+" Mix} + ["$[1]" \\specification]] [\\specification ["$[0]" equivalence] - ["$[0]" monoid] - ["$[0]" mix] ["$[0]" functor {"+" Injection}]]] [control - ["[0]" maybe]] + ["[0]" maybe ("[1]#[0]" functor)]] [data ["[0]" bit] ["[0]" text ("[1]#[0]" equivalence)] @@ -22,7 +25,8 @@ [number ["n" nat]]]]] [\\library - ["[0]" / {"+" Array}]]) + ["[0]" / {"+" Array} + ["!" \\unsafe]]]) (def: injection (Injection Array) @@ -110,6 +114,184 @@ (/.any? n.even? the_array))) ))) +(def: test|unsafe + Test + (<| (_.covering !._) + (_.for [!.Array]) + (do [! random.monad] + [size ..bounded_size + base random.nat + shift random.nat + dummy (random.only (|>> (n.= base) not) random.nat) + .let [expected (n.+ base shift)] + the_array (random.array size random.nat) + evens (random.array size (random.only n.even? random.nat))] + (`` ($_ _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= n.equivalence left right)) + (random.array size random.nat))) + (_.for [!.composite] + ($monoid.spec (/.equivalence n.equivalence) + (implementation + (def: identity (!.empty 0)) + (def: (composite left right) + (!.composite left right))) + (random.array size random.nat))) + (_.for [!.each] + ($functor.spec ..injection /.equivalence + (function (_ $ it) + (!.each $ it)))) + (_.for [!.mix] + ($mix.spec ..injection /.equivalence + (: (Mix !.Array) + (function (_ $ init it) + (!.mix (function (_ index item output) + ($ item output)) + init + it))))) + + (_.cover [!.empty !.size] + (n.= size (!.size (: (Array Nat) + (!.empty size))))) + (_.cover [!.type] + (case !.Array + (^ (<| {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) + (same? !.type nominal_type) + + _ + false)) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.item !.has!] + (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 expected) + (!.item 0) + (n.= expected))) + (_.cover [!.lacks!] + (|> (!.empty 1) + (: (Array Nat)) + (!.has! 0 expected) + (!.lacks! 0) + (!.lacks? 0))) + (_.cover [!.revised!] + (|> (!.empty 1) + (: (Array Nat)) + (!.has! 0 base) + (!.revised! 0 (n.+ shift)) + (!.item 0) + (n.= expected))) + (_.cover [!.upsert!] + (let [the_array (|> (!.empty 2) + (: (Array Nat)) + (!.has! 0 base) + (!.upsert! 0 dummy (n.+ shift)) + (!.upsert! 1 base (n.+ shift)))] + (and (n.= expected (!.item 0 the_array)) + (n.= expected (!.item 1 the_array))))) + (do ! + [occupancy (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.occupancy !.vacancy] + (let [the_array (loop [output (: (Array Nat) + (!.empty size)) + idx 0] + (if (n.< occupancy idx) + (again (!.has! idx expected output) + (++ idx)) + output))] + (and (n.= occupancy (!.occupancy the_array)) + (n.= size (n.+ (!.occupancy the_array) + (!.vacancy the_array))))))) + (do ! + [the_list (random.list size random.nat) + .let [the_array (!.clone the_array) + members (|> the_array (!.list {.#None}) (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] + (_.cover [!.of_list !.list] + (and (|> the_list !.of_list (!.list {.#None}) + (# (list.equivalence n.equivalence) = the_list)) + (|> the_array (!.list {.#None}) !.of_list + (!.= n.equivalence the_array)) + (exec + (!.only! n.even? the_array) + (list.every? (function (_ value) + (or (n.even? value) + (same? default value))) + (!.list {.#Some default} the_array)))))) + (do ! + [amount (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.copy!] + (let [copy (: (Array Nat) + (!.empty size))] + (exec (!.copy! amount 0 the_array 0 copy) + (# (list.equivalence n.equivalence) = + (list.first amount (!.list {.#None} the_array)) + (!.list {.#None} copy)))))) + (_.cover [!.clone] + (let [clone (!.clone the_array)] + (and (not (same? the_array clone)) + (!.= n.equivalence the_array clone)))) + (let [the_array (!.clone the_array) + evens (|> the_array (!.list {.#None}) (list.only n.even?)) + odds (|> the_array (!.list {.#None}) (list.only n.odd?))] + (_.cover [!.only!] + (exec (!.only! n.even? the_array) + (and (n.= (list.size evens) (!.occupancy the_array)) + (n.= (list.size odds) (!.vacancy the_array)) + (|> the_array + (!.list {.#None}) + (# (list.equivalence n.equivalence) = evens)))))) + (let [choose (: (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (_.cover [!.one] + (|> evens + (!.one choose) + (maybe#each (text#= (|> evens + (!.each (# n.decimal encoded)) + (!.item 0)))) + (maybe.else false)))) + (_.cover [!.example] + (# (maybe.equivalence n.equivalence) = + (!.example n.even? the_array) + (list.example n.even? (!.list {.#None} the_array)))) + (_.cover [!.example'] + (case [(!.example n.even? the_array) + (!.example' (function (_ idx member) + (n.even? member)) + the_array)] + [{.#Some expected} {.#Some [idx actual]}] + (and (not (!.lacks? idx the_array)) + (n.= expected actual) + (n.= actual (!.item idx the_array))) + + [{.#None} {.#None}] + true + + _ + false)) + (_.cover [!.every?] + (# bit.equivalence = + (list.every? n.even? (!.list {.#None} the_array)) + (!.every? n.even? the_array))) + (_.cover [!.any?] + (# bit.equivalence = + (list.any? n.even? (!.list {.#None} the_array)) + (!.any? n.even? the_array))) + ))))) + (def: .public test Test (<| (_.covering /._) @@ -130,7 +312,10 @@ (/.empty size))))) (_.cover [/.type_name] (case /.Array - (^ {.#Named _ {.#UnivQ _ {.#Primitive nominal_type (list {.#Parameter 1})}}}) + (^ (<| {.#Named (symbol /.Array)} + {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) (same? /.type_name nominal_type) _ @@ -163,7 +348,6 @@ (/.write! 0 expected))] (and (/.contains? 0 the_array) (not (/.contains? 1 the_array))))) - (_.cover [/.update!] (let [the_array (|> (/.empty 1) (: (Array Nat)) @@ -242,4 +426,6 @@ (and (n.= (list.size evens) (/.occupancy the_array)) (n.= (list.size odds) (/.vacancy the_array)) (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) + + ..test|unsafe )))) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index 8ff0e74a2..b09be8b72 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -459,6 +459,7 @@ (do [! random.monad] [$var/0 (# ! each (|>> %.nat (format "v0_") /.var) random.nat) $var/1 (# ! each (|>> %.nat (format "v1_") /.var) random.nat) + $def (# ! each (|>> %.nat (format "def_") /.var) random.nat) expected/0 random.safe_frac expected/1 random.safe_frac dummy/0 random.safe_frac @@ -529,6 +530,37 @@ (:as Bit) not) )) + (_.cover [/.globals/0] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.def $def (list $var/0) + (/.return (/.in? /.globals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.globals/0 (/.string (/.code $var/0)))) + (/.not (/.apply/* (list (/.float dummy/0)) $def)))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.globals/0 (/.string (/.code $var/0)))))))) + (:as Bit))) + (_.cover [/.locals/0] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.def $def (list $var/0) + (/.return (/.in? /.locals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.locals/0 (/.string (/.code $var/0)))) + (/.apply/* (list (/.float dummy/0)) $def))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.locals/0 (/.string (/.code $var/0)))))))) + (:as Bit))) + (_.cover [/.import] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.import "math") + (/.set (list $output) (/.in? /.globals/0 (/.string "math")))))) + (:as Bit))) (_.for [/.Access] ..test|access) ))) @@ -665,6 +697,23 @@ {.#None})))) (:as Nat) (n.= expected))) + (_.cover [/.break] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + ($_ /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int factor)) $iteration) + /.break + (/.set (list $output) (/.+ (/.int (.int base)) + $output)))) + {.#None})))) + (:as Nat) + (n.= expected))) ))) (def: test|statement @@ -721,6 +770,13 @@ (/.set (list $output) (/.apply/* (list) $def))))) (:as Frac) (f.= expected/0))) + (_.cover [/.exec] + (|> (..statement + (function (_ $output) + (/.exec {.#Some /.globals/0} + (/.string (/.code (/.set (list $output) (/.float expected/0))))))) + (:as Frac) + (f.= expected/0))) ..test|exception (_.for [/.Location] ..test|location) diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux index 3f542ce73..f5e4d5b4e 100644 --- a/stdlib/source/unsafe/lux/data/binary.lux +++ b/stdlib/source/unsafe/lux/data/binary.lux @@ -8,7 +8,8 @@ [inline {"+" inline:}]]] [data [collection - ["[0]" array]]] + ["[0]" array "_" + ["[1]" \\unsafe]]]] [math [number {"+" hex} ["[0]" i64]]]]]) @@ -53,273 +54,271 @@ (type: .public Binary (array.Array (I64 Any))))) -(with_expansions [<size> (: Nat size) - <jvm> (ffi.array byte <size>) - <jvm> (: ..Binary <jvm>)] - (template: .public (empty size) - [(: ..Binary - (for [@.old <jvm> - @.jvm <jvm> - - @.js - (|> <size> - .int - "lux i64 f64" - [] - ("js object new" ("js constant" "ArrayBuffer")) - [] - ("js object new" ("js constant" "Uint8Array")) - (:as ..Binary)) - - @.python - (|> <size> - ("python apply" (:as ffi.Function ("python constant" "bytearray"))) - (:as ..Binary)) - - @.scheme - (..make-bytevector <size>)] - - ... Default - (array.empty <size>)))])) - -(with_expansions [<it> (: ..Binary it) - <jvm> (ffi.length <it>)] - (template: .public (size it) - [(: Nat - (for [@.old <jvm> - @.jvm <jvm> - - @.js - (|> <it> - ("js object get" "length") - (:as Frac) - "lux f64 i64" - .nat) - - @.python - (|> <it> - (:as (array.Array (I64 Any))) - "python array length") - - @.scheme - (..bytevector-length [<it>])] - - ... Default - (array.size <it>)))])) +(`` (with_expansions [<size> (.: .Nat size) + <jvm> (ffi.array byte <size>) + <jvm> (.: ..Binary <jvm>)] + (template: .public (empty size) + [(: ..Binary + (for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm> + + (~~ (.static @.js)) + (.|> <size> + .int + "lux i64 f64" + [] + ("js object new" ("js constant" "ArrayBuffer")) + [] + ("js object new" ("js constant" "Uint8Array")) + (.:as ..Binary)) + + (~~ (.static @.python)) + (.|> <size> + ("python apply" (.:as ffi.Function ("python constant" "bytearray"))) + (.:as ..Binary)) + + (~~ (.static @.scheme)) + (..make-bytevector <size>)] + + ... Default + (array.empty <size>)))]))) + +(`` (with_expansions [<it> (.: ..Binary it) + <jvm> (ffi.length <it>)] + (template: .public (size it) + [(.: .Nat + (.for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm> + + (~~ (.static @.js)) + (.|> <it> + ("js object get" "length") + (.:as .Frac) + "lux f64 i64" + .nat) + + (~~ (.static @.python)) + (.|> <it> + (.:as (array.Array (.I64 .Any))) + "python array length") + + (~~ (.static @.scheme)) + (..bytevector-length [<it>])] + + ... Default + (array.size <it>)))]))) (def: byte_mask Nat (i64.mask i64.bits_per_byte)) (with_expansions [<byte_mask> (.static ..byte_mask) - <it> (: ..Binary it) - <index> (: Nat index) + <it> (.: ..Binary it) + <index> (.: .Nat index) <jvm> (ffi.read! <index> <it>) <jvm> (ffi.byte_to_long <jvm>) - <jvm> (|> <jvm> - (:as I64) - ("lux i64 and" <byte_mask>))] + <jvm> (.|> <jvm> + (.:as .I64) + ("lux i64 and" <byte_mask>))] (template: .public (bytes/1 index it) - [(<| (:as .I64) - (: (.I64 .Any)) - (`` (for [@.old (~~ <jvm>) - @.jvm (~~ <jvm>) - - @.js - (|> <it> - (:as (array.Array .Frac)) - ("js array read" <index>) - "lux f64 i64" - .i64) - - @.python - (|> <it> - (:as (array.Array .I64)) - ("python array read" <index>)) - - @.scheme - (..bytevector-u8-ref [<it> <index>])] - - ... Default - (.case (array.read! <index> <it>) - {.#Some it} - it - - {.#None} - (.i64 (: (I64 Any) 0))))))])) + [(.<| (.:as .I64) + (.: (.I64 .Any)) + (`` (.for [(~~ (.static @.old)) (~~ <jvm>) + (~~ (.static @.jvm)) (~~ <jvm>) + + (~~ (.static @.js)) + (.|> <it> + (.:as (array.Array .Frac)) + ("js array read" <index>) + "lux f64 i64" + .i64) + + (~~ (.static @.python)) + (.|> <it> + (.:as (array.Array .I64)) + ("python array read" <index>)) + + (~~ (.static @.scheme)) + (..bytevector-u8-ref [<it> <index>])] + + ... Default + (.if (array.lacks? <index> <it>) + (.i64 0) + (array.item <index> <it>)))))])) (template: .public (bytes/2 index' it') - [(<| (let [index (: Nat index') - it (: ..Binary it')]) - (:as .I64) - (: (.I64 .Any)) - ($_ "lux i64 or" - ("lux i64 left-shift" 8 (..bytes/1 index it)) - (..bytes/1 ("lux i64 +" 1 index) it)))]) + [(.<| (.let [index (.: Nat index') + it (.: ..Binary it')]) + (.:as .I64) + (.: (.I64 .Any)) + (.$_ "lux i64 or" + ("lux i64 left-shift" 8 (..bytes/1 index it)) + (..bytes/1 ("lux i64 +" 1 index) it)))]) (template: .public (bytes/4 index' it') - [(<| (let [index (: Nat index') - it (: ..Binary it')]) - (:as .I64) - (: (.I64 .Any)) - ($_ "lux i64 or" - ("lux i64 left-shift" 24 (..bytes/1 index it)) - ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 1 index) it)) - ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 2 index) it)) - (..bytes/1 ("lux i64 +" 3 index) it)))]) + [(.<| (.let [index (.: Nat index') + it (.: ..Binary it')]) + (.:as .I64) + (.: (.I64 .Any)) + (.$_ "lux i64 or" + ("lux i64 left-shift" 24 (..bytes/1 index it)) + ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 1 index) it)) + ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 2 index) it)) + (..bytes/1 ("lux i64 +" 3 index) it)))]) (template: .public (bytes/8 index' it') - [(<| (let [index (: Nat index') - it (: ..Binary it')]) - (:as .I64) - (: (.I64 .Any)) - ($_ "lux i64 or" - ("lux i64 left-shift" 56 (..bytes/1 index it)) - ("lux i64 left-shift" 48 (..bytes/1 ("lux i64 +" 1 index) it)) - ("lux i64 left-shift" 40 (..bytes/1 ("lux i64 +" 2 index) it)) - ("lux i64 left-shift" 32 (..bytes/1 ("lux i64 +" 3 index) it)) - ("lux i64 left-shift" 24 (..bytes/1 ("lux i64 +" 4 index) it)) - ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 5 index) it)) - ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 6 index) it)) - (..bytes/1 ("lux i64 +" 7 index) it)))]) + [(.<| (.let [index (.: Nat index') + it (.: ..Binary it')]) + (.:as .I64) + (.: (.I64 .Any)) + (.$_ "lux i64 or" + ("lux i64 left-shift" 56 (..bytes/1 index it)) + ("lux i64 left-shift" 48 (..bytes/1 ("lux i64 +" 1 index) it)) + ("lux i64 left-shift" 40 (..bytes/1 ("lux i64 +" 2 index) it)) + ("lux i64 left-shift" 32 (..bytes/1 ("lux i64 +" 3 index) it)) + ("lux i64 left-shift" 24 (..bytes/1 ("lux i64 +" 4 index) it)) + ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 5 index) it)) + ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 6 index) it)) + (..bytes/1 ("lux i64 +" 7 index) it)))]) (with_expansions [<byte> (hex "FF") - <it> (: ..Binary it) - <index> (: Nat index) - <value> (: (I64 Any) value) - <jvm_value> (for [@.old - (:as Int <value>) - - @.jvm - (:as (Primitive "java.lang.Long") <value>)] - <value>) + <it> (.: ..Binary it) + <index> (.: .Nat index) + <value> (.: (.I64 .Any) value) + <jvm_value> (`` (.for [(~~ (.static @.old)) + (.:as .Int <value>) + + (~~ (.static @.jvm)) + (.:as (.Primitive "java.lang.Long") <value>)] + <value>)) + <jvm_value> <jvm_value> <jvm_value> (ffi.long_to_byte <jvm_value>) <jvm> (ffi.write! <index> <jvm_value> <it>)] - (template: .public (with/1! index value it) - [(: ..Binary - (for [@.old <jvm> - @.jvm <jvm> - - @.js - (|> <it> - (: ..Binary) - (:as (array.Array .Frac)) - ("js array write" <index> - (|> <value> - .int - ("lux i64 and" (.int <byte>)) - "lux i64 f64")) - (:as ..Binary)) - - @.python - (|> <it> - (: ..Binary) - (:as (array.Array (I64 Any))) - ("python array write" <index> (|> <value> ("lux i64 and" <byte>) (: (I64 Any)))) - (:as ..Binary)) - - @.scheme - (let [it' <it>] - (exec - (..bytevector-u8-set! [it' <index> <value>]) - it'))] - - ... Default - (array.write! <index> (|> <value> .int ("lux i64 and" (.int <byte>))) <it>)))])) + (`` (template: .public (with/1! index value it) + [(.: ..Binary + (.for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm> + + (~~ (.static @.js)) + (.|> <it> + (.: ..Binary) + (.:as (array.Array .Frac)) + ("js array write" <index> + (.|> <value> + .int + ("lux i64 and" (.int <byte>)) + "lux i64 f64")) + (.:as ..Binary)) + + (~~ (.static @.python)) + (.|> <it> + (.: ..Binary) + (.:as (array.Array (.I64 .Any))) + ("python array write" <index> (.|> <value> ("lux i64 and" <byte>) (.: (.I64 .Any)))) + (.:as ..Binary)) + + (~~ (.static @.scheme)) + (.let [it' <it>] + (.exec + (..bytevector-u8-set! [it' <index> <value>]) + it'))] + + ... Default + (array.has! <index> (.|> <value> .int ("lux i64 and" (.int <byte>))) <it>)))]))) (template: .public (with/2! index' value' it) - [(let [index (: Nat index') - value (: (I64 Any) value')] - (|> it - (..with/1! index ("lux i64 right-shift" 8 value)) - (..with/1! ("lux i64 +" 1 index) value)))]) + [(.let [index (.: .Nat index') + value (.: (.I64 .Any) value')] + (.|> it + (..with/1! index ("lux i64 right-shift" 8 value)) + (..with/1! ("lux i64 +" 1 index) value)))]) (template: .public (with/4! index' value' it) - [(let [index (: Nat index') - value (: (I64 Any) value')] - (|> it - (..with/1! index ("lux i64 right-shift" 24 value)) - (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value)) - (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value)) - (..with/1! ("lux i64 +" 3 index) value)))]) - -(template: .public (with/8! index' value' it) - [(let [index (: Nat index') - value (: (I64 Any) value')] - (for [@.scheme (let [write_high (: (-> ..Binary ..Binary) - (|>> (..with/1! index ("lux i64 right-shift" 56 value)) - (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value)) - (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value)) - (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value)))) - write_low (: (-> ..Binary ..Binary) - (|>> (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value)) - (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value)) - (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value)) - (..with/1! ("lux i64 +" 7 index) value)))] - (|> it - write_high - write_low))] - (|> it - (..with/1! index ("lux i64 right-shift" 56 value)) - (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value)) - (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value)) - (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value)) - (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value)) - (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value)) - (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value)) - (..with/1! ("lux i64 +" 7 index) value))))]) - -(with_expansions [<reference> (: ..Binary reference') - <sample> (: ..Binary sample') + [(.let [index (.: .Nat index') + value (.: (.I64 .Any) value')] + (.|> it + (..with/1! index ("lux i64 right-shift" 24 value)) + (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value)) + (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value)) + (..with/1! ("lux i64 +" 3 index) value)))]) + +(`` (template: .public (with/8! index' value' it) + [(.let [index (.: .Nat index') + value (.: (.I64 .Any) value')] + (.for [(~~ (.static @.scheme)) (.let [write_high (.: (.-> ..Binary ..Binary) + (.|>> (..with/1! index ("lux i64 right-shift" 56 value)) + (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value)) + (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value)) + (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value)))) + write_low (.: (.-> ..Binary ..Binary) + (.|>> (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value)) + (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value)) + (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value)) + (..with/1! ("lux i64 +" 7 index) value)))] + (.|> it + write_high + write_low))] + (.|> it + (..with/1! index ("lux i64 right-shift" 56 value)) + (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value)) + (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value)) + (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value)) + (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value)) + (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value)) + (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value)) + (..with/1! ("lux i64 +" 7 index) value))))])) + +(with_expansions [<reference> (.: ..Binary reference') + <sample> (.: ..Binary sample') <jvm> (java/util/Arrays::equals <reference> <sample>) <jvm> (ffi.of_boolean <jvm>)] - (template: .public (= reference' sample') - [(for [@.old <jvm> - @.jvm <jvm>] - (let [reference <reference> - sample <sample> - limit (..size reference)] - (and ("lux i64 =" limit (..size sample)) - (loop [index 0] - (if ("lux i64 =" limit index) - true - (and ("lux i64 =" - (..bytes/1 index reference) - (..bytes/1 index sample)) - (again (++ index))))))))])) + (`` (template: .public (= reference' sample') + [(.for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm>] + (.let [reference <reference> + sample <sample> + limit (..size reference)] + (.and ("lux i64 =" limit (..size sample)) + (.loop [index 0] + (.if ("lux i64 =" limit index) + .true + (.and ("lux i64 =" + (..bytes/1 index reference) + (..bytes/1 index sample)) + (again ("lux i64 +" 1 index))))))))]))) ... TODO: Turn into a template ASAP. -(inline: .public (copy! bytes source_offset source target_offset target) - (-> Nat Nat ..Binary Nat ..Binary ..Binary) - (with_expansions [<jvm> (java/lang/System::arraycopy source (ffi.as_int (.int source_offset)) - target (ffi.as_int (.int target_offset)) - (ffi.as_int (.int bytes))) - <jvm> (exec - <jvm> - target)] - (for [@.old <jvm> - @.jvm <jvm>] - - ... Default - (loop [index 0] - (if ("lux i64 <" (.int bytes) (.int index)) - (exec - (..with/1! ("lux i64 +" target_offset index) - (..bytes/1 ("lux i64 +" source_offset index) source) - target) - (again (++ index))) - target))))) +(`` (inline: .public (copy! bytes source_offset source target_offset target) + (-> .Nat .Nat ..Binary Nat ..Binary ..Binary) + (with_expansions [<jvm> (java/lang/System::arraycopy source (ffi.as_int (.int source_offset)) + target (ffi.as_int (.int target_offset)) + (ffi.as_int (.int bytes))) + <jvm> (.exec + <jvm> + target)] + (.for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm>] + + ... Default + (.loop [index 0] + (.if ("lux i64 <" (.int bytes) (.int index)) + (.exec + (..with/1! ("lux i64 +" target_offset index) + (..bytes/1 ("lux i64 +" source_offset index) source) + target) + (again ("lux i64 +" 1 index))) + target)))))) ... TODO: Turn into a template ASAP. -(with_expansions [<jvm> (java/util/Arrays::copyOfRange binary - (ffi.as_int (.int offset)) - (ffi.as_int (.int limit))) - <jvm> (let [limit ("lux i64 +" size offset)] - <jvm>)] - (inline: .public (slice offset size binary) - (-> Nat Nat ..Binary ..Binary) - (for [@.old <jvm> - @.jvm <jvm>] - - ... Default - (..copy! size offset binary 0 (..empty size))))) +(`` (with_expansions [<jvm> (java/util/Arrays::copyOfRange binary + (ffi.as_int (.int offset)) + (ffi.as_int (.int limit))) + <jvm> (.let [limit ("lux i64 +" size offset)] + <jvm>)] + (inline: .public (slice offset size binary) + (-> .Nat .Nat ..Binary ..Binary) + (.for [(~~ (.static @.old)) <jvm> + (~~ (.static @.jvm)) <jvm>] + + ... Default + (..copy! size offset binary 0 (..empty size)))))) diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux new file mode 100644 index 000000000..cd6bebf63 --- /dev/null +++ b/stdlib/source/unsafe/lux/data/collection/array.lux @@ -0,0 +1,409 @@ +(.using + [library + [lux {"-" type list} + ["@" target] + [abstract + ["[0]" functor]] + [data + [collection + ["[0]" list]]]]]) + +(def: .public type + "#Array") + +(type: .public (Array a) + {.#Primitive ..type {.#Item a {.#End}}}) + +(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)) + + (`` (template: .public (empty <size>) + [((.: (.All (_ a) (.-> .Nat (..Array a))) + (.function (empty size) + (.for [(~~ (.static @.old)) + (.:expected ("jvm anewarray" "(java.lang.Object )" size)) + + (~~ (.static @.jvm)) + (|> (~~ (..int! size)) + "jvm array new object" + (.: <array_type>) + .:expected) + + (~~ (.static @.js)) ("js array new" size) + (~~ (.static @.python)) ("python array new" size) + (~~ (.static @.lua)) ("lua array new" size) + (~~ (.static @.ruby)) ("ruby array new" size) + (~~ (.static @.php)) ("php array new" size) + (~~ (.static @.scheme)) ("scheme array new" size)]))) + <size>)])) + + (`` (template: .public (size <array>) + [((.: (.All (_ a) (.-> (..Array a) .Nat)) + (.function (size array) + (.for [(~~ (.static @.old)) + ("jvm arraylength" array) + + (~~ (.static @.jvm)) + (.|> array + (.:as <array_type>) + "jvm array length object" + "jvm conversion int-to-long" + "jvm object cast" + (.: <index_type>) + (.:as .Nat)) + + (~~ (.static @.js)) ("js array length" array) + (~~ (.static @.python)) ("python array length" array) + (~~ (.static @.lua)) ("lua array length" array) + (~~ (.static @.ruby)) ("ruby array length" array) + (~~ (.static @.php)) ("php array length" array) + (~~ (.static @.scheme)) ("scheme array length" array)]))) + <array>)])) + + (template: (lacks?' <read!> <null?> index array) + [(<null?> (<read!> index array))]) + + (`` (template: .public (lacks? <index> <array>) + [((.: (.All (_ a) + (.-> .Nat (..Array a) .Bit)) + (.function (lacks? index array) + (.let [size (..size array)] + (.if ("lux i64 <" (.int size) (.int index)) + (.for [(~~ (.static @.old)) + ("jvm object null?" ("jvm aaload" array index)) + + (~~ (.static @.jvm)) + (.|> array + (.:as <array_type>) + ("jvm array read object" (~~ (int! index))) + "jvm object null?") + + (~~ (.static @.js)) (~~ (lacks?' "js array read" "js object undefined?" index array)) + (~~ (.static @.python)) (~~ (lacks?' "python array read" "python object none?" index array)) + (~~ (.static @.lua)) (~~ (lacks?' "lua array read" "lua object nil?" index array)) + (~~ (.static @.ruby)) (~~ (lacks?' "ruby array read" "ruby object nil?" index array)) + (~~ (.static @.php)) (~~ (lacks?' "php array read" "php object null?" index array)) + (~~ (.static @.scheme)) (~~ (lacks?' "scheme array read" "scheme object nil?" index array))]) + .true)))) + <index> <array>)])) + + (`` (template: .public (item <index> <array>) + [((.: (.All (_ a) + (.-> .Nat (..Array a) a)) + (.function (item index array) + (.for [(~~ (.static @.old)) + ("jvm aaload" array index) + + (~~ (.static @.jvm)) + (.|> array + (.:as <array_type>) + ("jvm array read object" (~~ (int! index))) + .:expected) + + (~~ (.static @.js)) ("js array read" index array) + (~~ (.static @.python)) ("python array read" index array) + (~~ (.static @.lua)) ("lua array read" index array) + (~~ (.static @.ruby)) ("ruby array read" index array) + (~~ (.static @.php)) ("php array read" index array) + (~~ (.static @.scheme)) ("scheme array read" index array)]))) + <index> <array>)])) + + (`` (template: .public (has! <index> <value> <array>) + [((.: (.All (_ a) + (.-> .Nat a (..Array a) (..Array a))) + (.function (has! index value array) + (.for [(~~ (.static @.old)) + ("jvm aastore" array index value) + + (~~ (.static @.jvm)) + (.|> array + (.:as <array_type>) + ("jvm array write object" (~~ (int! index)) (.:as <elem_type> value)) + .:expected) + + (~~ (.static @.js)) ("js array write" index value array) + (~~ (.static @.python)) ("python array write" index value array) + (~~ (.static @.lua)) ("lua array write" index value array) + (~~ (.static @.ruby)) ("ruby array write" index value array) + (~~ (.static @.php)) ("php array write" index value array) + (~~ (.static @.scheme)) ("scheme array write" index value array)]))) + <index> <value> <array>)])) + + (`` (template: .public (lacks! <index> <array>) + [((.: (.All (_ a) + (.-> .Nat (..Array a) (..Array a))) + (.function (lacks! index array) + (.let [size (..size array)] + (.if ("lux i64 <" (.int size) (.int index)) + (.for [(~~ (.static @.old)) + (..has! index (.:expected ("jvm object null")) array) + + (~~ (.static @.jvm)) + (..has! index (.:expected (: <elem_type> ("jvm object null"))) array) + + (~~ (.static @.js)) ("js array delete" index array) + (~~ (.static @.python)) ("python array delete" index array) + (~~ (.static @.lua)) ("lua array delete" index array) + (~~ (.static @.ruby)) ("ruby array delete" index array) + (~~ (.static @.php)) ("php array delete" index array) + (~~ (.static @.scheme)) ("scheme array delete" index array)]) + array)))) + <index> <array>)])) + ) + +(template: .public (revised! <index> <$> <array>) + [((.: (.All (_ a) + (.-> .Nat (.-> a a) (..Array a) (..Array a))) + (.function (revised! index $ array) + (.if (..lacks? index array) + array + (..has! index ($ (..item index array)) array)))) + <index> <$> <array>)]) + +(template: .public (upsert! <index> <default> <$> <array>) + [((.: (.All (_ a) + (.-> .Nat a (.-> a a) (..Array a) (..Array a))) + (.function (upsert! index default $ array) + (..has! index + ($ (.if (..lacks? index array) + default + (..item index array))) + array))) + <index> <default> <$> <array>)]) + +(template: .public (copy! <length> <src_start> <src_array> <dest_start> <dest_array>) + [((.: (.All (_ a) + (.-> .Nat .Nat (..Array a) .Nat (..Array a) + (..Array a))) + (.function (copy! length src_start src_array dest_start dest_array) + (.loop [offset 0] + (.if ("lux i64 <" (.int length) (.int offset)) + (.exec + (.if (..lacks? ("lux i64 +" offset src_start) src_array) + (..lacks! ("lux i64 +" offset dest_start) dest_array) + (..has! ("lux i64 +" offset dest_start) + (..item ("lux i64 +" offset src_start) src_array) + dest_array)) + (again ("lux i64 +" 1 offset))) + dest_array)))) + <length> <src_start> <src_array> <dest_start> <dest_array>)]) + +(template [<name> <when_lacks> <when_has>] + [(template: .public (<name> <array>) + [((.: (.All (_ a) (.-> (..Array a) .Nat)) + (.function (occupancy array) + (.let [size (..size array)] + (.loop [index 0 + it 0] + (.if ("lux i64 <" (.int size) (.int index)) + (.if (..lacks? index array) + (again ("lux i64 +" 1 index) <when_lacks>) + (again ("lux i64 +" 1 index) <when_has>)) + it))))) + <array>)])] + + [occupancy it ("lux i64 +" 1 it)] + [vacancy ("lux i64 +" 1 it) it] + ) + +(template: .public (only! <?> <it>) + [((.: (.All (_ a) + (.-> (.-> a .Bit) (..Array a) (..Array a))) + (.function (only! ? it) + (.let [size (..size it)] + (.loop [index 0] + (.if ("lux i64 <" (.int size) (.int index)) + (.exec + (.if (..lacks? index it) + it + (.if (? (..item index it)) + it + (..lacks! index it))) + (again ("lux i64 +" 1 index))) + it))))) + <?> <it>)]) + +(template [<name> <predicate> <test> <type> <term>] + [(template: .public (<name> <?> <it>) + [((.: (.All (_ a) + (.-> <predicate> (..Array a) (.Maybe <type>))) + (.function (<name> ? it) + (.let [size (..size it)] + (.loop [index 0] + (.if ("lux i64 <" (.int size) (.int index)) + (.if (..lacks? index it) + (again ("lux i64 +" 1 index)) + (.let [it (..item index it)] + (.if <test> + {.#Some <term>} + (again ("lux i64 +" 1 index))))) + {.#None}))))) + <?> <it>)])] + + [example (.-> a .Bit) (? it) a it] + [example' (.-> Nat a .Bit) (? index it) [Nat a] [index it]] + ) + +(template: .public (clone <it>) + [((.: (.All (_ a) (.-> (..Array a) (..Array a))) + (.function (clone it) + (.let [size (..size it)] + (..copy! size 0 it 0 (..empty size))))) + <it>)]) + +(template: .public (of_list <input>) + [((.: (.All (_ a) (.-> (.List a) (..Array a))) + (.function (of_list input) + (.let [size (list.size input) + output (..empty size)] + (.loop [index 0 + input input] + (.case input + {.#End} + output + + {.#Item head tail} + (.exec + (..has! index head output) + (again ("lux i64 +" 1 index) tail))))))) + <input>)]) + +(def: underflow + Nat + (-- 0)) + +(`` (template: (list|-default <empty> <array>) + [((.: (.All (_ a) (.-> (.List a) (..Array a) (.List a))) + (.function (list|-default empty array) + (.loop [index ("lux i64 -" 1 (..size array)) + output empty] + (.if ("lux i64 =" (~~ (.static ..underflow)) index) + output + (again ("lux i64 -" 1 index) + (.if (..lacks? index array) + output + {.#Item (..item index array) output})))))) + <empty> <array>)])) + +(`` (template: (list|+default <default> <array>) + [((.: (.All (_ a) (.-> a (..Array a) (.List a))) + (.function (list|+default default array) + (.loop [index ("lux i64 -" 1 (..size array)) + output (`` (.: (.List (~~ (.as_is (~~ (.:of default))))) + {.#End}))] + (.if ("lux i64 =" (~~ (.static ..underflow)) index) + output + (again ("lux i64 -" 1 index) + {.#Item (.if (..lacks? index array) + default + (..item index array)) + output}))))) + <default> <array>)])) + +(`` (template: .public (list <default> <array>) + [((.: (.All (_ a) (.-> (.Maybe a) (..Array a) (.List a))) + (.function (list default array) + (.case default + {.#Some default} + (~~ (..list|+default default array)) + + {.#None} + (~~ (..list|-default {.#End} array))))) + <default> <array>)])) + +(template: .public (= <//#=> <left/*> <right/*>) + [((.: (.All (_ a) (.-> (.-> a a .Bit) (..Array a) (..Array a) .Bit)) + (.function (= //#= left/* right/*) + (.let [size (..size left/*)] + (.and ("lux i64 =" (..size right/*) size) + (.loop [index 0] + (.if ("lux i64 <" (.int size) (.int index)) + (.if (..lacks? index left/*) + (..lacks? index right/*) + (.if (..lacks? index right/*) + .false + (.and (//#= (..item index left/*) + (..item index right/*)) + (again ("lux i64 +" 1 index))))) + true)))))) + <//#=> <left/*> <right/*>)]) + +(template: .public (composite <left/*> <right/*>) + [((.: (.All (_ a) (.-> (..Array a) (..Array a) (..Array a))) + (.function (composite left/* right/*) + (.let [|left| (..size left/*) + |right| (..size right/*)] + (.|> (..empty ("lux i64 +" |left| |right|)) + (..copy! |left| 0 left/* 0) + (..copy! |right| 0 right/* |left|))))) + <left/*> <right/*>)]) + +(template: .public (mix <$> <init> <it>) + [((.: (.All (_ a b) + (.-> (.-> Nat b a a) a (..Array b) a)) + (.function (mix $ init it) + (.let [size (..size it)] + (.loop [index 0 + so_far init] + (.if ("lux i64 <" (.int size) (.int index)) + (.if (..lacks? index it) + (again ("lux i64 +" 1 index) so_far) + (again ("lux i64 +" 1 index) ($ index (..item index it) so_far))) + so_far))))) + <$> <init> <it>)]) + +(template: .public (each <$> <input>) + [((.: (functor.Functor ..Array) + (.function (each $ input) + (..mix (.function (_ index item output) + (..has! index ($ item) output)) + (..empty (..size input)) + input))) + <$> <input>)]) + +(template [<name> <init> <op>] + [(template: .public (<name> <?> <it>) + [((.: (.All (_ a) + (.-> (.-> a .Bit) + (.-> (..Array a) .Bit))) + (.function (<name> ? it) + (.let [size (..size it)] + (.loop [index 0] + (.if ("lux i64 <" (.int size) (.int index)) + (.if (..lacks? index it) + (again ("lux i64 +" 1 index)) + (<op> (? (..item index it)) + (again ("lux i64 +" 1 index)))) + <init>))))) + <?> <it>)])] + + [every? .true and] + [any? .false or] + ) + +(template: .public (one <?> <it>) + [((.: (.All (_ a b) + (.-> (.-> a (.Maybe b)) (..Array a) (.Maybe b))) + (.function (one ? it) + (.let [size (..size it)] + (.loop [index 0] + (.if ("lux i64 <" (.int size) (.int index)) + (with_expansions [<again> (again ("lux i64 +" 1 index))] + (.if (..lacks? index it) + <again> + (.case (? (..item index it)) + {.#None} + <again> + + output + output))) + {.#None}))))) + <?> <it>)]) |