diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/unsafe/lux/data/binary.lux | 391 | ||||
| -rw-r--r-- | stdlib/source/unsafe/lux/data/collection/array.lux | 750 |
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>)])) |