diff options
Diffstat (limited to 'stdlib/source/library/lux/data/binary.lux')
-rw-r--r-- | stdlib/source/library/lux/data/binary.lux | 246 |
1 files changed, 133 insertions, 113 deletions
diff --git a/stdlib/source/library/lux/data/binary.lux b/stdlib/source/library/lux/data/binary.lux index 6cd8c722b..deec60d53 100644 --- a/stdlib/source/library/lux/data/binary.lux +++ b/stdlib/source/library/lux/data/binary.lux @@ -33,7 +33,10 @@ ["Offset" (%.nat offset)] ["Length" (%.nat length)])) -(with_expansions [<jvm> (as_is (type: #export Binary (ffi.type [byte])) +(with_expansions [<documentation> (as_is {#.doc (doc "A binary BLOB of data.")}) + <jvm> (as_is (type: #export Binary + <documentation> + (ffi.type [byte])) (ffi.import: java/lang/Object) @@ -75,14 +78,17 @@ (length ffi.Number)]) (type: #export Binary + <documentation> Uint8Array)) @.python (type: #export Binary + <documentation> (primitive "bytearray")) @.scheme (as_is (type: #export Binary + <documentation> (primitive "bytevector")) (ffi.import: (make-bytevector [Nat] Binary)) @@ -92,6 +98,7 @@ ## Default (type: #export Binary + <documentation> (array.Array (I64 Any))))) (template: (!size binary) @@ -114,167 +121,177 @@ ## Default (array.size binary))) -(template: (!read idx binary) - (for {@.old (..i64 (ffi.array_read idx binary)) - @.jvm (..i64 (ffi.array_read idx binary)) +(template: (!read index binary) + (for {@.old (..i64 (ffi.array_read index binary)) + @.jvm (..i64 (ffi.array_read index binary)) @.js (|> binary (: ..Binary) (:as (array.Array .Frac)) - ("js array read" idx) + ("js array read" index) f.nat .i64) @.python (|> binary (:as (array.Array .I64)) - ("python array read" idx)) + ("python array read" index)) @.scheme - (..bytevector-u8-ref [binary idx])} + (..bytevector-u8-ref [binary index])} ## Default (|> binary - (array.read idx) + (array.read index) (maybe.else (: (I64 Any) 0)) (:as I64)))) -(template: (!!write <byte_type> <post> <write> idx value binary) +(template: (!!write <byte_type> <post> <write> index value binary) (|> binary (: ..Binary) (:as (array.Array <byte_type>)) - (<write> idx (|> value .nat (n.% (hex "100")) <post>)) + (<write> index (|> value .nat (n.% (hex "100")) <post>)) (:as ..Binary))) -(template: (!write idx value binary) - (for {@.old (ffi.array_write idx (..byte value) binary) - @.jvm (ffi.array_write idx (..byte value) binary) +(template: (!write index value binary) + (for {@.old (ffi.array_write index (..byte value) binary) + @.jvm (ffi.array_write index (..byte value) binary) - @.js (!!write .Frac n.frac "js array write" idx value binary) - @.python (!!write (I64 Any) (:as (I64 Any)) "python array write" idx value binary) - @.scheme (exec (..bytevector-u8-set! [binary idx value]) + @.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! idx (|> value .nat (n.% (hex "100"))) binary))) + (array.write! index (|> value .nat (n.% (hex "100"))) binary))) (def: #export size (-> Binary Nat) (|>> !size)) -(def: #export create +(def: #export (create size) + {#.doc (doc "A fresh/empty binary BLOB of the specified size.")} (-> Nat Binary) - (for {@.old (|>> (ffi.array byte)) - @.jvm (|>> (ffi.array byte)) + (for {@.old (ffi.array byte size) + @.jvm (ffi.array byte size) @.js - (|>> n.frac ArrayBuffer::new Uint8Array::new) + (|> size n.frac ArrayBuffer::new Uint8Array::new) @.python - (|>> ("python apply" (:as ffi.Function ("python constant" "bytearray"))) - (:as Binary)) + (|> size + ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as Binary)) @.scheme - (|>> ..make-bytevector)} + (..make-bytevector size)} ## Default - array.new)) + (array.new size))) (def: #export (fold f init binary) (All [a] (-> (-> I64 a a) a Binary a)) (let [size (..!size binary)] - (loop [idx 0 + (loop [index 0 output init] - (if (n.< size idx) - (recur (inc idx) (f (!read idx binary) output)) + (if (n.< size index) + (recur (inc index) (f (!read index binary) output)) output)))) -(def: #export (read/8 idx binary) +(def: #export (read/8 index binary) + {#.doc (doc "Read 1 byte (8 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) idx) - (#try.Success (!read idx binary)) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (if (n.< (..!size binary) index) + (#try.Success (!read index binary)) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (read/16 idx binary) +(def: #export (read/16 index binary) + {#.doc (doc "Read 2 bytes (16 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 1 idx)) + (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success ($_ i64.or - (i64.left_shifted 8 (!read idx binary)) - (!read (n.+ 1 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (i64.left_shifted 8 (!read index binary)) + (!read (n.+ 1 index) binary))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (read/32 idx binary) +(def: #export (read/32 index binary) + {#.doc (doc "Read 4 bytes (32 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 3 idx)) + (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success ($_ i64.or - (i64.left_shifted 24 (!read idx binary)) - (i64.left_shifted 16 (!read (n.+ 1 idx) binary)) - (i64.left_shifted 8 (!read (n.+ 2 idx) binary)) - (!read (n.+ 3 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (read/64 idx binary) + (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: #export (read/64 index binary) + {#.doc (doc "Read 8 bytes (64 bits) at the given index.")} (-> Nat Binary (Try I64)) - (if (n.< (..!size binary) (n.+ 7 idx)) + (if (n.< (..!size binary) (n.+ 7 index)) (#try.Success ($_ i64.or - (i64.left_shifted 56 (!read idx binary)) - (i64.left_shifted 48 (!read (n.+ 1 idx) binary)) - (i64.left_shifted 40 (!read (n.+ 2 idx) binary)) - (i64.left_shifted 32 (!read (n.+ 3 idx) binary)) - (i64.left_shifted 24 (!read (n.+ 4 idx) binary)) - (i64.left_shifted 16 (!read (n.+ 5 idx) binary)) - (i64.left_shifted 8 (!read (n.+ 6 idx) binary)) - (!read (n.+ 7 idx) binary))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (write/8 idx value binary) + (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: #export (write/8 index value binary) + {#.doc (doc "Write 1 byte (8 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) idx) + (if (n.< (..!size binary) index) (#try.Success (|> binary - (!write idx value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!write index value))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (write/16 idx value binary) +(def: #export (write/16 index value binary) + {#.doc (doc "Write 2 bytes (16 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 1 idx)) + (if (n.< (..!size binary) (n.+ 1 index)) (#try.Success (|> binary - (!write idx (i64.right_shifted 8 value)) - (!write (n.+ 1 idx) value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!write index (i64.right_shifted 8 value)) + (!write (n.+ 1 index) value))) + (exception.except ..index_out_of_bounds [(..!size binary) index]))) -(def: #export (write/32 idx value binary) +(def: #export (write/32 index value binary) + {#.doc (doc "Write 4 bytes (32 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 3 idx)) + (if (n.< (..!size binary) (n.+ 3 index)) (#try.Success (|> binary - (!write idx (i64.right_shifted 24 value)) - (!write (n.+ 1 idx) (i64.right_shifted 16 value)) - (!write (n.+ 2 idx) (i64.right_shifted 8 value)) - (!write (n.+ 3 idx) value))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) - -(def: #export (write/64 idx value 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]))) + +(def: #export (write/64 index value binary) + {#.doc (doc "Write 8 bytes (64 bits) at the given index.")} (-> Nat (I64 Any) Binary (Try Binary)) - (if (n.< (..!size binary) (n.+ 7 idx)) - (for {@.scheme (let [write_high (|>> (!write idx (i64.right_shifted 56 value)) - (!write (n.+ 1 idx) (i64.right_shifted 48 value)) - (!write (n.+ 2 idx) (i64.right_shifted 40 value)) - (!write (n.+ 3 idx) (i64.right_shifted 32 value))) - write_low (|>> (!write (n.+ 4 idx) (i64.right_shifted 24 value)) - (!write (n.+ 5 idx) (i64.right_shifted 16 value)) - (!write (n.+ 6 idx) (i64.right_shifted 8 value)) - (!write (n.+ 7 idx) value))] + (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 idx (i64.right_shifted 56 value)) - (!write (n.+ 1 idx) (i64.right_shifted 48 value)) - (!write (n.+ 2 idx) (i64.right_shifted 40 value)) - (!write (n.+ 3 idx) (i64.right_shifted 32 value)) - (!write (n.+ 4 idx) (i64.right_shifted 24 value)) - (!write (n.+ 5 idx) (i64.right_shifted 16 value)) - (!write (n.+ 6 idx) (i64.right_shifted 8 value)) - (!write (n.+ 7 idx) value)))) - (exception.except ..index_out_of_bounds [(..!size binary) idx]))) + (!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]))) (implementation: #export equivalence (Equivalence Binary) @@ -286,11 +303,11 @@ (let [limit (!size reference)] (and (n.= limit (!size sample)) - (loop [idx 0] - (if (n.< limit idx) - (and (n.= (!read idx reference) - (!read idx sample)) - (recur (inc idx))) + (loop [index 0] + (if (n.< limit index) + (and (n.= (!read index reference) + (!read index sample)) + (recur (inc index))) true)))))))) (for {@.old (as_is) @@ -306,6 +323,7 @@ ["Target output space" (%.nat target_output)]))) (def: #export (copy bytes source_offset source target_offset target) + {#.doc (doc "Mutates the target binary BLOB by copying bytes from the source BLOB to it.")} (-> 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))] @@ -316,35 +334,37 @@ ## Default (let [source_input (n.- source_offset (!size source)) target_output (n.- target_offset (!size target))] - (if (n.<= source_input bytes) - (loop [idx 0] - (if (n.< bytes idx) - (exec (!write (n.+ target_offset idx) - (!read (n.+ source_offset idx) source) + (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) - (recur (inc idx))) - (#try.Success target))) - (exception.except ..cannot_copy_bytes [bytes source_input target_output])))))) + (recur (inc index))) + (#try.Success target)))))))) (def: #export (slice offset length binary) + {#.doc (doc "Yields a subset of the binary BLOB, so long as the specified range is valid.")} (-> Nat Nat Binary (Try Binary)) (let [size (..!size binary) limit (n.+ length offset)] - (if (n.<= size limit) + (if (n.> size limit) + (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 (..create length)))) - (exception.except ..slice_out_of_bounds [size offset length])))) + (..copy length offset binary 0 (..create length))))))) -(def: #export (drop offset binary) +(def: #export (drop bytes binary) + {#.doc (doc "Yields a binary BLOB with at most the specified number of bytes removed.")} (-> Nat Binary Binary) - (case offset + (case bytes 0 binary - _ (let [distance (n.- offset (..!size binary))] - (case (..slice offset distance binary) + _ (let [distance (n.- bytes (..!size binary))] + (case (..slice bytes distance binary) (#try.Success slice) slice |