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/test/lux/data/binary.lux | 261 +++++++++++++++++++------------ stdlib/source/test/lux/target/python.lux | 29 +++- 2 files changed, 191 insertions(+), 99 deletions(-) (limited to 'stdlib/source/test') 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 [ ] + [(_.cover [ ] + (let [bytes (i64.left_shifted 1) + binary (!.empty bytes) + cap (case bytes + 8 (-- 0) + _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) + capped_value (i64.and cap value) + + pre ( 0 binary) + _ ( 0 value binary) + post ( 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 -- cgit v1.2.3