aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-03-05 04:30:09 -0400
committerEduardo Julian2022-03-05 04:30:09 -0400
commita7fc50b1906fa97fb56d5ebe3d3fff7baee276da (patch)
treec62e695c6dc264533abe4003a6338d4a39e958c0
parentab9dc5fd656ef42dbb0192f96d34e1c7b451a430 (diff)
Optimizations for the pure-Lux JVM compiler. [Part 5]
Diffstat (limited to '')
-rw-r--r--documentation/bookmark/back_end/c++.md4
-rw-r--r--stdlib/source/library/lux.lux21
-rw-r--r--stdlib/source/library/lux/control/maybe.lux2
-rw-r--r--stdlib/source/library/lux/control/parser/binary.lux2
-rw-r--r--stdlib/source/library/lux/data/binary.lux4
-rw-r--r--stdlib/source/library/lux/data/collection/array.lux425
-rw-r--r--stdlib/source/library/lux/data/collection/dictionary.lux216
-rw-r--r--stdlib/source/library/lux/data/collection/sequence.lux181
-rw-r--r--stdlib/source/library/lux/math/number/i64.lux2
-rw-r--r--stdlib/source/library/lux/math/number/int.lux4
-rw-r--r--stdlib/source/library/lux/math/number/rev.lux54
-rw-r--r--stdlib/source/library/lux/math/random.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux15
-rw-r--r--stdlib/source/library/lux/world/file.lux2
-rw-r--r--stdlib/source/poly/lux/data/format/json.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/synthesis.lux78
-rw-r--r--stdlib/source/test/lux/data/binary.lux5
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux198
-rw-r--r--stdlib/source/test/lux/target/python.lux56
-rw-r--r--stdlib/source/unsafe/lux/data/binary.lux483
-rw-r--r--stdlib/source/unsafe/lux/data/collection/array.lux409
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>)])