From 8b6d474dd5d2b323d1dba29359460af4708402ea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Feb 2022 05:29:58 -0400 Subject: Optimizations for the pure-Lux JVM compiler. [Part 2] --- stdlib/source/unsafe/lux/data/binary.lux | 314 +++++++++++++++++++++++++++++++ 1 file changed, 314 insertions(+) create mode 100644 stdlib/source/unsafe/lux/data/binary.lux (limited to 'stdlib/source/unsafe') 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 [ (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 (as_is ) + + @.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 [ (: Nat size) + (|> + (ffi.array byte) + (: ..Binary))] + (: ..Binary + (for [@.old + @.jvm + + @.js + (|> + .int + "lux i64 f64" + ArrayBuffer::new + Uint8Array::new) + + @.python + (|> + ("python apply" (:as ffi.Function ("python constant" "bytearray"))) + (:as ..Binary)) + + @.scheme + (..make-bytevector )] + + ... Default + (array.empty ))))]) + +(template: .public (size it) + [(with_expansions [ (: ..Binary it) + (ffi.length )] + (: Nat + (for [@.old + @.jvm + + @.js + (|> + Uint8Array::length + (: Frac) + "lux f64 i64" + .nat) + + @.python + (|> + (:as (array.Array (I64 Any))) + "python array length") + + @.scheme + (..bytevector-length [])] + + ... Default + (array.size ))))]) + +(def: byte_mask + Nat + (i64.mask i64.bits_per_byte)) + +(with_expansions [ (.static ..byte_mask)] + (template: .public (bytes/1 index it) + [(with_expansions [ (: ..Binary it) + (: Nat index) + (|> + (ffi.read! ) + ffi.byte_to_long + (:as I64) + ("lux i64 and" ))] + (: I64 + (`` (for [@.old (~~ ) + @.jvm (~~ ) + + @.js + (|> + (:as (array.Array .Frac)) + ("js array read" ) + "lux f64 i64" + .i64) + + @.python + (|> + (:as (array.Array .I64)) + ("python array read" )) + + @.scheme + (..bytevector-u8-ref [ ])] + + ... Default + (.case (array.read! ) + {.#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 [ (hex "FF")] + (template: .public (with/1! index value it) + [(with_expansions [ (: ..Binary it) + (: Nat index) + (: (I64 Any) value) + (for [@.old + (|> (:as Int) ffi.long_to_byte) + + @.jvm + (|> (:as (Primitive "java.lang.Long")) ffi.long_to_byte)] + ) + (ffi.write! )] + (: ..Binary + (for [@.old + @.jvm + + @.js + (|> + (: ..Binary) + (:as (array.Array .Frac)) + ("js array write" + (|> + .int + ("lux i64 and" (.int )) + "lux i64 f64")) + (:as ..Binary)) + + @.python + (|> + (: ..Binary) + (:as (array.Array (I64 Any))) + ("python array write" (|> ("lux i64 and" ) (: (I64 Any)))) + (:as ..Binary)) + + @.scheme + (let [it' ] + (exec + (..bytevector-u8-set! [it' ]) + it'))] + + ... Default + (array.write! (|> .int ("lux i64 and" (.int ))) ))))])) + +(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 [ (java/util/Arrays::equals reference sample)] + (for [@.old + @.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 [ (as_is (exec + (java/lang/System::arraycopy source (.int source_offset) + target (.int target_offset) + (.int bytes)) + target))] + (for [@.old + @.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 [ (as_is (java/util/Arrays::copyOfRange binary (.int offset) (.int limit)))] + (for [@.old + @.jvm ] + + ... Default + (..copy! size offset binary 0 (..empty size)))))) -- cgit v1.2.3