From 3d457763e34d4dd1992427b3918b351ac684adb7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 1 Feb 2021 04:59:32 -0400 Subject: Improved compilation of loops and pattern-matching for Python. --- stdlib/source/test/aedifex/artifact/snapshot.lux | 4 +- .../aedifex/artifact/snapshot/version/value.lux | 66 ++++++++++++++++++++++ stdlib/source/test/aedifex/artifact/value.lux | 38 ------------- .../test/lux/control/concurrency/promise.lux | 11 +++- .../test/lux/control/concurrency/semaphore.lux | 17 ++++-- stdlib/source/test/lux/data/binary.lux | 23 ++++---- stdlib/source/test/lux/extension.lux | 7 ++- stdlib/source/test/lux/host.py.lux | 24 ++++++++ stdlib/source/test/lux/math.lux | 3 +- stdlib/source/test/lux/type.lux | 2 + stdlib/source/test/lux/type/quotient.lux | 60 ++++++++++++++++++++ 11 files changed, 194 insertions(+), 61 deletions(-) create mode 100644 stdlib/source/test/aedifex/artifact/snapshot/version/value.lux delete mode 100644 stdlib/source/test/aedifex/artifact/value.lux create mode 100644 stdlib/source/test/lux/host.py.lux create mode 100644 stdlib/source/test/lux/type/quotient.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index 371fde55e..192978ebf 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -16,7 +16,8 @@ ["#." build] ["#." time] ["#." stamp] - ["#." version]] + ["#." version + ["#/." value]]] {#program ["." /]}) @@ -47,4 +48,5 @@ $/time.test $/stamp.test $/version.test + $/version/value.test )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux new file mode 100644 index 000000000..dc3f754a2 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux @@ -0,0 +1,66 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] + [math + ["." random (#+ Random) ("#\." monad)] + [number + ["n" nat] + ["i" int]]] + [time + ["." instant]]] + ["$." /// #_ + ["#." stamp]] + {#program + ["." / + ["//#" /// + ["#." stamp] + ["#." time]]]}) + +(def: #export random + (Random /.Value) + ($_ random.and + (random.ascii/alpha 5) + (random.or (random\wrap []) + $///stamp.random) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Value]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [sample random + stamp $///stamp.random] + (let [version (get@ #/.version sample) + + local! + (text\= version + (/.format (set@ #/.snapshot #///.Local sample))) + + remote_format (/.format {#/.version (format version /.snapshot) + #/.snapshot (#///.Remote stamp)}) + remote! + (and (text.starts_with? (format version (///time.format (get@ #///stamp.time stamp))) + remote_format) + (text.ends_with? (%.nat (get@ #///stamp.build stamp)) + remote_format))] + (_.cover [/.snapshot /.format] + (and local! + remote!)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/value.lux b/stdlib/source/test/aedifex/artifact/value.lux deleted file mode 100644 index 10e9016b1..000000000 --- a/stdlib/source/test/aedifex/artifact/value.lux +++ /dev/null @@ -1,38 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - {[0 #spec] - [/ - ["$." equivalence]]}] - [control - ["." try ("#\." functor)] - [parser - ["<.>" text]]] - [math - ["." random (#+ Random)] - [number - ["n" nat] - ["i" int]]] - [time - ["." instant]]] - {#program - ["." /]}) - -(def: #export random - (Random /.Value) - ($_ random.and - (random.ascii/alpha 5) - random.instant - random.nat - )) - -(def: #export test - Test - (<| (_.covering /._) - (_.for [/.Build /.Value]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - ))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 7fc3196cd..ee6ad2b43 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["@" target] [abstract [monad (#+ do)] {[0 #spec] @@ -18,7 +19,8 @@ ["." random] [number ["n" nat] - ["i" int]]]] + ["i" int] + ["." i64]]]] {1 ["." / [// @@ -43,11 +45,16 @@ _ false)))))) +(def: delay + (for {@.js + (i64.left_shift 4 1)} + (i64.left_shift 3 1))) + (def: #export test Test (<| (_.covering /._) (do {! random.monad} - [to_wait (|> random.nat (\ ! map (|>> (n.% 10) (n.+ 10)))) + [to_wait (|> random.nat (\ ! map (|>> (n.% ..delay) (n.+ ..delay)))) expected random.nat dummy random.nat #let [not_dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 472e21c7d..729e986c2 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["@" target] [abstract ["." monad (#+ do)] ["." enum]] @@ -20,12 +21,18 @@ [math ["." random] [number - ["n" nat]]] + ["n" nat] + ["." i64]]] [type ["." refinement]]] {1 ["." /]}) +(def: delay + (for {@.js + (i64.left_shift 4 1)} + (i64.left_shift 3 1))) + (def: semaphore Test (_.for [/.Semaphore] @@ -34,7 +41,7 @@ [initial_open_positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do promise.monad - [result (promise.time_out 10 (/.wait semaphore))] + [result (promise.time_out ..delay (/.wait semaphore))] (_.cover' [/.semaphore] (case result (#.Some _) @@ -47,7 +54,7 @@ #let [semaphore (/.semaphore initial_open_positions)]] (wrap (do {! promise.monad} [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) - result (promise.time_out 10 (/.wait semaphore))] + result (promise.time_out ..delay (/.wait semaphore))] (_.cover' [/.wait] (case result (#.Some _) @@ -61,9 +68,9 @@ (wrap (do {! promise.monad} [_ (monad.map ! /.wait (list.repeat initial_open_positions semaphore)) #let [block (/.wait semaphore)] - result/0 (promise.time_out 10 block) + result/0 (promise.time_out ..delay block) open_positions (/.signal semaphore) - result/1 (promise.time_out 10 block)] + result/1 (promise.time_out ..delay block)] (_.cover' [/.signal] (case [result/0 result/1 open_positions] [#.None (#.Some _) (#try.Success +0)] diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 07c02ea09..89237babc 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -51,14 +51,15 @@ (#try.Success _) false)) -(def: (binary_io bytes read write value) +(def: (binary_io power read write value) (-> Nat (-> Nat Binary (Try Nat)) (-> Nat Nat Binary (Try Any)) Nat Bit) - (let [binary (/.create bytes) + (let [bytes (i64.left_shift power 1) + binary (/.create bytes) cap (case bytes 8 (dec 0) _ (|> 1 (i64.left_shift (n.* 8 bytes)) dec)) capped_value (i64.and cap value)] - (and (succeed + (and (..succeed (do try.monad [pre (read 0 binary) _ (write 0 value binary) @@ -104,23 +105,23 @@ (_.for [/.index_out_of_bounds] ($_ _.and (_.cover [/.read/8 /.write/8] - (..binary_io 1 /.read/8 /.write/8 value)) + (..binary_io 0 /.read/8 /.write/8 value)) (_.cover [/.read/16 /.write/16] - (..binary_io 2 /.read/16 /.write/16 value)) + (..binary_io 1 /.read/16 /.write/16 value)) (_.cover [/.read/32 /.write/32] - (..binary_io 4 /.read/32 /.write/32 value)) + (..binary_io 2 /.read/32 /.write/32 value)) (_.cover [/.read/64 /.write/64] - (..binary_io 8 /.read/64 /.write/64 value)))) + (..binary_io 3 /.read/64 /.write/64 value)))) (_.cover [/.slice] (let [slice_size (|> to (n.- from) inc) random_slice (try.assume (/.slice from to sample)) idxs (enum.range n.enum 0 (dec slice_size)) reader (function (_ binary idx) (/.read/8 idx binary))] (and (n.= slice_size (/.size random_slice)) - (case [(monad.map try.monad (reader random_slice) idxs) - (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)] - [(#try.Success slice_vals) (#try.Success binary_vals)] - (\ (list.equivalence n.equivalence) = slice_vals binary_vals) + (case [(monad.map try.monad (|>> (n.+ from) (reader sample)) idxs) + (monad.map try.monad (reader random_slice) idxs)] + [(#try.Success binary_vals) (#try.Success slice_vals)] + (\ (list.equivalence n.equivalence) = binary_vals slice_vals) _ #0)))) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 855c6e8bb..d032a47b5 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -3,7 +3,8 @@ ["." debug] ["@" target ["." jvm] - ["." js]] + ["." js] + ["." python]] [abstract [monad (#+ do)]] [control @@ -61,8 +62,8 @@ (wrap (for {@.jvm (row.row (#jvm.Constant (#jvm.LDC (#jvm.String self)))) - @.js - (js.string self)}))))) + @.js (js.string self) + @.python (python.unicode self)}))))) (for {@.old (as_is)} diff --git a/stdlib/source/test/lux/host.py.lux b/stdlib/source/test/lux/host.py.lux new file mode 100644 index 000000000..0b6cac81b --- /dev/null +++ b/stdlib/source/test/lux/host.py.lux @@ -0,0 +1,24 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try]] + [data + ["." text ("#\." equivalence)]] + [math + ["." random (#+ Random)] + [number + ["." nat] + ["." frac]]]] + {1 + ["." /]}) + +(def: #export test + Test + (do {! random.monad} + [] + (<| (_.covering /._) + (_.test "TBD" + true)))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index a140a736d..403205dad 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -21,7 +21,8 @@ ["#/." continuous] ["#/." fuzzy]]]) -(def: margin Frac +0.0000001) +(def: margin + +0.0000001) (def: (trigonometric_symmetry forward backward angle) (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 70b13a382..b1d205e4a 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -21,6 +21,7 @@ ["#." check] ["#." dynamic] ["#." implicit] + ["#." quotient] ["#." resource]]) (def: short @@ -169,5 +170,6 @@ /check.test /dynamic.test /implicit.test + /quotient.test /resource.test ))) diff --git a/stdlib/source/test/lux/type/quotient.lux b/stdlib/source/test/lux/type/quotient.lux new file mode 100644 index 000000000..ef19c6841 --- /dev/null +++ b/stdlib/source/test/lux/type/quotient.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence]]}] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat ("#\." equivalence)]]]] + {1 + ["." /]}) + +(def: #export (random class super) + (All [t c %] (-> (/.Class t c %) (Random t) (Random (/.Quotient t c %)))) + (\ random.monad map (/.quotient class) super)) + +(def: mod_10_class + (/.class (|>> (n.% 10) %.nat))) + +(def: Mod_10 + (/.type ..mod_10_class)) + +(def: #export test + Test + (<| (_.covering /._) + (do random.monad + [modulus (random.filter (n.> 0) random.nat) + #let [class (: (-> Nat Text) + (|>> (n.% modulus) %.nat))] + value random.nat] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence text.equivalence) + (..random (/.class class) random.nat))) + + (_.for [/.Class] + (_.cover [/.class] + (is? (: Any class) + (: Any (/.class class))))) + (_.for [/.Quotient] + ($_ _.and + (_.cover [/.quotient /.value /.label] + (let [quotient (/.quotient (/.class class) value)] + (and (is? value + (/.value quotient)) + (text\= (class value) + (/.label quotient))))) + (_.cover [/.type] + (exec + (: ..Mod_10 + (/.quotient ..mod_10_class value)) + true)) + )) + )))) -- cgit v1.2.3