diff options
author | Eduardo Julian | 2022-03-05 04:30:09 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-03-05 04:30:09 -0400 |
commit | a7fc50b1906fa97fb56d5ebe3d3fff7baee276da (patch) | |
tree | c62e695c6dc264533abe4003a6338d4a39e958c0 /stdlib/source/unsafe | |
parent | ab9dc5fd656ef42dbb0192f96d34e1c7b451a430 (diff) |
Optimizations for the pure-Lux JVM compiler. [Part 5]
Diffstat (limited to 'stdlib/source/unsafe')
-rw-r--r-- | stdlib/source/unsafe/lux/data/binary.lux | 483 | ||||
-rw-r--r-- | stdlib/source/unsafe/lux/data/collection/array.lux | 409 |
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>)]) |