aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2022-02-12 05:29:58 -0400
committerEduardo Julian2022-02-12 05:29:58 -0400
commit8b6d474dd5d2b323d1dba29359460af4708402ea (patch)
tree32a752dbced8f5620e9f4f57be5b36ef33860f31
parent105ab334201646be6b594d3d1215297e3b629a10 (diff)
Optimizations for the pure-Lux JVM compiler. [Part 2]
-rw-r--r--.gitignore13
-rw-r--r--documentation/bookmark/concurrency/lock_free_programming.md1
l---------lux-php/source/lux.lux1
-rw-r--r--stdlib/source/library/lux/data/binary.lux427
-rw-r--r--stdlib/source/library/lux/target/jvm/bytecode.lux20
-rw-r--r--stdlib/source/library/lux/target/jvm/bytecode/instruction.lux198
-rw-r--r--stdlib/source/library/lux/target/python.lux33
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/analysis/type.lux3
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux14
-rw-r--r--stdlib/source/test/lux/data/binary.lux261
-rw-r--r--stdlib/source/test/lux/target/python.lux29
-rw-r--r--stdlib/source/unsafe/lux/data/binary.lux314
12 files changed, 724 insertions, 590 deletions
diff --git a/.gitignore b/.gitignore
index 0b6b8cbbd..40d60ba10 100644
--- a/.gitignore
+++ b/.gitignore
@@ -22,12 +22,14 @@ aedifex.jar
/lux-jvm/RELEASE
/lux-jvm/target
/lux-jvm/source/library
+/lux-jvm/source/unsafe
/lux-jvm/source/program
/lux-jvm/source/spec
/lux-js/RELEASE
/lux-js/target
/lux-js/source/library
+/lux-js/source/unsafe
/lux-js/source/program
/lux-js/source/spec
/lux-js/node_based_compiler.js
@@ -36,18 +38,21 @@ aedifex.jar
/lux-python/RELEASE
/lux-python/target
/lux-python/source/library
+/lux-python/source/unsafe
/lux-python/source/program
/lux-python/source/spec
/lux-lua/RELEASE
/lux-lua/target
/lux-lua/source/library
+/lux-lua/source/unsafe
/lux-lua/source/program
/lux-lua/source/spec
/lux-ruby/RELEASE
/lux-ruby/target
/lux-ruby/source/library
+/lux-ruby/source/unsafe
/lux-ruby/source/program
/lux-ruby/source/spec
@@ -56,25 +61,19 @@ aedifex.jar
/lux-php/target
/lux-php/source/library
-/lux-php/source/lux
+/lux-php/source/unsafe
/lux-php/source/program
/lux-php/source/spec
/lux-cl/target
-/lux-cl/source/lux.lux
-/lux-cl/source/lux
/lux-cl/source/program
/lux-cl/source/spec
/lux-scheme/target
-/lux-scheme/source/lux.lux
-/lux-scheme/source/lux
/lux-scheme/source/program
/lux-scheme/source/spec
/lux-r/target
-/lux-r/source/lux.lux
-/lux-r/source/lux
/lux-r/source/program
/lux-r/source/spec
diff --git a/documentation/bookmark/concurrency/lock_free_programming.md b/documentation/bookmark/concurrency/lock_free_programming.md
index 902dbb360..1ee123951 100644
--- a/documentation/bookmark/concurrency/lock_free_programming.md
+++ b/documentation/bookmark/concurrency/lock_free_programming.md
@@ -1,5 +1,6 @@
# Reference
+0. [Design and Implementation of Highly Scalable Quantifiable Data Structures in C++ - CppCon 2021](https://www.youtube.com/watch?v=ECWsLj0pgbI)
0. [Building a Lock-free Multi-producer, Multi-consumer Queue for Tcmalloc - Matt Kulukundis - CppCon 21](https://www.youtube.com/watch?v=_qaKkHuHYE0)
0. [Fear and Loathing in Lock-Free Programming](https://medium.com/@tylerneely/fear-and-loathing-in-lock-free-programming-7158b1cdd50c)
0. [Transactional Memory: Architectural Support for Lock-Free Data Structures](http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.491.1948&rep=rep1&type=pdf)
diff --git a/lux-php/source/lux.lux b/lux-php/source/lux.lux
deleted file mode 120000
index 73d05a22e..000000000
--- a/lux-php/source/lux.lux
+++ /dev/null
@@ -1 +0,0 @@
-/home/eduardoejp/lux/stdlib/source/lux.lux \ No newline at end of file
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))))))