diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/data/binary.lux | 427 | ||||
| -rw-r--r-- | stdlib/source/library/lux/target/jvm/bytecode.lux | 20 | ||||
| -rw-r--r-- | stdlib/source/library/lux/target/jvm/bytecode/instruction.lux | 198 | ||||
| -rw-r--r-- | stdlib/source/library/lux/target/python.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/binary.lux | 261 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/python.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/unsafe/lux/data/binary.lux | 314 |
9 files changed, 717 insertions, 582 deletions
diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 4eb32df1b..479c7d7a1 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -1,372 +1,137 @@ (.using - [library - [lux {"-" i64} - ["@" target] - ["[0]" ffi] - [abstract - [monad {"+" do}] - [equivalence {"+" Equivalence}] - [monoid {"+" Monoid}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - [text - ["%" format {"+" format}]] - [collection - ["[0]" array]]] - [math - [number {"+" hex} - ["n" nat] - ["f" frac] - ["[0]" i64]]]]]) - -(exception: .public (index_out_of_bounds [size Nat - index Nat]) - (exception.report - ["Size" (%.nat size)] - ["Index" (%.nat index)])) - -(exception: .public (slice_out_of_bounds [size Nat - offset Nat - length Nat]) - (exception.report - ["Size" (%.nat size)] - ["Offset" (%.nat offset)] - ["Length" (%.nat length)])) - -(with_expansions [<jvm> (as_is (type: .public Binary - (ffi.type [byte])) - - (ffi.import: java/lang/Object) - - (ffi.import: java/lang/System - ["[1]::[0]" - ("static" arraycopy [java/lang/Object int java/lang/Object int int] "try" void)]) - - (ffi.import: java/util/Arrays - ["[1]::[0]" - ("static" copyOfRange [[byte] int int] [byte]) - ("static" equals [[byte] [byte]] boolean)]) - - (def: byte_mask - I64 - (|> i64.bits_per_byte i64.mask .i64)) - - (def: i64 - (-> (Primitive "java.lang.Byte") I64) - (|>> ffi.byte_to_long (:as I64) (i64.and ..byte_mask))) - - (def: byte - (-> (I64 Any) (Primitive "java.lang.Byte")) - (for [@.old - (|>> .int ffi.long_to_byte) - - @.jvm - (|>> .int (:as (Primitive "java.lang.Long")) ffi.long_to_byte)])))] - (for [@.old (as_is <jvm>) - @.jvm (as_is <jvm>) - - @.js - (as_is (ffi.import: ArrayBuffer - ["[1]::[0]" - (new [ffi.Number])]) - - (ffi.import: Uint8Array - ["[1]::[0]" - (new [ArrayBuffer]) - (length ffi.Number)]) - - (type: .public Binary - Uint8Array)) - - @.python - (type: .public Binary - (Primitive "bytearray")) - - @.scheme - (as_is (type: .public Binary - (Primitive "bytevector")) - - (ffi.import: (make-bytevector [Nat] Binary)) - (ffi.import: (bytevector-u8-ref [Binary Nat] I64)) - (ffi.import: (bytevector-u8-set! [Binary Nat (I64 Any)] Any)) - (ffi.import: (bytevector-length [Binary] Nat)))] - - ... Default - (type: .public Binary - (array.Array (I64 Any))))) - -(template: (!size binary) - [(for [@.old (ffi.length binary) - @.jvm (ffi.length binary) - - @.js - (|> binary - Uint8Array::length - f.nat) - - @.python - (|> binary - (:as (array.Array (I64 Any))) - "python array length") - - @.scheme - (..bytevector-length [binary])] - - ... Default - (array.size binary))]) - -(template: (!read index binary) - [(for [@.old (..i64 (ffi.read! index binary)) - @.jvm (..i64 (ffi.read! index binary)) - - @.js - (|> binary - (: ..Binary) - (:as (array.Array .Frac)) - ("js array read" index) - f.nat - .i64) - - @.python - (|> binary - (:as (array.Array .I64)) - ("python array read" index)) - - @.scheme - (..bytevector-u8-ref [binary index])] - - ... Default - (|> binary - (array.read! index) - (maybe.else (: (I64 Any) 0)) - (:as I64)))]) - -(template: (!!write <byte_type> <post> <write> index value binary) - [(|> binary - (: ..Binary) - (:as (array.Array <byte_type>)) - (<write> index (|> value .nat (n.% (hex "100")) <post>)) - (:as ..Binary))]) - -(template: (!write index value binary) - [(for [@.old (ffi.write! index (..byte value) binary) - @.jvm (ffi.write! index (..byte value) binary) - - @.js (!!write .Frac n.frac "js array write" index value binary) - @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" index value binary) - @.scheme (exec (..bytevector-u8-set! [binary index value]) - binary)] - - ... Default - (array.write! index (|> value .nat (n.% (hex "100"))) binary))]) + [library + [lux "*" + ["@" target] + ["[0]" ffi] + [abstract + [equivalence {"+" Equivalence}] + [monoid {"+" Monoid}]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + [text + ["%" format]] + [collection + ["[0]" array]]] + [math + [number + ["n" nat]]]]] + ["[0]" / "_" + ["[1]" \\unsafe]]) + +(type: .public Binary + /.Binary) (def: .public size (-> Binary Nat) - (|>> !size)) + (|>> /.size)) (def: .public (empty size) (-> Nat Binary) - (for [@.old (ffi.array byte size) - @.jvm (ffi.array byte size) - - @.js - (|> size n.frac ArrayBuffer::new Uint8Array::new) - - @.python - (|> size - ("python apply" (:as ffi.Function ("python constant" "bytearray"))) - (:as Binary)) - - @.scheme - (..make-bytevector size)] + (/.empty size)) - ... Default - (array.empty size))) - -(def: .public (aggregate f init binary) +(def: .public (aggregate $ init it) (All (_ a) (-> (-> I64 a a) a Binary a)) - (let [size (..!size binary)] + (let [size (/.size it)] (loop [index 0 output init] (if (n.< size index) - (again (++ index) (f (!read index binary) output)) + (again (++ index) ($ (/.bytes/1 index it) output)) output)))) -(def: .public (read/8! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) index) - {try.#Success (!read index binary)} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/16! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 1 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 8 (!read index binary)) - (!read (n.+ 1 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/32! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 3 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 24 (!read index binary)) - (i64.left_shifted 16 (!read (n.+ 1 index) binary)) - (i64.left_shifted 8 (!read (n.+ 2 index) binary)) - (!read (n.+ 3 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (read/64! index binary) - (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 7 index)) - {try.#Success ($_ i64.or - (i64.left_shifted 56 (!read index binary)) - (i64.left_shifted 48 (!read (n.+ 1 index) binary)) - (i64.left_shifted 40 (!read (n.+ 2 index) binary)) - (i64.left_shifted 32 (!read (n.+ 3 index) binary)) - (i64.left_shifted 24 (!read (n.+ 4 index) binary)) - (i64.left_shifted 16 (!read (n.+ 5 index) binary)) - (i64.left_shifted 8 (!read (n.+ 6 index) binary)) - (!read (n.+ 7 index) binary))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/8! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) index) - {try.#Success (|> binary - (!write index value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/16! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 1 index)) - {try.#Success (|> binary - (!write index (i64.right_shifted 8 value)) - (!write (n.+ 1 index) value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) - -(def: .public (write/32! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 3 index)) - {try.#Success (|> binary - (!write index (i64.right_shifted 24 value)) - (!write (n.+ 1 index) (i64.right_shifted 16 value)) - (!write (n.+ 2 index) (i64.right_shifted 8 value)) - (!write (n.+ 3 index) value))} - (exception.except ..index_out_of_bounds [(..!size binary) index]))) +(exception: .public (index_out_of_bounds [size Nat + index Nat]) + (exception.report + ["Size" (%.nat size)] + ["Index" (%.nat index)])) -(def: .public (write/64! index value binary) - (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 7 index)) - (for [@.scheme (let [write_high (|>> (!write index (i64.right_shifted 56 value)) - (!write (n.+ 1 index) (i64.right_shifted 48 value)) - (!write (n.+ 2 index) (i64.right_shifted 40 value)) - (!write (n.+ 3 index) (i64.right_shifted 32 value))) - write_low (|>> (!write (n.+ 4 index) (i64.right_shifted 24 value)) - (!write (n.+ 5 index) (i64.right_shifted 16 value)) - (!write (n.+ 6 index) (i64.right_shifted 8 value)) - (!write (n.+ 7 index) value))] - (|> binary write_high write_low {try.#Success}))] - {try.#Success (|> binary - (!write index (i64.right_shifted 56 value)) - (!write (n.+ 1 index) (i64.right_shifted 48 value)) - (!write (n.+ 2 index) (i64.right_shifted 40 value)) - (!write (n.+ 3 index) (i64.right_shifted 32 value)) - (!write (n.+ 4 index) (i64.right_shifted 24 value)) - (!write (n.+ 5 index) (i64.right_shifted 16 value)) - (!write (n.+ 6 index) (i64.right_shifted 8 value)) - (!write (n.+ 7 index) value))}) - (exception.except ..index_out_of_bounds [(..!size binary) index]))) +(template [<safe> <unsafe> <shift>] + [(def: .public (<safe> index it) + (-> Nat Binary (Try I64)) + (if (n.< (/.size it) (|> index <shift>)) + {try.#Success (<unsafe> index it)} + (exception.except ..index_out_of_bounds [(/.size it) index])))] + + [read/8! /.bytes/1 (|>)] + [read/16! /.bytes/2 (n.+ 1)] + [read/32! /.bytes/4 (n.+ 3)] + [read/64! /.bytes/8 (n.+ 7)] + ) + +(template [<safe> <unsafe> <shift>] + [(def: .public (<safe> index value it) + (-> Nat (I64 Any) Binary (Try Binary)) + (if (n.< (/.size it) (|> index <shift>)) + {try.#Success (<unsafe> index value it)} + (exception.except ..index_out_of_bounds [(/.size it) index])))] + + [write/8! /.with/1! (|>)] + [write/16! /.with/2! (n.+ 1)] + [write/32! /.with/4! (n.+ 3)] + [write/64! /.with/8! (n.+ 7)] + ) (implementation: .public equivalence (Equivalence Binary) (def: (= reference sample) - (with_expansions [<jvm> (java/util/Arrays::equals reference sample)] - (for [@.old <jvm> - @.jvm <jvm>] - (let [limit (!size reference)] - (and (n.= limit - (!size sample)) - (loop [index 0] - (if (n.< limit index) - (and (n.= (!read index reference) - (!read index sample)) - (again (++ index))) - true)))))))) + (/.= reference sample))) -(for [@.old (as_is) - @.jvm (as_is)] - - ... Default - (exception: .public (cannot_copy_bytes [bytes Nat - source_input Nat - target_output Nat]) - (exception.report - ["Bytes" (%.nat bytes)] - ["Source input space" (%.nat source_input)] - ["Target output space" (%.nat target_output)]))) +(exception: .public (cannot_copy_bytes [bytes Nat + source_input Nat + target_output Nat]) + (exception.report + ["Bytes" (%.nat bytes)] + ["Source input space" (%.nat source_input)] + ["Target output space" (%.nat target_output)])) (def: .public (copy bytes source_offset source target_offset target) (-> Nat Nat Binary Nat Binary (Try Binary)) - (with_expansions [<jvm> (as_is (do try.monad - [_ (java/lang/System::arraycopy source (.int source_offset) target (.int target_offset) (.int bytes))] - (in target)))] - (for [@.old <jvm> - @.jvm <jvm>] - - ... Default - (let [source_input (n.- source_offset (!size source)) - target_output (n.- target_offset (!size target))] - (if (n.> source_input bytes) - (exception.except ..cannot_copy_bytes [bytes source_input target_output]) - (loop [index 0] - (if (n.< bytes index) - (exec (!write (n.+ target_offset index) - (!read (n.+ source_offset index) source) - target) - (again (++ index))) - {try.#Success target}))))))) + (let [source_input (n.- source_offset (/.size source))] + (if (n.< bytes source_input) + (let [target_output (n.- target_offset (/.size target))] + (exception.except ..cannot_copy_bytes [bytes source_input target_output])) + {try.#Success (/.copy! bytes source_offset source target_offset target)}))) + +(exception: .public (slice_out_of_bounds [size Nat + offset Nat + length Nat]) + (exception.report + ["Size" (%.nat size)] + ["Offset" (%.nat offset)] + ["Length" (%.nat length)])) (def: .public (slice offset length binary) (-> Nat Nat Binary (Try Binary)) - (let [size (..!size binary) + (let [size (/.size binary) limit (n.+ length offset)] - (if (n.> size limit) + (if (n.< limit size) (exception.except ..slice_out_of_bounds [size offset length]) - (with_expansions [<jvm> (as_is {try.#Success (java/util/Arrays::copyOfRange binary (.int offset) (.int limit))})] - (for [@.old <jvm> - @.jvm <jvm>] - - ... Default - (..copy length offset binary 0 (..empty length))))))) + {try.#Success (/.slice offset length binary)}))) (def: .public (after bytes binary) (-> Nat Binary Binary) - (case bytes - 0 binary - _ (let [distance (n.- bytes (..!size binary))] - (case (..slice bytes distance binary) - {try.#Success slice} - slice - - {try.#Failure _} - (..empty 0))))) + (cond (n.= 0 bytes) + binary + + (n.< bytes (/.size binary)) + (/.empty 0) + + ... else + (/.slice bytes (n.- bytes (/.size binary)) binary))) (implementation: .public monoid (Monoid Binary) (def: identity - (..empty 0)) + (/.empty 0)) (def: (composite left right) - (let [sizeL (!size left) - sizeR (!size right) - output (..empty (n.+ sizeL sizeR))] + (let [sizeL (/.size left) + sizeR (/.size right) + output (/.empty (n.+ sizeL sizeR))] (exec - (..copy sizeL 0 left 0 output) - (..copy sizeR 0 right sizeL output) + (/.copy! sizeL 0 left 0 output) + (/.copy! sizeR 0 right sizeL output) output)))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 5c70611bf..4cdd42299 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -211,8 +211,8 @@ {try.#Success [state' [relative ($ it)]]} ... {try.#Failure error} - it - (:expected it))))) + failure + (:expected failure))))) (implementation: .public monad (Monad Bytecode) @@ -232,12 +232,12 @@ {try.#Success [state'' [(relative#composite left right) it]]} ... {try.#Failure error} - it - (:expected it)) + failure + (:expected failure)) ... {try.#Failure error} - it - (:expected it))))) + failure + (:expected failure))))) (def: .public (when_continuous it) (-> (Bytecode Any) (Bytecode Any)) @@ -1148,9 +1148,9 @@ {try.#Success [state'' [(relative#composite left right) it]]} ... {try.#Failure error} - it - it) + failure + failure) ... {try.#Failure error} - it - (:expected it)))) + failure + (:expected failure)))) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index c422dd1c2..4f371461a 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -1,6 +1,7 @@ (.using [library [lux "*" + [ffi {"+"}] [abstract [monad {"+" do}] [monoid {"+" Monoid}]] @@ -9,7 +10,9 @@ ["[0]" try]] [data ["[0]" product] - ["[0]" binary] + ["[0]" binary "_" + [/ {"+"}] + ["[1]" \\unsafe]] ["[0]" format "_" ["[1]" binary {"+" Mutation Specification}]] [collection @@ -76,8 +79,7 @@ (function (_ [offset binary]) [(n.+ (///unsigned.value ..opcode_size) offset) - (try.trusted - (binary.write/8! offset opcode binary))])) + (binary.with/1! offset opcode binary)])) (def: nullary [Estimator (-> Opcode Instruction)] @@ -105,12 +107,10 @@ (-> Opcode <inputT> Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value <shift>) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode_size) offset) - (<unwrap> input0) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) + (<unwrap> input0)))])) (def: <name> [Estimator (-> Opcode <inputT> Instruction)] @@ -119,10 +119,10 @@ [(n.+ (///unsigned.value <shift>) size) (|>> mutation ((<private> opcode input0)))])]))] - [..size/1 unary/1 U1 binary.write/8! ///unsigned.value] - [..size/2 unary/2 U2 binary.write/16! ///unsigned.value] - [..size/2 jump/2 Jump binary.write/16! ///signed.value] - [..size/4 jump/4 Big_Jump binary.write/32! ///signed.value] + [..size/1 unary/1 U1 binary.with/1! ///unsigned.value] + [..size/2 unary/2 U2 binary.with/2! ///unsigned.value] + [..size/2 jump/2 Jump binary.with/2! ///signed.value] + [..size/4 jump/4 Big_Jump binary.with/4! ///signed.value] ) (template [<shift> <name> <inputT> <writer>] @@ -131,12 +131,10 @@ (-> Opcode <inputT> Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value <shift>) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode_size) offset) - (///signed.value input0) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) + (///signed.value input0)))])) (def: <name> [Estimator (-> Opcode <inputT> Instruction)] @@ -145,8 +143,8 @@ [(n.+ (///unsigned.value <shift>) size) (|>> mutation ((<private> opcode input0)))])]))] - [..size/1 unary/1' S1 binary.write/8!] - [..size/2 unary/2' S2 binary.write/16!] + [..size/1 unary/1' S1 binary.with/1!] + [..size/2 unary/2' S2 binary.with/2!] ) (def: size/11 @@ -159,15 +157,12 @@ (-> Opcode U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/11) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/8! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/1) offset) - (///unsigned.value input1) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/1! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/1) offset) + (///unsigned.value input1)))])) (def: binary/11 [Estimator (-> Opcode U1 U1 Instruction)] @@ -186,15 +181,12 @@ (-> Opcode U2 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/21) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)))])) (def: binary/21 [Estimator (-> Opcode U2 U1 Instruction)] @@ -214,18 +206,14 @@ (-> Opcode U2 U1 U1 Mutation) (function (_ [offset binary]) [(n.+ (///unsigned.value ..size/211) offset) - (try.trusted - (do try.monad - [_ (binary.write/8! offset opcode binary) - _ (binary.write/16! (n.+ (///unsigned.value ..opcode_size) offset) - (///unsigned.value input0) - binary) - _ (binary.write/8! (n.+ (///unsigned.value ..size/2) offset) - (///unsigned.value input1) - binary)] - (binary.write/8! (n.+ (///unsigned.value ..size/21) offset) - (///unsigned.value input2) - binary)))])) + (|> binary + (binary.with/1! offset opcode) + (binary.with/2! (n.+ (///unsigned.value ..opcode_size) offset) + (///unsigned.value input0)) + (binary.with/1! (n.+ (///unsigned.value ..size/2) offset) + (///unsigned.value input1)) + (binary.with/1! (n.+ (///unsigned.value ..size/21) offset) + (///unsigned.value input2)))])) (def: trinary/211 [Estimator (-> Opcode U2 U1 U1 Instruction)] @@ -617,34 +605,34 @@ (try.trusted (do [! try.monad] [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) - maximum (///signed.+/4 minimum amount_of_afterwards) - _ (binary.write/8! offset (hex "AA") binary) - .let [offset (n.+ (///unsigned.value ..opcode_size) offset)] - _ (case padding - 3 (do ! - [_ (binary.write/8! offset 0 binary)] - (binary.write/16! (++ offset) 0 binary)) - 2 (binary.write/16! offset 0 binary) - 1 (binary.write/8! offset 0 binary) - _ (in binary)) - .let [offset (n.+ padding offset)] - _ (binary.write/32! offset (///signed.value default) binary) - .let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] - _ (binary.write/32! offset (///signed.value minimum) binary) - .let [offset (n.+ (///unsigned.value ..integer_size) offset)] - _ (binary.write/32! offset (///signed.value maximum) binary)] - (loop [offset (n.+ (///unsigned.value ..integer_size) offset) - afterwards (: (List Big_Jump) - {.#Item at_minimum afterwards})] - (case afterwards - {.#End} - (in binary) - - {.#Item head tail} - (do ! - [_ (binary.write/32! offset (///signed.value head) binary)] - (again (n.+ (///unsigned.value ..big_jump_size) offset) - tail))))))]))] + maximum (///signed.+/4 minimum amount_of_afterwards)] + (in (let [_ (binary.with/1! offset (hex "AA") binary) + offset (n.+ (///unsigned.value ..opcode_size) offset) + _ (case padding + 3 (|> binary + (binary.with/1! offset 0) + (binary.with/2! (++ offset) 0)) + 2 (binary.with/2! offset 0 binary) + 1 (binary.with/1! offset 0 binary) + _ binary) + offset (n.+ padding offset) + _ (binary.with/4! offset (///signed.value default) binary) + offset (n.+ (///unsigned.value ..big_jump_size) offset) + _ (binary.with/4! offset (///signed.value minimum) binary) + offset (n.+ (///unsigned.value ..integer_size) offset) + _ (binary.with/4! offset (///signed.value maximum) binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + afterwards (: (List Big_Jump) + {.#Item at_minimum afterwards})] + (case afterwards + {.#End} + binary + + {.#Item head tail} + (exec + (binary.with/4! offset (///signed.value head) binary) + (again (n.+ (///unsigned.value ..big_jump_size) offset) + tail))))))))]))] [(n.+ tableswitch_size size) (|>> mutation tableswitch_mutation)]))))])) @@ -678,33 +666,31 @@ lookupswitch_mutation (: Mutation (function (_ [offset binary]) [(n.+ lookupswitch_size offset) - (try.trusted - (do [! try.monad] - [_ (binary.write/8! offset (hex "AB") binary) - .let [offset (n.+ (///unsigned.value ..opcode_size) offset)] - _ (case padding - 3 (do ! - [_ (binary.write/8! offset 0 binary)] - (binary.write/16! (++ offset) 0 binary)) - 2 (binary.write/16! offset 0 binary) - 1 (binary.write/8! offset 0 binary) - _ (in binary)) - .let [offset (n.+ padding offset)] - _ (binary.write/32! offset (///signed.value default) binary) - .let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] - _ (binary.write/32! offset amount_of_cases binary)] - (loop [offset (n.+ (///unsigned.value ..integer_size) offset) - cases cases] - (case cases - {.#End} - (in binary) - - {.#Item [value jump] tail} - (do ! - [_ (binary.write/32! offset (///signed.value value) binary) - _ (binary.write/32! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)] - (again (n.+ case_size offset) - tail))))))]))] + (let [_ (binary.with/1! offset (hex "AB") binary) + offset (n.+ (///unsigned.value ..opcode_size) offset) + _ (case padding + 3 (|> binary + (binary.with/1! offset 0) + (binary.with/2! (++ offset) 0)) + 2 (binary.with/2! offset 0 binary) + 1 (binary.with/1! offset 0 binary) + _ binary) + offset (n.+ padding offset) + _ (binary.with/4! offset (///signed.value default) binary) + offset (n.+ (///unsigned.value ..big_jump_size) offset) + _ (binary.with/4! offset amount_of_cases binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + cases cases] + (case cases + {.#End} + binary + + {.#Item [value jump] tail} + (exec + (binary.with/4! offset (///signed.value value) binary) + (binary.with/4! (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary) + (again (n.+ case_size offset) + tail)))))]))] [(n.+ lookupswitch_size size) (|>> mutation lookupswitch_mutation)]))))])) diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index dc1b5e935..90d8210ef 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -230,29 +230,16 @@ (format (:representation func) "(" (text.interposed ", " (list#each ..code args)) ")"))) (template [<name> <brand> <prefix>] - [(def: (<name> var) - (-> (Expression Any) Text) - (format <prefix> (:representation var)))] + [(def: .public <name> + (-> (Expression Any) (Expression Any)) + (|>> :representation + (format <prefix>) + :abstraction))] [splat_poly Poly "*"] [splat_keyword Keyword "**"] ) - (template [<name> <splat>] - [(def: .public (<name> args extra func) - (-> (List (Expression Any)) (Expression Any) (Expression Any) (Computation Any)) - (<| :abstraction - ... ..expression - (format (:representation func) - (format "(" (|> args - (list#each (function (_ arg) (format (:representation arg) ", "))) - text.together) - (<splat> extra) ")"))))] - - [apply_poly splat_poly] - [apply_keyword splat_keyword] - ) - (def: .public (the name object) (-> Text (Expression Any) (Computation Any)) (:abstraction (format (:representation object) "." name))) @@ -261,16 +248,6 @@ (-> Text (List (Expression Any)) (Expression Any) (Computation Any)) (..apply/* (..the method object) args)) - (template [<name> <apply>] - [(def: .public (<name> args extra method) - (-> (List (Expression Any)) (Expression Any) Text - (-> (Expression Any) (Computation Any))) - (|>> (..the method) (<apply> args extra)))] - - [do_poly apply_poly] - [do_keyword apply_keyword] - ) - (def: .public (item idx array) (-> (Expression Any) (Expression Any) Location) (:abstraction (format (:representation array) "[" (:representation idx) "]"))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux index bd2c04844..db622ca0c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux @@ -117,8 +117,7 @@ [var (..check check.var) .let [[@it :it:] var] it (it var) - ... _ (..check (check.forget! @it)) - ] + _ (..check (check.forget! @it))] (in it))) (def: .public (inferring action) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index d747ff070..21cf02c95 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -136,12 +136,14 @@ (function (_ extension_name analyse archive args) (case args (^ (list opC)) - (do ////.monad - [[var_id varT] (typeA.check check.var) - _ (typeA.inference (type (Either Text varT))) - opA (<| (typeA.expecting (type (-> .Any varT))) - (analyse archive opC))] - (in {////analysis.#Extension extension_name (list opA)})) + (<| typeA.with_var + (function (_ [@var :var:])) + (do [! ////.monad] + [_ (typeA.inference (type (Either Text :var:)))] + (|> opC + (analyse archive) + (typeA.expecting (type (-> .Any :var:))) + (# ! each (|>> list {////analysis.#Extension extension_name}))))) _ (////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index f3bd5e78f..0a354092d 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -1,26 +1,29 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - ["[0]" monad {"+" do}] - ["[0]" enum] - [\\specification - ["$[0]" equivalence] - ["$[0]" monoid]]] - [control - ["[0]" try {"+" Try}] - ["[0]" exception {"+" Exception}]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["[0]" i64] - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Binary}]]) + [library + [lux "*" + [ffi {"+"}] + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}] + ["[0]" enum] + [\\specification + ["$[0]" equivalence] + ["$[0]" monoid]]] + [control + ["[0]" try {"+" Try}] + ["[0]" exception {"+" Exception}]] + [data + [collection + [array {"+"}] + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["[0]" random {"+" Random}] + [number + ["[0]" i64] + ["n" nat]]]]] + [\\library + ["[0]" / + ["!" \\unsafe]]]) (def: (succeed result) (-> (Try Bit) Bit) @@ -32,7 +35,7 @@ output)) (def: .public (random size) - (-> Nat (Random Binary)) + (-> Nat (Random /.Binary)) (let [output (/.empty size)] (loop [idx 0] (if (n.< size idx) @@ -52,7 +55,7 @@ false)) (def: (binary_io power read write value) - (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) + (-> Nat (-> Nat /.Binary (Try Nat)) (-> Nat Nat /.Binary (Try Any)) Nat Bit) (let [bytes (i64.left_shifted power 1) binary (/.empty bytes) cap (case bytes @@ -75,9 +78,74 @@ {.#Item head tail}) (list))) +(def: test|unsafe + Test + (<| (_.covering !._) + (_.for [!.Binary]) + (do [! random.monad] + [.let [gen_size (|> random.nat (# ! each (|>> (n.% 100) (n.max 8))))] + size gen_size + sample (..random size) + value random.nat + .let [gen_idx (|> random.nat (# ! each (n.% size)))] + offset gen_idx + length (# ! each (n.% (n.- offset size)) random.nat)] + (`` ($_ _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= left right)) + (..random size))) + (_.cover [!.empty] + (!.= (!.empty size) (!.empty size))) + (_.cover [!.size] + (|> (!.empty size) !.size (n.= size))) + (~~ (template [<power> <bytes/?> <with/?>] + [(_.cover [<bytes/?> <with/?>] + (let [bytes (i64.left_shifted <power> 1) + binary (!.empty bytes) + cap (case bytes + 8 (-- 0) + _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) + capped_value (i64.and cap value) + + pre (<bytes/?> 0 binary) + _ (<with/?> 0 value binary) + post (<bytes/?> 0 binary)] + (and (n.= 0 pre) + (n.= capped_value post))))] + + [0 !.bytes/1 !.with/1!] + [1 !.bytes/2 !.with/2!] + [2 !.bytes/4 !.with/4!] + [3 !.bytes/8 !.with/8!])) + (_.cover [!.slice] + (let [random_slice (!.slice offset length sample) + idxs (: (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (!.bytes/1 idx binary))] + (and (n.= length (!.size random_slice)) + (# (list.equivalence n.equivalence) = + (list#each (|>> (n.+ offset) (reader sample)) idxs) + (list#each (reader random_slice) idxs))))) + (_.cover [!.copy!] + (and (let [it (!.copy! size 0 sample 0 (!.empty size))] + (and (not (same? sample it)) + (!.= sample it))) + (let [sample/0 (!.bytes/1 0 sample) + copy (!.copy! 1 0 sample 0 (!.empty 2)) + copy/0 (!.bytes/1 0 copy) + copy/1 (!.bytes/1 1 copy)] + (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))) + ))))) + (def: .public test Test (<| (_.covering /._) + (_.for [/.Binary]) (do [! random.monad] [.let [gen_size (|> random.nat (# ! each (|>> (n.% 100) (n.max 8))))] size gen_size @@ -86,78 +154,79 @@ .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset gen_idx length (# ! each (n.% (n.- offset size)) random.nat)] - (_.for [/.Binary] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random size))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (..random size))) - (_.cover [/.aggregate] - (n.= (# list.mix mix n.+ 0 (..as_list sample)) - (/.aggregate n.+ 0 sample))) - - (_.cover [/.empty] - (# /.equivalence = - (/.empty size) - (/.empty size))) - (_.cover [/.size] - (|> (/.empty size) /.size (n.= size))) - (_.for [/.index_out_of_bounds] - ($_ _.and - (_.cover [/.read/8! /.write/8!] - (..binary_io 0 /.read/8! /.write/8! value)) - (_.cover [/.read/16! /.write/16!] - (..binary_io 1 /.read/16! /.write/16! value)) - (_.cover [/.read/32! /.write/32!] - (..binary_io 2 /.read/32! /.write/32! value)) - (_.cover [/.read/64! /.write/64!] - (..binary_io 3 /.read/64! /.write/64! value)))) - (_.cover [/.slice] - (let [random_slice (try.trusted (/.slice offset length sample)) - idxs (: (List Nat) - (case length - 0 (list) - _ (enum.range n.enum 0 (-- length)))) - reader (function (_ binary idx) - (/.read/8! idx binary))] - (and (n.= length (/.size random_slice)) - (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) - (monad.each try.monad (reader random_slice) idxs)] - [{try.#Success binary_vals} {try.#Success slice_vals}] - (# (list.equivalence n.equivalence) = binary_vals slice_vals) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random size))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (..random size))) + (_.cover [/.aggregate] + (n.= (# list.mix mix n.+ 0 (..as_list sample)) + (/.aggregate n.+ 0 sample))) + + (_.cover [/.empty] + (# /.equivalence = + (/.empty size) + (/.empty size))) + (_.cover [/.size] + (|> (/.empty size) /.size (n.= size))) + (_.for [/.index_out_of_bounds] + ($_ _.and + (_.cover [/.read/8! /.write/8!] + (..binary_io 0 /.read/8! /.write/8! value)) + (_.cover [/.read/16! /.write/16!] + (..binary_io 1 /.read/16! /.write/16! value)) + (_.cover [/.read/32! /.write/32!] + (..binary_io 2 /.read/32! /.write/32! value)) + (_.cover [/.read/64! /.write/64!] + (..binary_io 3 /.read/64! /.write/64! value)))) + (_.cover [/.slice] + (let [random_slice (try.trusted (/.slice offset length sample)) + idxs (: (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (/.read/8! idx binary))] + (and (n.= length (/.size random_slice)) + (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) + (monad.each try.monad (reader random_slice) idxs)] + [{try.#Success binary_vals} {try.#Success slice_vals}] + (# (list.equivalence n.equivalence) = binary_vals slice_vals) + + _ + #0)))) + (_.cover [/.slice_out_of_bounds] + (and (throws? /.slice_out_of_bounds (/.slice size size sample)) + (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] + (case offset + 0 (not verdict) + _ verdict)))) + (_.cover [/.after] + (and (# /.equivalence = sample (/.after 0 sample)) + (# /.equivalence = (/.empty 0) (/.after size sample)) + (case (list.reversed (..as_list sample)) + {.#End} + false - _ - #0)))) - (_.cover [/.slice_out_of_bounds] - (and (throws? /.slice_out_of_bounds (/.slice size size sample)) - (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] - (case offset - 0 (not verdict) - _ verdict)))) - (_.cover [/.after] - (and (# /.equivalence = sample (/.after 0 sample)) - (# /.equivalence = (/.empty 0) (/.after size sample)) - (case (list.reversed (..as_list sample)) - {.#End} - false + {.#Item head tail} + (n.= (list.mix n.+ 0 tail) + (/.aggregate n.+ 0 (/.after 1 sample)))))) + (_.cover [/.copy] + (and (case (/.copy size 0 sample 0 (/.empty size)) + {try.#Success output} + (and (not (same? sample output)) + (# /.equivalence = sample output)) - {.#Item head tail} - (n.= (list.mix n.+ 0 tail) - (/.aggregate n.+ 0 (/.after 1 sample)))))) - (_.cover [/.copy] - (and (case (/.copy size 0 sample 0 (/.empty size)) - {try.#Success output} - (and (not (same? sample output)) - (# /.equivalence = sample output)) + {try.#Failure _} + false) + (succeed + (do try.monad + [sample/0 (/.read/8! 0 sample) + copy (/.copy 1 0 sample 0 (/.empty 2)) + copy/0 (/.read/8! 0 copy) + copy/1 (/.read/8! 1 copy)] + (in (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))))) - {try.#Failure _} - false) - (succeed - (do try.monad - [sample/0 (/.read/8! 0 sample) - copy (/.copy 1 0 sample 0 (/.empty 2)) - copy/0 (/.read/8! 0 copy) - copy/1 (/.read/8! 1 copy)] - (in (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))))) - ))))) + ..test|unsafe + )))) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index 6eed5ecab..45eae7e38 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -329,8 +329,12 @@ (do [! random.monad] [expected/0 random.safe_frac expected/1 random.safe_frac - choice (# ! each (n.% 2) random.nat) - .let [expected/? (case choice + poly_choice (# ! each (n.% 2) random.nat) + .let [keyword (|>> %.nat (format "k") /.string) + keyword/0 (keyword 0) + keyword/1 (keyword 1) + keyword_choice (keyword poly_choice)] + .let [expected/? (case poly_choice 0 expected/0 _ expected/1)] $var (# ! each (|>> %.nat (format "v") /.var) random.nat) @@ -344,9 +348,28 @@ (expression (|>> (:as Frac) (f.= expected/?)) (/.apply/* (/.lambda (list $choice (/.poly $var)) (/.item $choice $var)) - (list (/.int (.int choice)) + (list (/.int (.int poly_choice)) (/.float expected/0) (/.float expected/1))))) + (_.for [/.Keyword /.KVar] + ($_ _.and + (_.cover [/.keyword] + (expression (|>> (:as Nat) (n.= 2)) + (/.apply/* (/.lambda (list $choice (/.keyword $var)) + (/.len/1 $var)) + (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)]))))))) + (_.cover [/.splat_keyword] + (expression (|>> (:as Frac) (f.= expected/?)) + (/.apply/* (/.lambda (list $choice (/.keyword $var)) + (/.item $choice $var)) + (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)]))))))) + )) ))) (def: test|expression diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux new file mode 100644 index 000000000..868dd82f3 --- /dev/null +++ b/stdlib/source/unsafe/lux/data/binary.lux @@ -0,0 +1,314 @@ +(.using + [library + [lux "*" + ["@" target] + ["[0]" ffi] + [control + [function + [inline {"+" inline:}]]] + [data + [collection + ["[0]" array]]] + [math + [number {"+" hex} + ["[0]" i64]]]]]) + +(with_expansions [<jvm> (as_is (type: .public Binary + (ffi.type [byte])) + + (ffi.import: java/lang/Object) + + (ffi.import: java/lang/System + ["[1]::[0]" + ("static" arraycopy [java/lang/Object int java/lang/Object int int] void)]) + + (ffi.import: java/util/Arrays + ["[1]::[0]" + ("static" copyOfRange [[byte] int int] [byte]) + ("static" equals [[byte] [byte]] boolean)]))] + (for [@.old (as_is <jvm>) + @.jvm (as_is <jvm>) + + @.js + (as_is (ffi.import: ArrayBuffer + ["[1]::[0]" + (new [ffi.Number])]) + + (ffi.import: Uint8Array + ["[1]::[0]" + (new [ArrayBuffer]) + (length ffi.Number)]) + + (type: .public Binary + Uint8Array)) + + @.python + (type: .public Binary + (Primitive "bytearray")) + + @.scheme + (as_is (type: .public Binary + (Primitive "bytevector")) + + (ffi.import: (make-bytevector [Nat] Binary)) + (ffi.import: (bytevector-u8-ref [Binary Nat] I64)) + (ffi.import: (bytevector-u8-set! [Binary Nat (I64 Any)] Any)) + (ffi.import: (bytevector-length [Binary] Nat)))] + + ... Default + (type: .public Binary + (array.Array (I64 Any))))) + +(template: .public (empty size) + [(with_expansions [<size> (: Nat size) + <jvm> (|> <size> + (ffi.array byte) + (: ..Binary))] + (: ..Binary + (for [@.old <jvm> + @.jvm <jvm> + + @.js + (|> <size> + .int + "lux i64 f64" + ArrayBuffer::new + Uint8Array::new) + + @.python + (|> <size> + ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as ..Binary)) + + @.scheme + (..make-bytevector <size>)] + + ... Default + (array.empty <size>))))]) + +(template: .public (size it) + [(with_expansions [<it> (: ..Binary it) + <jvm> (ffi.length <it>)] + (: Nat + (for [@.old <jvm> + @.jvm <jvm> + + @.js + (|> <it> + Uint8Array::length + (: Frac) + "lux f64 i64" + .nat) + + @.python + (|> <it> + (:as (array.Array (I64 Any))) + "python array length") + + @.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)] + (template: .public (bytes/1 index it) + [(with_expansions [<it> (: ..Binary it) + <index> (: Nat index) + <jvm> (|> <it> + (ffi.read! <index>) + ffi.byte_to_long + (:as I64) + ("lux i64 and" <byte_mask>))] + (: I64 + (`` (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)))))))])) + +(template: .public (bytes/2 index' it') + [(let [index (: Nat index') + it (: ..Binary it')] + (: I64 + ($_ "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')] + (: I64 + ($_ "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')] + (: I64 + ($_ "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")] + (template: .public (with/1! index value it) + [(with_expansions [<it> (: ..Binary it) + <index> (: Nat index) + <value> (: (I64 Any) value) + <value> (for [@.old + (|> <value> (:as Int) ffi.long_to_byte) + + @.jvm + (|> <value> (:as (Primitive "java.lang.Long")) ffi.long_to_byte)] + <value>) + <jvm> (ffi.write! <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/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)))]) + +(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))))]) + +(def: .public (= reference sample) + (-> ..Binary ..Binary Bit) + (with_expansions [<jvm> (java/util/Arrays::equals reference sample)] + (for [@.old <jvm> + @.jvm <jvm>] + (let [limit (..size reference)] + (and ("lux i64 =" limit (..size sample)) + (loop [index 0] + (if ("lux i64 =" limit index) + (and ("lux i64 =" + (..bytes/1 index reference) + (..bytes/1 index sample)) + (again (++ index))) + true))))))) + +(def: .public (copy! bytes source_offset source target_offset target) + (-> Nat Nat ..Binary Nat ..Binary ..Binary) + (with_expansions [<jvm> (as_is (exec + (java/lang/System::arraycopy source (.int source_offset) + target (.int target_offset) + (.int bytes)) + 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))))) + +(def: .public (slice offset size binary) + (-> Nat Nat ..Binary ..Binary) + (let [limit ("lux i64 +" size offset)] + (with_expansions [<jvm> (as_is (java/util/Arrays::copyOfRange binary (.int offset) (.int limit)))] + (for [@.old <jvm> + @.jvm <jvm>] + + ... Default + (..copy! size offset binary 0 (..empty size)))))) |