aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/unsafe
diff options
context:
space:
mode:
authorEduardo Julian2022-06-12 00:38:20 -0400
committerEduardo Julian2022-06-12 00:38:20 -0400
commitb48ea68a83d01903554c7696c77eedaaf1035680 (patch)
treec342d8094c3158de16526f874ca9624418cd2dd2 /stdlib/source/unsafe
parent7abf2d0ac55c229a8793bbff31f132596ffcb275 (diff)
De-sigil-ification: suffix : [Part 3]
Diffstat (limited to 'stdlib/source/unsafe')
-rw-r--r--stdlib/source/unsafe/lux/data/binary.lux391
-rw-r--r--stdlib/source/unsafe/lux/data/collection/array.lux750
2 files changed, 589 insertions, 552 deletions
diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux
index 6f51fde27..1dc9fc96c 100644
--- a/stdlib/source/unsafe/lux/data/binary.lux
+++ b/stdlib/source/unsafe/lux/data/binary.lux
@@ -60,57 +60,59 @@
(`` (with_expansions [<size> (.is .Nat size)
<jvm> (ffi.array byte <size>)
<jvm> (.is ..Binary <jvm>)]
- (template: .public (empty size)
- [(is ..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> (.is ..Binary it)
- <jvm> (ffi.length <it>)]
- (template: .public (size it)
- [(.is .Nat
- (.for (~~ (.static @.old)) <jvm>
+ (def: .public empty
+ (template (empty size)
+ [(is ..Binary
+ (for (~~ (.static @.old)) <jvm>
(~~ (.static @.jvm)) <jvm>
(~~ (.static @.js))
- (.|> <it>
- ("js object get" "length")
- (.as .Frac)
- "lux f64 i64"
- .nat)
+ (.|> <size>
+ .int
+ "lux i64 f64"
+ []
+ ("js object new" ("js constant" "ArrayBuffer"))
+ []
+ ("js object new" ("js constant" "Uint8Array"))
+ (.as ..Binary))
(~~ (.static @.python))
- (.|> <it>
- (.as (array.Array (.I64 .Any)))
- "python array length")
+ (.|> <size>
+ []
+ ("python apply" (.as ffi.Function ("python constant" "bytearray")))
+ (.as ..Binary))
(~~ (.static @.scheme))
- (..bytevector-length [<it>])
+ (..make-bytevector <size>)
... Default
- (array.size <it>)))])))
+ (array.empty <size>)))]))))
+
+(`` (with_expansions [<it> (.is ..Binary it)
+ <jvm> (ffi.length <it>)]
+ (def: .public size
+ (template (size it)
+ [(.is .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
@@ -124,67 +126,71 @@
<jvm> (.|> <jvm>
(.as .I64)
("lux i64 and" <byte_mask>))]
- (template: .public (bits_8 index it)
- [(.<| (.as .I64)
+ (def: .public bits_8
+ (template (bits_8 index it)
+ [(.<| (.as .I64)
+ (.is (.I64 .Any))
+ (`` (.for (~~ (.static @.old)) (~~ <jvm>)
+ (~~ (.static @.jvm)) (~~ <jvm>)
+
+ (~~ (.static @.js))
+ (.|> <it>
+ (.as (array.Array .Frac))
+ ("js array read" <index>)
+ (.as .Frac)
+ "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>)))))])))
+
+(def: .public bits_16
+ (template (bits_16 index' it')
+ [(.<| (.let [index (.is Nat index')
+ it (.is ..Binary it')])
+ (.as .I64)
(.is (.I64 .Any))
- (`` (.for (~~ (.static @.old)) (~~ <jvm>)
- (~~ (.static @.jvm)) (~~ <jvm>)
-
- (~~ (.static @.js))
- (.|> <it>
- (.as (array.Array .Frac))
- ("js array read" <index>)
- (.as .Frac)
- "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 (bits_16 index' it')
- [(.<| (.let [index (.is Nat index')
- it (.is ..Binary it')])
- (.as .I64)
- (.is (.I64 .Any))
- (.all "lux i64 or"
- ("lux i64 left-shift" 8 (..bits_8 index it))
- (..bits_8 ("lux i64 +" 1 index) it)))])
-
-(template: .public (bits_32 index' it')
- [(.<| (.let [index (.is Nat index')
- it (.is ..Binary it')])
- (.as .I64)
- (.is (.I64 .Any))
- (.all "lux i64 or"
- ("lux i64 left-shift" 24 (..bits_8 index it))
- ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 1 index) it))
- ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 2 index) it))
- (..bits_8 ("lux i64 +" 3 index) it)))])
-
-(template: .public (bits_64 index' it')
- [(.<| (.let [index (.is Nat index')
- it (.is ..Binary it')])
- (.as .I64)
- (.is (.I64 .Any))
- (.all "lux i64 or"
- ("lux i64 left-shift" 56 (..bits_8 index it))
- ("lux i64 left-shift" 48 (..bits_8 ("lux i64 +" 1 index) it))
- ("lux i64 left-shift" 40 (..bits_8 ("lux i64 +" 2 index) it))
- ("lux i64 left-shift" 32 (..bits_8 ("lux i64 +" 3 index) it))
- ("lux i64 left-shift" 24 (..bits_8 ("lux i64 +" 4 index) it))
- ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 5 index) it))
- ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 6 index) it))
- (..bits_8 ("lux i64 +" 7 index) it)))])
+ (.all "lux i64 or"
+ ("lux i64 left-shift" 8 (..bits_8 index it))
+ (..bits_8 ("lux i64 +" 1 index) it)))]))
+
+(def: .public bits_32
+ (template (bits_32 index' it')
+ [(.<| (.let [index (.is Nat index')
+ it (.is ..Binary it')])
+ (.as .I64)
+ (.is (.I64 .Any))
+ (.all "lux i64 or"
+ ("lux i64 left-shift" 24 (..bits_8 index it))
+ ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 1 index) it))
+ ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 2 index) it))
+ (..bits_8 ("lux i64 +" 3 index) it)))]))
+
+(def: .public bits_64
+ (template (bits_64 index' it')
+ [(.<| (.let [index (.is Nat index')
+ it (.is ..Binary it')])
+ (.as .I64)
+ (.is (.I64 .Any))
+ (.all "lux i64 or"
+ ("lux i64 left-shift" 56 (..bits_8 index it))
+ ("lux i64 left-shift" 48 (..bits_8 ("lux i64 +" 1 index) it))
+ ("lux i64 left-shift" 40 (..bits_8 ("lux i64 +" 2 index) it))
+ ("lux i64 left-shift" 32 (..bits_8 ("lux i64 +" 3 index) it))
+ ("lux i64 left-shift" 24 (..bits_8 ("lux i64 +" 4 index) it))
+ ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 5 index) it))
+ ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 6 index) it))
+ (..bits_8 ("lux i64 +" 7 index) it)))]))
(with_expansions [<byte> (hex "FF")
<it> (.is ..Binary it)
@@ -199,99 +205,104 @@
<jvm_value> <jvm_value>
<jvm_value> (ffi.long_to_byte <jvm_value>)
<jvm> (ffi.write! <index> <jvm_value> <it>)]
- (`` (template: .public (has_8! index value it)
- [(.is ..Binary
- (.for (~~ (.static @.old)) <jvm>
- (~~ (.static @.jvm)) <jvm>
-
- (~~ (.static @.js))
- (.|> <it>
- (.is ..Binary)
- (.as (array.Array .Frac))
- ("js array write" <index>
- (.|> <value>
- .int
- ("lux i64 and" (.int <byte>))
- "lux i64 f64"
- .as_expected))
- (.as ..Binary))
-
- (~~ (.static @.python))
- (.|> <it>
- (.is ..Binary)
- (.as (array.Array (.I64 .Any)))
- ("python array write" <index> (.|> <value> ("lux i64 and" <byte>) (.is (.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 (has_16! index' value' it)
- [(.let [index (.is .Nat index')
- value (.is (.I64 .Any) value')]
- (.|> it
- (..has_8! index ("lux i64 right-shift" 8 value))
- (..has_8! ("lux i64 +" 1 index) value)))])
-
-(template: .public (has_32! index' value' it)
- [(.let [index (.is .Nat index')
- value (.is (.I64 .Any) value')]
- (.|> it
- (..has_8! index ("lux i64 right-shift" 24 value))
- (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value))
- (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value))
- (..has_8! ("lux i64 +" 3 index) value)))])
-
-(`` (template: .public (has_64! index' value' it)
- [(.let [index (.is .Nat index')
- value (.is (.I64 .Any) value')]
- (.for (~~ (.static @.scheme)) (.let [write_high (.is (.-> ..Binary ..Binary)
- (.|>> (..has_8! index ("lux i64 right-shift" 56 value))
- (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
- (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
- (..has_8! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))))
- write_low (.is (.-> ..Binary ..Binary)
- (.|>> (..has_8! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
- (..has_8! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
- (..has_8! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
- (..has_8! ("lux i64 +" 7 index) value)))]
- (.|> it
- write_high
- write_low))
- (.|> it
- (..has_8! index ("lux i64 right-shift" 56 value))
- (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
- (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
- (..has_8! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))
- (..has_8! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
- (..has_8! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
- (..has_8! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
- (..has_8! ("lux i64 +" 7 index) value))))]))
+ (`` (def: .public has_8!
+ (template (has_8! index value it)
+ [(.is ..Binary
+ (.for (~~ (.static @.old)) <jvm>
+ (~~ (.static @.jvm)) <jvm>
+
+ (~~ (.static @.js))
+ (.|> <it>
+ (.is ..Binary)
+ (.as (array.Array .Frac))
+ ("js array write" <index>
+ (.|> <value>
+ .int
+ ("lux i64 and" (.int <byte>))
+ "lux i64 f64"
+ .as_expected))
+ (.as ..Binary))
+
+ (~~ (.static @.python))
+ (.|> <it>
+ (.is ..Binary)
+ (.as (array.Array (.I64 .Any)))
+ ("python array write" <index> (.|> <value> ("lux i64 and" <byte>) (.is (.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>)))]))))
+
+(def: .public has_16!
+ (template (has_16! index' value' it)
+ [(.let [index (.is .Nat index')
+ value (.is (.I64 .Any) value')]
+ (.|> it
+ (..has_8! index ("lux i64 right-shift" 8 value))
+ (..has_8! ("lux i64 +" 1 index) value)))]))
+
+(def: .public has_32!
+ (template (has_32! index' value' it)
+ [(.let [index (.is .Nat index')
+ value (.is (.I64 .Any) value')]
+ (.|> it
+ (..has_8! index ("lux i64 right-shift" 24 value))
+ (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value))
+ (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value))
+ (..has_8! ("lux i64 +" 3 index) value)))]))
+
+(`` (def: .public has_64!
+ (template (has_64! index' value' it)
+ [(.let [index (.is .Nat index')
+ value (.is (.I64 .Any) value')]
+ (.for (~~ (.static @.scheme)) (.let [write_high (.is (.-> ..Binary ..Binary)
+ (.|>> (..has_8! index ("lux i64 right-shift" 56 value))
+ (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
+ (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
+ (..has_8! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))))
+ write_low (.is (.-> ..Binary ..Binary)
+ (.|>> (..has_8! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
+ (..has_8! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
+ (..has_8! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
+ (..has_8! ("lux i64 +" 7 index) value)))]
+ (.|> it
+ write_high
+ write_low))
+ (.|> it
+ (..has_8! index ("lux i64 right-shift" 56 value))
+ (..has_8! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
+ (..has_8! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
+ (..has_8! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))
+ (..has_8! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
+ (..has_8! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
+ (..has_8! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
+ (..has_8! ("lux i64 +" 7 index) value))))])))
(with_expansions [<reference> (.is ..Binary reference')
<sample> (.is ..Binary sample')
<jvm> (java/util/Arrays::equals <reference> <sample>)
<jvm> (ffi.of_boolean <jvm>)]
- (`` (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 (again [index 0])
- (.if ("lux i64 =" limit index)
- .true
- (.and ("lux i64 ="
- (..bits_8 index reference)
- (..bits_8 index sample))
- (again ("lux i64 +" 1 index))))))))])))
+ (`` (def: .public =
+ (template (= reference' sample')
+ [(.for (~~ (.static @.old)) <jvm>
+ (~~ (.static @.jvm)) <jvm>
+ (.let [reference <reference>
+ sample <sample>
+ limit (..size reference)]
+ (.and ("lux i64 =" limit (..size sample))
+ (.loop (again [index 0])
+ (.if ("lux i64 =" limit index)
+ .true
+ (.and ("lux i64 ="
+ (..bits_8 index reference)
+ (..bits_8 index sample))
+ (again ("lux i64 +" 1 index))))))))]))))
... TODO: Turn into a template ASAP.
(`` (inline: .public (copy! bytes source_offset source target_offset target)
diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux
index fd43808c5..d3116b89b 100644
--- a/stdlib/source/unsafe/lux/data/collection/array.lux
+++ b/stdlib/source/unsafe/lux/data/collection/array.lux
@@ -13,7 +13,7 @@
(def: .public type
"#Array")
-(template [<item> <array>]
+(with_template [<item> <array>]
[(type: .public <array>
{.#Primitive ..type {.#Item <item> {.#End}}})]
@@ -23,390 +23,416 @@
(with_expansions [<index_type> (.Primitive "java.lang.Long")
<item_type> (.Primitive "java.lang.Object")]
- (for @.jvm (template: (jvm_int value)
- [(.|> value
- (.as <index_type>)
- "jvm object cast"
- "jvm conversion long-to-int")])
+ (for @.jvm (def: jvm_int
+ (template (jvm_int value)
+ [(.|> value
+ (.as <index_type>)
+ "jvm object cast"
+ "jvm conversion long-to-int")]))
(these))
- (`` (template: .public (empty <size>)
- [((.is (.All (_ a) (.-> .Nat (..Array a)))
- (.function (empty size)
- (.as_expected
- (.for (~~ (.static @.old))
- ("jvm anewarray" "(java.lang.Object )" size)
-
- (~~ (.static @.jvm))
- (|> (~~ (..jvm_int size))
- "jvm array new object"
- (.is (..Array <item_type>)))
-
- (~~ (.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>)
- [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
- (.function (size array)
- (.for (~~ (.static @.old))
- ("jvm arraylength" array)
-
- (~~ (.static @.jvm))
- (.|> array
- "jvm array length object"
- "jvm conversion int-to-long"
- "jvm object cast"
- (.is <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>)
- [((.is (.All (_ r w)
- (.-> .Nat (..Array' r w) .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
- ("jvm array read object" (~~ (jvm_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 (has? index array)
- [(.not (..lacks? index array))])
-
- (`` (template: .public (item <index> <array>)
- [((.is (.All (_ r w)
- (.-> .Nat (..Array' r w) r))
- (.function (item index array)
- (.as_expected
- (.for (~~ (.static @.old))
- ("jvm aaload" array index)
-
- (~~ (.static @.jvm))
- ("jvm array read object" (~~ (jvm_int index)) array)
-
- (~~ (.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>)
- [((.is (.All (_ r w)
- (.-> .Nat w (..Array' r w) (..Array' r w)))
- (.function (has! index value array)
- (.for (~~ (.static @.old))
- ("jvm aastore" array index value)
-
- (~~ (.static @.jvm))
- (.|> array
- ("jvm array write object" (~~ (jvm_int index)) value)
- .as_expected)
-
- (~~ (.static @.js)) ("js array write" index (.as_expected value) array)
- (~~ (.static @.python)) ("python array write" index (.as_expected value) array)
- (~~ (.static @.lua)) ("lua array write" index (.as_expected value) array)
- (~~ (.static @.ruby)) ("ruby array write" index (.as_expected value) array)
- (~~ (.static @.php)) ("php array write" index (.as_expected value) array)
- (~~ (.static @.scheme)) ("scheme array write" index (.as_expected value) array))))
- <index> <value> <array>)]))
-
- (`` (template: .public (lacks! <index> <array>)
- [((.is (.All (_ r w)
- (.-> .Nat (..Array' r w) (..Array' r w)))
- (.function (lacks! index array)
- (.let [size (..size array)]
- (.if ("lux i64 <" (.int size) (.int index))
- (.for (~~ (.static @.old))
- (..has! index (.as_expected ("jvm object null")) array)
-
- (~~ (.static @.jvm))
- (..has! index (.as_expected (is <item_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>)]))
+ (`` (def: .public empty
+ (template (empty <size>)
+ [((.is (.All (_ a) (.-> .Nat (..Array a)))
+ (.function (empty size)
+ (.as_expected
+ (.for (~~ (.static @.old))
+ ("jvm anewarray" "(java.lang.Object )" size)
+
+ (~~ (.static @.jvm))
+ (|> (~~ (..jvm_int size))
+ "jvm array new object"
+ (.is (..Array <item_type>)))
+
+ (~~ (.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>)])))
+
+ (`` (def: .public size
+ (template (size <array>)
+ [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
+ (.function (size array)
+ (.for (~~ (.static @.old))
+ ("jvm arraylength" array)
+
+ (~~ (.static @.jvm))
+ (.|> array
+ "jvm array length object"
+ "jvm conversion int-to-long"
+ "jvm object cast"
+ (.is <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>)])))
+
+ (def: lacks?'
+ (template (lacks?' <read!> <null?> index array)
+ [(<null?> (<read!> index array))]))
+
+ (`` (def: .public lacks?
+ (template (lacks? <index> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat (..Array' r w) .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
+ ("jvm array read object" (~~ (jvm_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>)])))
+
+ (def: .public has?
+ (template (has? index array)
+ [(.not (..lacks? index array))]))
+
+ (`` (def: .public item
+ (template (item <index> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat (..Array' r w) r))
+ (.function (item index array)
+ (.as_expected
+ (.for (~~ (.static @.old))
+ ("jvm aaload" array index)
+
+ (~~ (.static @.jvm))
+ ("jvm array read object" (~~ (jvm_int index)) array)
+
+ (~~ (.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>)])))
+
+ (`` (def: .public has!
+ (template (has! <index> <value> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat w (..Array' r w) (..Array' r w)))
+ (.function (has! index value array)
+ (.for (~~ (.static @.old))
+ ("jvm aastore" array index value)
+
+ (~~ (.static @.jvm))
+ (.|> array
+ ("jvm array write object" (~~ (jvm_int index)) value)
+ .as_expected)
+
+ (~~ (.static @.js)) ("js array write" index (.as_expected value) array)
+ (~~ (.static @.python)) ("python array write" index (.as_expected value) array)
+ (~~ (.static @.lua)) ("lua array write" index (.as_expected value) array)
+ (~~ (.static @.ruby)) ("ruby array write" index (.as_expected value) array)
+ (~~ (.static @.php)) ("php array write" index (.as_expected value) array)
+ (~~ (.static @.scheme)) ("scheme array write" index (.as_expected value) array))))
+ <index> <value> <array>)])))
+
+ (`` (def: .public lacks!
+ (template (lacks! <index> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat (..Array' r w) (..Array' r w)))
+ (.function (lacks! index array)
+ (.let [size (..size array)]
+ (.if ("lux i64 <" (.int size) (.int index))
+ (.for (~~ (.static @.old))
+ (..has! index (.as_expected ("jvm object null")) array)
+
+ (~~ (.static @.jvm))
+ (..has! index (.as_expected (is <item_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>)
- [((.is (.All (_ r w)
- (.-> .Nat (.-> r w) (..Array' r w) (..Array' r w)))
- (.function (revised! index $ array)
- (.if (..lacks? index array)
- array
- (..has! index ($ (..item index array)) array))))
- <index> <$> <array>)])
-
-(template: .public (upsert! <index> <default> <$> <array>)
- [((.is (.All (_ r w)
- (.-> .Nat r (.-> r w) (..Array' r w) (..Array' r w)))
- (.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>)
- [((.is (.All (_ r w)
- (.-> .Nat .Nat (..Array' w .Nothing) .Nat (..Array' r w)
- (..Array' r w)))
- (.function (copy! length src_start src_array dest_start dest_array)
- (.loop (again [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>)
- [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
- (.function (occupancy array)
- (.let [size (..size array)]
- (.loop (again [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>)])]
+(def: .public revised!
+ (template (revised! <index> <$> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat (.-> r w) (..Array' r w) (..Array' r w)))
+ (.function (revised! index $ array)
+ (.if (..lacks? index array)
+ array
+ (..has! index ($ (..item index array)) array))))
+ <index> <$> <array>)]))
+
+(def: .public upsert!
+ (template (upsert! <index> <default> <$> <array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat r (.-> r w) (..Array' r w) (..Array' r w)))
+ (.function (upsert! index default $ array)
+ (..has! index
+ ($ (.if (..lacks? index array)
+ default
+ (..item index array)))
+ array)))
+ <index> <default> <$> <array>)]))
+
+(def: .public copy!
+ (template (copy! <length> <src_start> <src_array> <dest_start> <dest_array>)
+ [((.is (.All (_ r w)
+ (.-> .Nat .Nat (..Array' w .Nothing) .Nat (..Array' r w)
+ (..Array' r w)))
+ (.function (copy! length src_start src_array dest_start dest_array)
+ (.loop (again [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>)]))
+
+(with_template [<name> <when_lacks> <when_has>]
+ [(def: .public <name>
+ (template (<name> <array>)
+ [((.is (.All (_ r w) (.-> (..Array' r w) .Nat))
+ (.function (occupancy array)
+ (.let [size (..size array)]
+ (.loop (again [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>)
- [((.is (.All (_ r w)
- (.-> (.-> r .Bit) (..Array' r w) (..Array' r w)))
- (.function (only! ? it)
- (.let [size (..size it)]
- (.loop (again [index 0])
- (.if ("lux i64 <" (.int size) (.int index))
- (.exec
- (.if (..lacks? index it)
- it
- (.if (? (..item index it))
+(def: .public only!
+ (template (only! <?> <it>)
+ [((.is (.All (_ r w)
+ (.-> (.-> r .Bit) (..Array' r w) (..Array' r w)))
+ (.function (only! ? it)
+ (.let [size (..size it)]
+ (.loop (again [index 0])
+ (.if ("lux i64 <" (.int size) (.int index))
+ (.exec
+ (.if (..lacks? index it)
it
- (..lacks! index it)))
- (again ("lux i64 +" 1 index)))
- it)))))
- <?> <it>)])
-
-(template [<name> <predicate> <test> <type> <term>]
- [(template: .public (<name> <?> <it>)
- [((.is (.All (_ r w)
- (.-> <predicate> (..Array' r w) (.Maybe <type>)))
- (.function (<name> ? it)
- (.let [size (..size it)]
- (.loop (again [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>)])]
+ (.if (? (..item index it))
+ it
+ (..lacks! index it)))
+ (again ("lux i64 +" 1 index)))
+ it)))))
+ <?> <it>)]))
+
+(with_template [<name> <predicate> <test> <type> <term>]
+ [(def: .public <name>
+ (template (<name> <?> <it>)
+ [((.is (.All (_ r w)
+ (.-> <predicate> (..Array' r w) (.Maybe <type>)))
+ (.function (<name> ? it)
+ (.let [size (..size it)]
+ (.loop (again [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 (.-> r .Bit) (? it) r it]
[example' (.-> Nat r .Bit) (? index it) [Nat r] [index it]]
)
-(template: .public (clone <it>)
- [((.is (.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>)
- [((.is (.All (_ a) (.-> (.List a) (..Array a)))
- (.function (of_list input)
- (.let [size (list.size input)
- output (..empty size)]
- (.loop (again [index 0
- input input])
- (.case input
- {.#End}
- output
-
- {.#Item head tail}
- (.exec
- (..has! index head output)
- (again ("lux i64 +" 1 index) tail)))))))
- <input>)])
+(def: .public clone
+ (template (clone <it>)
+ [((.is (.All (_ a) (.-> (..Array a) (..Array a)))
+ (.function (clone it)
+ (.let [size (..size it)]
+ (..copy! size 0 it 0 (..empty size)))))
+ <it>)]))
+
+(def: .public of_list
+ (template (of_list <input>)
+ [((.is (.All (_ a) (.-> (.List a) (..Array a)))
+ (.function (of_list input)
+ (.let [size (list.size input)
+ output (..empty size)]
+ (.loop (again [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>)
- [((.is (.All (_ r w) (.-> (.List r) (..Array' r w) (.List r)))
- (.function (list|-default empty array)
- (.loop (again [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>)
- [((.is (.All (_ r w) (.-> r (..Array' r w) (.List r)))
- (.function (list|+default default array)
- (.loop (again [index ("lux i64 -" 1 (..size array))
- output (`` (.is (.List (~~ (.these (~~ (.type_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>)
- [((.is (.All (_ r w) (.-> (.Maybe r) (..Array' r w) (.List r)))
- (.function (list default array)
- (.case default
- {.#Some default}
- (~~ (..list|+default default array))
-
- {.#None}
- (~~ (..list|-default {.#End} array)))))
- <default> <array>)]))
-
-(template: .public (= <//#=> <left/*> <right/*>)
- [((.is (.All (_ r w0 w1) (.-> (.-> r r .Bit) (..Array' r w0) (..Array' r w1) .Bit))
- (.function (= //#= left/* right/*)
- (.let [size (..size left/*)]
- (.and ("lux i64 =" (..size right/*) size)
- (.loop (again [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/*>)
- [((.is (.All (_ a) (.-> (..Array' a .Nothing) (..Array' a .Nothing) (..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>)
- [((.is (.All (_ r w s)
- (.-> (.-> Nat r s s) s (..Array' r w) s))
- (.function (mix $ init it)
- (.let [size (..size it)]
- (.loop (again [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>)
- [((.is (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>)
- [((.is (.All (_ r w)
- (.-> (.-> r .Bit)
- (.-> (..Array' r w) .Bit)))
- (.function (<name> ? it)
- (.let [size (..size it)]
- (.loop (again [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>)])]
+(`` (def: list|-default
+ (template (list|-default <empty> <array>)
+ [((.is (.All (_ r w) (.-> (.List r) (..Array' r w) (.List r)))
+ (.function (list|-default empty array)
+ (.loop (again [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>)])))
+
+(`` (def: list|+default
+ (template (list|+default <default> <array>)
+ [((.is (.All (_ r w) (.-> r (..Array' r w) (.List r)))
+ (.function (list|+default default array)
+ (.loop (again [index ("lux i64 -" 1 (..size array))
+ output (`` (.is (.List (~~ (.these (~~ (.type_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>)])))
+
+(`` (def: .public list
+ (template (list <default> <array>)
+ [((.is (.All (_ r w) (.-> (.Maybe r) (..Array' r w) (.List r)))
+ (.function (list default array)
+ (.case default
+ {.#Some default}
+ (~~ (..list|+default default array))
+
+ {.#None}
+ (~~ (..list|-default {.#End} array)))))
+ <default> <array>)])))
+
+(def: .public =
+ (template (= <//#=> <left/*> <right/*>)
+ [((.is (.All (_ r w0 w1) (.-> (.-> r r .Bit) (..Array' r w0) (..Array' r w1) .Bit))
+ (.function (= //#= left/* right/*)
+ (.let [size (..size left/*)]
+ (.and ("lux i64 =" (..size right/*) size)
+ (.loop (again [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/*>)]))
+
+(def: .public composite
+ (template (composite <left/*> <right/*>)
+ [((.is (.All (_ a) (.-> (..Array' a .Nothing) (..Array' a .Nothing) (..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/*>)]))
+
+(def: .public mix
+ (template (mix <$> <init> <it>)
+ [((.is (.All (_ r w s)
+ (.-> (.-> Nat r s s) s (..Array' r w) s))
+ (.function (mix $ init it)
+ (.let [size (..size it)]
+ (.loop (again [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>)]))
+
+(def: .public each
+ (template (each <$> <input>)
+ [((.is (functor.Functor ..Array)
+ (.function (each $ input)
+ (..mix (.function (_ index item output)
+ (..has! index ($ item) output))
+ (..empty (..size input))
+ input)))
+ <$> <input>)]))
+
+(with_template [<name> <init> <op>]
+ [(def: .public <name>
+ (template (<name> <?> <it>)
+ [((.is (.All (_ r w)
+ (.-> (.-> r .Bit)
+ (.-> (..Array' r w) .Bit)))
+ (.function (<name> ? it)
+ (.let [size (..size it)]
+ (.loop (again [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>)
- [((.is (.All (_ r r' w)
- (.-> (.-> r (.Maybe r')) (..Array' r w) (.Maybe r')))
- (.function (one ? it)
- (.let [size (..size it)]
- (.loop (again [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}
+(def: .public one
+ (template (one <?> <it>)
+ [((.is (.All (_ r r' w)
+ (.-> (.-> r (.Maybe r')) (..Array' r w) (.Maybe r')))
+ (.function (one ? it)
+ (.let [size (..size it)]
+ (.loop (again [index 0])
+ (.if ("lux i64 <" (.int size) (.int index))
+ (with_expansions [<again> (again ("lux i64 +" 1 index))]
+ (.if (..lacks? index it)
<again>
-
- output
- output)))
- {.#None})))))
- <?> <it>)])
+ (.case (? (..item index it))
+ {.#None}
+ <again>
+
+ output
+ output)))
+ {.#None})))))
+ <?> <it>)]))