aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/unsafe
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/unsafe')
-rw-r--r--stdlib/source/unsafe/lux/data/binary.lux483
-rw-r--r--stdlib/source/unsafe/lux/data/collection/array.lux409
2 files changed, 650 insertions, 242 deletions
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>)])
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 01:06:40 +0000