diff options
| author | Eduardo Julian | 2022-08-18 03:13:52 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-08-18 03:13:52 -0400 |
| commit | 9d20deda529f590c3092ac24546ba31da3c8f643 (patch) | |
| tree | d82bdd08c43e08d4d76f5380802d2555589130bc /stdlib/source | |
| parent | 3b2d67a9679499b6ec9cbd781d2bf55396719136 (diff) | |
Added support for event-loop concurrency.
Diffstat (limited to 'stdlib/source')
12 files changed, 1545 insertions, 1326 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/event.lux b/stdlib/source/library/lux/control/concurrency/event.lux new file mode 100644 index 000000000..680bf50dd --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/event.lux @@ -0,0 +1,107 @@ +... https://en.wikipedia.org/wiki/Event_loop +(.require + [library + [lux (.except loop) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" io (.only IO)] + ["[0]" try (.only Try)] + ["[0]" exception (.only Exception)]] + [data + [text + ["%" \\format]] + [collection + ["[0]" list]]] + [math + [number + ["n" nat]]] + [world + [time + ["[0]" instant (.only Instant) (.use "[1]#[0]" order)] + ["[0]" duration]]]]] + [// + ["[0]" atom (.only Atom)]]) + +(def Action + (type_literal (IO Any))) + +(type Event + (Record + [#when Instant + #what Action])) + +(def Scheduler + (type_literal (-> Nat Action (IO Any)))) + +(def Loop + (type_literal (IO (Try Nat)))) + +(exception.def .public (error_during_execution [loop error]) + (Exception [Text Text]) + (exception.report + (list ["Loop" (%.text loop)] + ["Error" error]))) + +(def (execute! loop action) + (-> Text Action (Try Any)) + (when (try (io.run! action)) + {try.#Failure error} + (exception.except ..error_during_execution [loop error]) + + success + success)) + +(exception.def .public (already_started loop) + (Exception Text) + (exception.report + (list ["Loop" (%.text loop)]))) + +(def .public (loop name) + (-> Text [Scheduler Loop]) + (let [state (is (Atom [Bit (List Event)]) + (atom.atom [false (list)]))] + [(is Scheduler + (function (schedule! milli_seconds action) + (do io.monad + [now instant.now + _ (atom.update! (function (_ [stated? events]) + [stated? + (list.partial [#when (instant.after (duration.of_millis (.int milli_seconds)) + now) + #what action] + events)]) + state)] + (in [])))) + (is Loop + (.loop (retry! [_ []]) + (do [! io.monad] + [started?,events (atom.read! state) + .let [[started? events] started?,events]] + (if started? + (in (exception.except ..already_started [name])) + (do ! + [swapped? (atom.compare_and_swap! started?,events [true events] state)] + (if swapped? + (.loop (again [events_processed 0]) + (do ! + [started?,events (atom.read! state) + .let [[started? events] started?,events]] + (when events + ... And... we're done! + {.#End} + (in {try.#Success events_processed}) + + _ + (do ! + [now instant.now + .let [[pending ready] (list.partition (function (_ thread) + (instant#< (the #when thread) now)) + events)] + swapped? (atom.compare_and_swap! started?,events [started? pending] state)] + (if swapped? + (do [! (try.with !)] + [_ (monad.each ! (|>> (the #what) (..execute! name) io.io) ready)] + (again (n.+ (list.size ready) events_processed))) + (again events_processed)))))) + (retry! [])))))))])) diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index def0f230d..5b260b4ea 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -7,7 +7,6 @@ ["[0]" monad (.only do)]] [control ["[0]" try] - ["[0]" exception] ["[0]" io (.only IO io)]] [data ["[0]" text] @@ -22,9 +21,11 @@ ["[0]" configuration]] [world [time - ["[0]" instant]]]]] + ["[0]" instant (.only Instant) (.use "[1]#[0]" order)] + ["[0]" duration]]]]] [// - ["[0]" atom (.only Atom)]]) + ["[0]" atom (.only Atom)] + ["[0]" event]]) (with_expansions [<jvm> (these (ffi.import java/lang/Object "[1]::[0]") @@ -68,11 +69,7 @@ (start [] "io" "?" Any)) ... Default - (type Thread - (Record - [#creation Nat - #delay Nat - #action (IO Any)])) + (these) )) (def .public parallelism @@ -102,12 +99,9 @@ @.python (these) ... Default - (these (def started? - (Atom Bit) - (atom.atom false)) - (def runner - (Atom (List Thread)) - (atom.atom (list)))))) + (these (def schedule!,run! + (let [[module _] (symbol .._)] + (event.loop module)))))) (def (execute! action) (-> (IO Any) Any) @@ -147,13 +141,8 @@ (in [])) ... Default - (do [! io.monad] - [now (at ! each (|>> instant.millis .nat) instant.now) - _ (atom.update! (|>> {.#Item [#creation now - #delay milli_seconds - #action action]}) - ..runner)] - (in []))))) + (let [[schedule! run!] ..schedule!,run!] + (schedule! milli_seconds action))))) (for @.old (these) @.jvm (these) @@ -161,39 +150,15 @@ @.python (these) ... Default - (these (exception.def .public cannot_continue_running_threads) - - ... https://en.wikipedia.org/wiki/Event_loop - ... Starts the event-loop. - (def .public run! - (IO Any) - (do [! io.monad] - [started? (atom.read! ..started?)] - (if started? - (in []) - (do ! - [_ (atom.write! true ..started?)] - (loop (again [_ []]) - (do ! - [threads (atom.read! ..runner)] - (when threads - ... And... we're done! - {.#End} - (in []) - - _ - (do ! - [now (at ! each (|>> instant.millis .nat) instant.now) - .let [[ready pending] (list.partition (function (_ thread) - (|> (the #creation thread) - (n.+ (the #delay thread)) - (n.<= now))) - threads)] - swapped? (atom.compare_and_swap! threads pending ..runner)] - (if swapped? - (do ! - [_ (monad.each ! (|>> (the #action) ..execute! io.io) ready)] - (again [])) - (panic! (exception.error ..cannot_continue_running_threads [])))) - ))))))) - )) + (def .public run! + (IO Any) + (let [[schedule! run!] ..schedule!,run!] + (do io.monad + [outcome run!] + (when outcome + {try.#Success _} + (in []) + + {try.#Failure error} + (in (debug.log! error)))))) + ) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux index c475281e4..92811921c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux @@ -45,7 +45,7 @@ (all _.then (if initial? (_.define $binding binding) - (_.set $binding binding)) + (_.statement (_.set $binding binding))) body )) @@ -56,7 +56,7 @@ (let [variable (//when.register (n.+ offset register))] (if initial? (_.define variable (_.at (_.i32 (.int register)) $iteration)) - (_.set variable (_.at (_.i32 (.int register)) $iteration)))))) + (_.statement (_.set variable (_.at (_.i32 (.int register)) $iteration))))))) list.reversed (list#mix _.then body) (_.then (_.define $iteration (_.array bindings)))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux index 8848c781d..506287a9c 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux @@ -143,8 +143,8 @@ tuple)) (with_expansions [<recur> (these (all _.then - (_.set lefts (_.- last_index_right lefts)) - (_.set tuple (_.at last_index_right tuple))))] + (_.statement (_.set lefts (_.- last_index_right lefts))) + (_.statement (_.set tuple (_.at last_index_right tuple)))))] (runtime (tuple//left lefts tuple) (with_vars [last_index_right] @@ -182,9 +182,9 @@ (with_vars [tag is_last value] (_.closure (list tag is_last value) (all _.then - (_.set (_.the ..variant_tag_field @this) tag) - (_.set (_.the ..variant_flag_field @this) is_last) - (_.set (_.the ..variant_value_field @this) value) + (_.statement (_.set (_.the ..variant_tag_field @this) tag)) + (_.statement (_.set (_.the ..variant_flag_field @this) is_last)) + (_.statement (_.set (_.the ..variant_value_field @this) value)) ))))) (def .public (variant tag last? value) @@ -199,10 +199,10 @@ actual::value (|> sum (_.the ..variant_value_field)) is_last? (_.= ..unit actual::right?) recur! (all _.then - (_.set expected::lefts (|> expected::lefts - (_.- actual::lefts) - (_.- (_.i32 +1)))) - (_.set sum actual::value))] + (_.statement (_.set expected::lefts (|> expected::lefts + (_.- actual::lefts) + (_.- (_.i32 +1))))) + (_.statement (_.set sum actual::value)))] (<| (_.while (_.boolean true)) (_.if (_.= expected::lefts actual::lefts) (_.if (_.= expected::right? actual::right?) @@ -260,8 +260,8 @@ (..last_index inputs) (_.>= (_.i32 +0) idx) (_.-- idx) - (_.set output (..some (_.array (list (_.at idx inputs) - output))))) + (_.statement (_.set output (..some (_.array (list (_.at idx inputs) + output)))))) (_.return output)))) (def runtime//lux @@ -280,8 +280,8 @@ (with_vars [high low] (_.closure (list high low) (all _.then - (_.set (_.the ..i64_high_field @this) high) - (_.set (_.the ..i64_low_field @this) low) + (_.statement (_.set (_.the ..i64_high_field @this) high)) + (_.statement (_.set (_.the ..i64_low_field @this) low)) ))))) (def .public (i64 high low) @@ -308,7 +308,7 @@ (def (cap_shift! shift) (-> Var Statement) - (_.set shift (|> shift (_.bit_and (_.i32 +63))))) + (_.statement (_.set shift (|> shift (_.bit_and (_.i32 +63)))))) (def (no_shift! shift input) (-> Var Var (-> Expression Expression)) @@ -458,18 +458,18 @@ (_.define x16 (|> (high_16 x00) (_.+ l16) (_.+ r16))) - (_.set x00 (low_16 x00)) + (_.statement (_.set x00 (low_16 x00))) (_.define x32 (|> (high_16 x16) (_.+ l32) (_.+ r32))) - (_.set x16 (low_16 x16)) + (_.statement (_.set x16 (low_16 x16))) (_.define x48 (|> (high_16 x32) (_.+ l48) (_.+ r48) low_16)) - (_.set x32 (low_16 x32)) + (_.statement (_.set x32 (low_16 x32))) (_.return (..i64 (_.bit_or (up_16 x48) x32) (_.bit_or (up_16 x16) x00))) @@ -527,26 +527,28 @@ (_.define x00 (_.* l00 r00)) (_.define x16 (high_16 x00)) - (_.set x00 (low_16 x00)) + (_.statement (_.set x00 (low_16 x00))) - (_.set x16 (|> x16 (_.+ (_.* l16 r00)))) - (_.define x32 (high_16 x16)) (_.set x16 (low_16 x16)) - (_.set x16 (|> x16 (_.+ (_.* l00 r16)))) - (_.set x32 (|> x32 (_.+ (high_16 x16)))) (_.set x16 (low_16 x16)) - - (_.set x32 (|> x32 (_.+ (_.* l32 r00)))) - (_.define x48 (high_16 x32)) (_.set x32 (low_16 x32)) - (_.set x32 (|> x32 (_.+ (_.* l16 r16)))) - (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) - (_.set x32 (|> x32 (_.+ (_.* l00 r32)))) - (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) + (_.statement (_.set x16 (|> x16 (_.+ (_.* l16 r00))))) + (_.define x32 (high_16 x16)) + (_.statement (_.set x16 (|> x16 low_16 (_.+ (_.* l00 r16))))) + (_.statement (_.set x32 (|> x32 (_.+ (high_16 x16))))) + (_.statement (_.set x16 (low_16 x16))) + + (_.statement (_.set x32 (|> x32 (_.+ (_.* l32 r00))))) + (_.define x48 (high_16 x32)) + (_.statement (_.set x32 (|> x32 low_16 (_.+ (_.* l16 r16))))) + (_.statement (_.set x48 (|> x48 (_.+ (high_16 x32))))) + (_.statement (_.set x32 (|> x32 low_16 (_.+ (_.* l00 r32))))) + (_.statement (_.set x48 (|> x48 (_.+ (high_16 x32))))) + (_.statement (_.set x32 (low_16 x32))) - (_.set x48 (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - low_16)) + (_.statement (_.set x48 (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + low_16))) (_.return (..i64 (_.bit_or (up_16 x48) x32) (_.bit_or (up_16 x16) x00))) @@ -641,14 +643,14 @@ (i64::< approximate_remainder remainder)) (all _.then - (_.set approximate (_.- delta approximate)) - (_.set approximate_result approximate_result') - (_.set approximate_remainder approx_remainder))) - (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result) - i64::one - approximate_result) - result)) - (_.set remainder (i64::- approximate_remainder remainder)))))) + (_.statement (_.set approximate (_.- delta approximate))) + (_.statement (_.set approximate_result approximate_result')) + (_.statement (_.set approximate_remainder approx_remainder)))) + (_.statement (_.set result (i64::+ (_.? (i64::= i64::zero approximate_result) + i64::one + approximate_result) + result))) + (_.statement (_.set remainder (i64::- approximate_remainder remainder))))))) (_.return result))))) (runtime @@ -761,7 +763,7 @@ (runtime (js//set object field input) (all _.then - (_.set (_.at field object) input) + (_.statement (_.set (_.at field object) input)) (_.return object))) (runtime @@ -781,7 +783,7 @@ (runtime (array//write idx value array) (all _.then - (_.set (_.at (_.the ..i64_low_field idx) array) value) + (_.statement (_.set (_.at (_.the ..i64_low_field idx) array) value)) (_.return array))) (runtime diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux index 7487beb55..c7790d6d1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux @@ -140,7 +140,7 @@ (def restore_cursor! Statement - (_.set @cursor (|> @savepoint (_.do "pop" (list))))) + (_.statement (_.set @cursor (|> @savepoint (_.do "pop" (list)))))) (def fail_pm! _.break) @@ -154,8 +154,8 @@ [(def (<name> simple? idx) (-> Bit Nat Statement) (all _.then - (_.set @temp (//runtime.sum//get ..peek_cursor <flag> - (|> idx .int _.i32))) + (_.statement (_.set @temp (//runtime.sum//get ..peek_cursor <flag> + (|> idx .int _.i32)))) (.if simple? (_.when (_.= _.null @temp) ..fail_pm!) diff --git a/stdlib/source/library/lux/world/environment.lux b/stdlib/source/library/lux/world/environment.lux index 69d8dce95..31dafca6d 100644 --- a/stdlib/source/library/lux/world/environment.lux +++ b/stdlib/source/library/lux/world/environment.lux @@ -375,7 +375,7 @@ <default>) @.python (os/path::expanduser "~") @.lua (..run_command "~" "echo ~") - @.ruby (io.io (Dir::home)) + @.ruby (Dir::home) ... @.php (do io.monad ... [output (..getenv/1 ["HOME"])] ... (in (if (bit#= false (as Bit output)) @@ -409,7 +409,7 @@ (if (same? default on_windows) (..run_command default "pwd") (in on_windows))) - @.ruby (io.io (FileUtils::pwd)) + @.ruby (FileUtils::pwd) ... @.php (do io.monad ... [output (..getcwd [])] ... (in (if (bit#= false (as Bit output)) diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 16e205fe7..554d8c4f6 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -672,7 +672,7 @@ (def ruby_separator Text - (..RubyFile::SEPARATOR)) + (io.run! (..RubyFile::SEPARATOR))) (`` (def .public default (System IO) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 58528f019..08a1f75cd 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -6,1222 +6,1276 @@ [monad (.only do)]] [control ["[0]" io] - ["[0]" maybe (.use "[1]#[0]" functor)] - [concurrency - ["[0]" atom (.only Atom)]]] - [data - ["[0]" product] - ["[0]" bit (.use "[1]#[0]" equivalence)] - ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]] - [collection - ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)] - ["[0]" list (.use "[1]#[0]" functor) - ["[0]" property]]]] - ["[0]" math - ["[0]" random (.use "[1]#[0]" functor)] - [number - [i8 (.only)] - [i16 (.only)] - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac] - ["[0]" i64]]] - ["[0]" meta (.use "[1]#[0]" monad) - ["@" target] - ["[0]" static] - ["[0]" location (.use "[1]#[0]" equivalence)] - ["[0]" code (.use "[1]#[0]" equivalence) - ["<[1]>" \\parser]] - ["[0]" macro (.only) - [syntax (.only syntax)] - ["^" pattern] - ["[0]" template]]] - [test - ["_" property (.only Test)]]]] + ... ["[0]" maybe (.use "[1]#[0]" functor)] + ... [concurrency + ... ["[0]" atom (.only Atom)]] + ] + ... [data + ... ["[0]" product] + ... ["[0]" bit (.use "[1]#[0]" equivalence)] + ... ["[0]" text (.use "[1]#[0]" equivalence) + ... ["%" \\format (.only format)]] + ... [collection + ... ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)] + ... ["[0]" list (.use "[1]#[0]" functor) + ... ["[0]" property]]]] + ... ["[0]" math + ... ["[0]" random (.use "[1]#[0]" functor)] + ... [number + ... [i8 (.only)] + ... [i16 (.only)] + ... ["n" nat] + ... ["i" int] + ... ["r" rev] + ... ["f" frac] + ... ["[0]" i64]]] + ... ["[0]" meta (.use "[1]#[0]" monad) + ... ["@" target] + ... ["[0]" static] + ... ["[0]" location (.use "[1]#[0]" equivalence)] + ... ["[0]" code (.use "[1]#[0]" equivalence) + ... ["<[1]>" \\parser]] + ... ["[0]" macro (.only) + ... [syntax (.only syntax)] + ... ["^" pattern] + ... ["[0]" template]]] + ... [test + ... ["_" property (.only Test)]] + ]] ... TODO: Must have 100% coverage on tests. - ["[0]" / - ["[1][0]" abstract] - ["[1][0]" control] - ["[1][0]" data] - ["[1][0]" debug] - - ["[1][0]" documentation] - ["[1][0]" math] - - ["[1][0]" meta] - ["[1][0]" program] - ["[1][0]" test/property] - - ["[1][0]" world] - - ["[1][0]" ffi]]) - -(def for_bit - Test - (do random.monad - [expected random.nat - dummy random.nat] - (_.for [/.Bit /.if] - (all _.and - (_.coverage [/.false] - (n.= expected - (/.if /.false - dummy - expected))) - (_.coverage [/.true] - (n.= expected - (/.if /.true - expected - dummy))) - (_.coverage [/.or] - (and (not (/.or /.false /.false)) - (/.or /.false /.true) - (/.or /.true /.false) - (/.or /.true /.true))) - (_.coverage [/.and] - (and (not (/.and /.false /.false)) - (not (/.and /.false /.true)) - (not (/.and /.true /.false)) - (/.and /.true /.true))) - (_.coverage [/.not] - (and (bit#= /.true (/.not /.false)) - (bit#= /.false (/.not /.true)))) - (_.coverage [/.cond] - (and (n.= expected - (/.cond /.true - expected - - ... else - dummy)) - (n.= expected - (/.cond /.false - dummy - - ... else - expected)) - (n.= expected - (/.cond /.true - expected - - /.false - dummy - - ... else - dummy)) - (n.= expected - (/.cond /.false - dummy - - /.true - expected - - ... else - dummy)))) - )))) - -(def for_try - Test - (do random.monad - [expected_error (random.lower_case 5) - expected random.nat] - (all _.and - (_.coverage [/.try] - (when (/.try expected) - {.#Left _} - false - - {.#Right actual} - (n.= expected actual))) - (_.coverage [/.undefined] - (when (/.try (/.undefined)) - {.#Left _} - true - - {.#Right _} - false)) - (_.coverage [/.panic!] - (when (/.try (/.panic! expected_error)) - {.#Left actual_error} - (text.contains? expected_error actual_error) - - {.#Right _} - false)) - ))) - -(def for_list - Test - (do random.monad - [e/0 random.nat - e/1 random.nat - e/2 random.nat - e/3 random.nat] - (all _.and - (_.coverage [/.list] - (when (/.list e/0 e/1) - (/.list a/0 a/1) - (and (n.= e/0 a/0) - (n.= e/1 a/1)) - - _ - false)) - ))) - -(type (Returner a) - (/.Interface - (is (-> Any a) - return))) - -(def (global_returner value) - (All (_ a) (-> a (Returner a))) - (/.implementation - (def (return _) - value))) - -(def static_return 123) - -(/.use "global#[0]" (..global_returner ..static_return)) - -(def for_interface - Test - (do random.monad - [expected random.nat - .let [local_returner (is (Returner Nat) - (/.implementation - (def (return _) - expected)))]] - (_.for [/.Interface] - (all _.and - (_.coverage [/.implementation] - (n.= expected (at local_returner return []))) - (_.coverage [/.use] - (n.= static_return (global#return []))) - (_.coverage [/.open] - (let [(/.open "local#[0]") local_returner] - (n.= expected (local#return [])))) - (_.coverage [/.at] - (n.= expected (/.at local_returner return []))) - )))) - -(def for_module - Test - (all _.and - (let [[module short] (/.symbol .example)] - (_.coverage [/.symbol /.prelude] - (and (text#= /.prelude module) - (text#= short "example")))) - (let [[module short] (/.symbol ..example)] - (_.coverage [/.module_separator] - (and (text.contains? /.module_separator module) - (not (text.contains? /.module_separator short))))) - )) - -(def for_pipe - Test - (do random.monad - [start random.nat - factor random.nat - .let [expected (n.* factor (++ start))]] - (all _.and - (_.coverage [/.|>] - (n.= expected - (/.|> start ++ (n.* factor)))) - (_.coverage [/.|>>] - (n.= expected - ((/.|>> ++ (n.* factor)) start))) - (_.coverage [/.<|] - (n.= expected - (/.<| (n.* factor) ++ start))) - (_.coverage [/.<<|] - (n.= expected - ((/.<<| (n.* factor) ++) start))) - ))) - -(def example_symbol "YOLO") -(def i8 8) - -(def current_module - Text - (let [[module _] (symbol .._)] - module)) - -(def for_code/' - Test - (do random.monad - [example_nat random.nat] - (_.coverage [/.'] - (and (code#= (code.nat 0) (/.' 0)) - (code#= (code.int -1) (/.' -1)) - (code#= (code.rev .2) (/.' .2)) - (code#= (code.frac +3.4) (/.' +3.4)) - (code#= (code.text "5") (/.' "5")) - (code#= (code.symbol ["" "example_symbol"]) - (/.' example_symbol)) - (code#= (code.symbol [/.prelude "example_symbol"]) - (/.' .example_symbol)) - (code#= (code.symbol [..current_module "example_symbol"]) - (/.' ..example_symbol)) - (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) - (/.' (6 +7 .8))) - (code#= (code.variant (list (code.frac +9.0) - (code.text "9") - (code.symbol ["" "i8"]))) - (/.' {+9.0 "9" i8})) - (code#= (code.tuple (list (code.frac +9.0) - (code.text "9") - (code.symbol ["" "i8"]))) - (/.' [+9.0 "9" i8])) - (not (code#= (code.nat example_nat) - (/.' (, (code.nat example_nat))))) - )))) - -(def for_code/` - Test - (do random.monad - [example_nat random.nat] - (_.coverage [/.`] - (and (code#= (code.nat 0) (/.` 0)) - (code#= (code.int -1) (/.` -1)) - (code#= (code.rev .2) (/.` .2)) - (code#= (code.frac +3.4) (/.` +3.4)) - (code#= (code.text "5") (/.` "5")) - (code#= (code.symbol [..current_module "example_symbol"]) - (/.` example_symbol)) - (code#= (code.symbol [/.prelude "example_symbol"]) - (/.` .example_symbol)) - (code#= (code.symbol [..current_module "example_symbol"]) - (/.` ..example_symbol)) - (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) - (/.` (6 +7 .8))) - (code#= (code.variant (list (code.frac +9.0) - (code.text "9") - (code.symbol [..current_module "i8"]))) - (/.` {+9.0 "9" i8})) - (code#= (code.tuple (list (code.frac +9.0) - (code.text "9") - (code.symbol [..current_module "i8"]))) - (/.` [+9.0 "9" i8])) - (code#= (code.nat example_nat) - (/.` (, (code.nat example_nat)))))))) - -(def for_code/`' - Test - (do random.monad - [example_nat random.nat] - (_.coverage [/.`'] - (and (code#= (code.nat 0) (/.`' 0)) - (code#= (code.int -1) (/.`' -1)) - (code#= (code.rev .2) (/.`' .2)) - (code#= (code.frac +3.4) (/.`' +3.4)) - (code#= (code.text "5") (/.`' "5")) - (code#= (code.symbol ["" "example_symbol"]) - (/.`' example_symbol)) - (code#= (code.symbol [/.prelude "example_symbol"]) - (/.`' .example_symbol)) - (code#= (code.symbol [..current_module "example_symbol"]) - (/.`' ..example_symbol)) - (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) - (/.`' (6 +7 .8))) - (code#= (code.variant (list (code.frac +9.0) - (code.text "9") - (code.symbol ["" "i8"]))) - (/.`' {+9.0 "9" i8})) - (code#= (code.tuple (list (code.frac +9.0) - (code.text "9") - (code.symbol ["" "i8"]))) - (/.`' [+9.0 "9" i8])) - (code#= (code.nat example_nat) - (/.`' (, (code.nat example_nat)))))))) - -(def for_code - Test - (do [! random.monad] - [example (at ! each code.nat random.nat)] - (all _.and - (_.for [/.Code /.Code'] - (all _.and - ..for_code/' - ..for_code/` - ..for_code/`' - )) - (_.coverage [/.Ann] - (|> example - (the /.#meta) - (location#= location.dummy))) - ))) - -(def identity_macro - (/.macro (_ tokens) - (at meta.monad in tokens))) - -(def crosshair - "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") - -(def found_crosshair? - (macro (_ tokens lux) - (let [[_ _ source_code] (the .#source lux)] - {.#Right [lux (list (code.bit (text.contains? ..crosshair source_code)))]}))) - -(def for_macro - Test - (let [macro (is /.Macro' - (function (_ tokens lux) - {.#Right [lux (list)]}))] - (do random.monad - [expected random.nat] - (`` (`` (all _.and - (_.coverage [/.Macro'] - (|> macro - (is /.Macro') - (same? macro))) - (_.coverage [/.Macro] - (|> macro - "lux macro" - (is /.Macro) - (is Any) - (same? (is Any macro)))) - (_.coverage [/.macro] - (same? expected (..identity_macro expected))) - (,, (for @.old (,, (these)) - (_.coverage [/.Source] - (..found_crosshair?)))) - ... (_.coverage [/.require] - ... (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) - ... <alias> (static.random code.text (random.lower_case 1)) - ... <definition> (static.random code.local (random.lower_case 1)) - ... <module/0> (static.random code.text (random.lower_case 2)) - ... <module/0>' (template.symbol [<module/0>]) - ... <module/1> (static.random code.text (random.lower_case 3)) - ... <module/1>' (template.symbol [<module/1>]) - ... <module/2> (static.random code.text (random.lower_case 4)) - ... <module/2>' (template.symbol [<module/2>]) - ... <m0/1> (template.text [<module/0> "/" <module/1>]) - ... <//> (template.text [// <module/2>']) - ... <//>' (template.symbol [<//>]) - ... <\\> (template.text [\\ <module/2>']) - ... <\\>' (template.symbol [<\\>]) - ... <m0/2> (template.text [<module/0> "/" <module/2>]) - ... <m2/1> (template.text [<module/2> "/" <module/1>]) - ... <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) - ... <open/0> (template.text [<module/0> "#[0]"])] - ... (and (,, (with_template [<input> <module> <referrals>] - ... [(with_expansions [<input>' (macro.final <input>)] - ... (let [scenario (is (-> Any Bit) - ... (function (_ _) - ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - ... (`` (for @.python (when (' [<input>']) - ... (^.` [<module> - ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) - ... (,, (template.spliced <referrals>))]) - ... true - - ... _ - ... false) - ... (when (' [<input>']) - ... (^.` [<module> (,, (template.spliced <referrals>))]) - ... true - - ... _ - ... false)))))] - ... (scenario [])))] - - ... [(.require [<module/0>']) - ... ("lux def module" []) - ... []] - - ... [(.require [<alias> <module/0>' (.except)]) - ... ("lux def module" [[<module/0> <alias>]]) - ... [(<referral> <module/0> (.except))]] - - ... [(.require [<alias> <module/0>' (.only <definition>)]) - ... ("lux def module" [[<module/0> <alias>]]) - ... [(<referral> <module/0> (.only <definition>))]] - - ... [(.require [<alias> <module/0>' (.except <definition>)]) - ... ("lux def module" [[<module/0> <alias>]]) - ... [(<referral> <module/0> (.except <definition>))]] - - ... [(.require [<alias> <module/0>']) - ... ("lux def module" []) - ... []] - - ... [(.require [<module/0>' - ... [<alias> <module/1>']]) - ... ("lux def module" [[<m0/1> <alias>]]) - ... [(<referral> <m0/1>)]] - - ... [(.require ["[0]" <module/0>' - ... ["[0]" <module/1>']]) - ... ("lux def module" [[<module/0> <module/0>] - ... [<m0/1> <module/1>]]) - ... [(<referral> <module/0>) - ... (<referral> <m0/1>)]] - - ... [(.require ["[0]" <module/0>' - ... ["[1]" <module/1>']]) - ... ("lux def module" [[<m0/1> <module/0>]]) - ... [(<referral> <m0/1>)]] - - ... [(.require ["[0]" <module/0>' - ... ["[1]" <module/1>' - ... ["[2]" <module/2>']]]) - ... ("lux def module" [[<m0/1/2> <module/0>]]) - ... [(<referral> <m0/1/2>)]] - - ... [(.require [<module/0>' - ... ["[0]" <module/1>' - ... ["[0]" <//>']]]) - ... ("lux def module" [[<m0/1> <module/1>] - ... [<m0/2> <//>]]) - ... [(<referral> <m0/1>) - ... (<referral> <m0/2>)]] - - ... [(.require ["[0]" <module/0>' - ... [<module/1>' - ... ["[0]" <\\>']]]) - ... ("lux def module" [[<module/0> <module/0>] - ... [<m2/1> <\\>]]) - ... [(<referral> <module/0>) - ... (<referral> <m2/1>)]] - - ... [(.require ["[0]" <module/0>' (.use "[1]#[0]" <definition>)]) - ... ("lux def module" [[<module/0> <module/0>]]) - ... [(<referral> <module/0> (<open/0> <definition>))]] - ... )))))) - )))))) - -(/.type for_type/variant - (Variant - {#Case/0} - {#Case/1 Nat} - {#Case/2 Int Text})) - -(/.type for_type/record - (Record - [#slot/0 Bit - #slot/1 Rev])) - -(/.type (for_type/all parameter) - [parameter parameter]) - -(def for_type - Test - (do [! random.monad] - [expected random.nat - - expected_left random.nat - expected_right random.nat - - .let [existential_type (at ! each (|>> {.#Ex}) random.nat)] - expected/0 existential_type - expected/1 existential_type] - (<| (_.for [/.Type]) - (all _.and - (_.coverage [/.is] - (|> expected - (/.is Any) - (same? (/.is Any expected)))) - (_.coverage [/.as] - (|> expected - (/.is Any) - (/.as /.Nat) - (same? expected))) - (_.coverage [/.as_expected] - (|> expected - (/.is Any) - /.as_expected - (/.is /.Nat) - (same? expected))) - (_.coverage [/.type_of] - (same? /.Nat (/.type_of expected))) - (_.coverage [/.Primitive] - (when (/.Primitive "foo" [expected/0 expected/1]) - {.#Primitive "foo" (list actual/0 actual/1)} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false)) - (_.coverage [/.type_literal] - (and (when (/.type_literal [expected/0 expected/1]) - {.#Product actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (/.Or expected/0 expected/1)) - {.#Sum actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (-> expected/0 expected/1)) - {.#Function actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (when (/.type_literal (expected/0 expected/1)) - {.#Apply actual/1 actual/0} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false))) - (_.coverage [/.type] - (exec - (is /.Type ..for_type/variant) - (is /.Type ..for_type/record) - (is /.Type ..for_type/all) - true)) - (_.coverage [/.Variant] - (exec - (is for_type/variant - {#Case/1 expected_left}) - true)) - (_.coverage [/.Record] - (exec - (is for_type/record - [#slot/0 (n.= expected_left expected_right) - #slot/1 (.rev expected_right)]) - true)) - )))) - -(def for_i64 - Test - (do random.monad - [expected random.i64] - (all _.and - (_.coverage [/.i64] - (same? (is Any expected) - (is Any (/.i64 expected)))) - (_.coverage [/.nat] - (same? (is Any expected) - (is Any (/.nat expected)))) - (_.coverage [/.int] - (same? (is Any expected) - (is Any (/.int expected)))) - (_.coverage [/.rev] - (same? (is Any expected) - (is Any (/.rev expected)))) - (_.coverage [/.++] - (n.= 1 (n.- expected - (/.++ expected)))) - (_.coverage [/.--] - (n.= 1 (n.- (/.-- expected) - expected))) - ))) - -(def for_function - Test - (do random.monad - [expected_left random.nat - expected_right random.nat] - (_.coverage [/.-> /.function] - (and (let [actual (is (/.-> Nat Nat Nat) - (/.function (_ actual_left actual_right) - (n.* (++ actual_left) (-- actual_right))))] - (n.= (n.* (++ expected_left) (-- expected_right)) - (actual expected_left expected_right))) - (let [actual (is (/.-> [Nat Nat] Nat) - (/.function (_ [actual_left actual_right]) - (n.* (++ actual_left) (-- actual_right))))] - (n.= (n.* (++ expected_left) (-- expected_right)) - (actual [expected_left expected_right]))))))) - -(def !n/+ - (/.template (_ <left> <right>) - [(n.+ <left> <right>)])) - -(def for_template - Test - (`` (all _.and - (_.coverage [/.with_template] - (let [bits (list (,, (/.with_template [_] - [true] - - [0] [1] [2] - )))] - (and (n.= 3 (list.size bits)) - (list.every? (bit#= true) bits)))) - (do random.monad - [left random.nat - right random.nat] - (_.coverage [/.template] - (n.= (n.+ left right) - (!n/+ left right)))) - ))) - -(def option/0 "0") -(def option/1 "1") -(def static_char "@") - -(def for_static - Test - (do random.monad - [sample (random.either (in option/0) - (in option/1))] - (all _.and - (_.coverage [/.static] - (when sample - (/.static option/0) true - (/.static option/1) true - _ false)) - (_.coverage [/.char] - (|> (`` (/.char (,, (/.static static_char)))) - text.of_char - (text#= static_char))) - ))) - -(type Small - (Record - [#small_left Nat - #small_right Text])) - -(type Big - (Record - [#big_left Nat - #big_right Small])) - -(def for_slot - Test - (do random.monad - [start/s random.nat - start/b random.nat - shift/s random.nat - shift/b random.nat - text (random.lower_case 1) - .let [expected/s (n.+ shift/s start/s) - expected/b (n.+ shift/b start/b) - - sample [#big_left start/b - #big_right [#small_left start/s - #small_right text]]]] - (all _.and - (_.coverage [/.the] - (and (and (|> sample - (/.the #big_left) - (same? start/b)) - (|> sample - ((/.the #big_left)) - (same? start/b))) - (and (|> sample - (/.the [#big_right #small_left]) - (same? start/s)) - (|> sample - ((/.the [#big_right #small_left])) - (same? start/s))))) - (_.coverage [/.has] - (and (and (|> sample - (/.has #big_left shift/b) - (/.the #big_left) - (same? shift/b)) - (|> sample - ((/.has #big_left shift/b)) - (/.the #big_left) - (same? shift/b)) - (|> sample - ((/.has #big_left) shift/b) - (/.the #big_left) - (same? shift/b))) - (and (|> sample - (/.has [#big_right #small_left] shift/s) - (/.the [#big_right #small_left]) - (same? shift/s)) - (|> sample - ((/.has [#big_right #small_left] shift/s)) - (/.the [#big_right #small_left]) - (same? shift/s)) - (|> sample - ((/.has [#big_right #small_left]) shift/s) - (/.the [#big_right #small_left]) - (same? shift/s))))) - (_.coverage [/.revised] - (and (and (|> sample - (/.revised #big_left (n.+ shift/b)) - (/.the #big_left) - (n.= expected/b)) - (|> sample - ((/.revised #big_left (n.+ shift/b))) - (/.the #big_left) - (n.= expected/b)) - (|> sample - ((is (-> (-> Nat Nat) (-> Big Big)) - (/.revised #big_left)) - (n.+ shift/b)) - (/.the #big_left) - (n.= expected/b))) - (and (|> sample - (/.revised [#big_right #small_left] (n.+ shift/s)) - (/.the [#big_right #small_left]) - (n.= expected/s)) - (|> sample - ((/.revised [#big_right #small_left] (n.+ shift/s))) - (/.the [#big_right #small_left]) - (n.= expected/s)) - (|> sample - ((is (-> (-> Nat Nat) (-> Big Big)) - (/.revised [#big_right #small_left])) - (n.+ shift/s)) - (/.the [#big_right #small_left]) - (n.= expected/s))))) - ))) - -(def for_associative - Test - (do random.monad - [left (random.lower_case 1) - mid (random.lower_case 1) - right (random.lower_case 1) - .let [expected (text.interposed "" (list left mid right))]] - (_.coverage [/.all /.left] - (with_expansions [<left_association> (/.left format - left - mid - right) - <right_association> (/.all format - left - mid - right)] - (and (text#= <left_association> - <right_association>) - (not (code#= (' <left_association>) - (' <right_association>)))))))) - -(def for_expansion - Test - (do random.monad - [left random.nat - right random.nat - dummy random.nat - .let [expected (n.+ left right)]] - (all _.and - (_.coverage [/.these] - (`` (and (,, (these true - true - true))))) - (_.coverage [/.with_expansions] - (/.with_expansions [<operands> (these left right)] - (n.= expected - (n.+ <operands>)))) - (_.coverage [/.comment] - (/.with_expansions [<dummy> (/.comment dummy) - <operands> (these left right)] - (n.= expected - (all n.+ <operands> <dummy>)))) - (_.coverage [/.``] - (n.= expected - (/.`` (all n.+ - (,, (these left right)) - (,, (/.comment dummy)))))) - (_.coverage [/.for] - (and (n.= expected - (/.for "fake host" dummy - expected)) - (n.= expected - (/.for @.old expected - @.jvm expected - @.js expected - @.python expected - @.lua expected - @.ruby expected - @.php expected - dummy)))) - ))) - -(def for_value - Test - (do random.monad - [left random.nat - right (random.lower_case 1) - - item/0 random.nat - item/1 random.nat - item/2 random.nat] - (all _.and - (_.coverage [/.Either] - (and (exec - (is (/.Either Nat Text) - {.#Left left}) - true) - (exec - (is (/.Either Nat Text) - {.#Right right}) - true))) - (_.coverage [/.Any] - (and (exec - (is /.Any - left) - true) - (exec - (is /.Any - right) - true))) - (_.coverage [/.Nothing] - (and (exec - (is (-> /.Any /.Nothing) - (function (_ _) - (undefined))) - true) - (exec - (is (-> /.Any /.Int) - (function (_ _) - (is /.Int (undefined)))) - true))) - (_.for [/.__adjusted_quantified_type__] - (all _.and - (_.coverage [/.All] - (let [identity (is (/.All (_ a) (-> a a)) - (|>>))] - (and (exec - (is Nat - (identity left)) - true) - (exec - (is Text - (identity right)) - true)))) - (_.coverage [/.Ex] - (let [hide (is (/.Ex (_ a) (-> Nat a)) - (|>>))] - (exec - (is /.Any - (hide left)) - true))))) - (_.coverage [/.same?] - (let [not_left (atom.atom left) - left (atom.atom left)] - (and (/.same? left left) - (/.same? not_left not_left) - (not (/.same? left not_left))))) - (_.coverage [/.Rec] - (let [list (is (/.Rec NList - (Maybe [Nat NList])) - {.#Some [item/0 - {.#Some [item/1 - {.#Some [item/2 - {.#None}]}]}]})] - (when list - {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} - (and (same? item/0 actual/0) - (same? item/1 actual/1) - (same? item/2 actual/2)) - - _ - false))) - ))) - -(type (Pair l r) - (Record - [#left l - #right r])) - -(def !pair - (template (_ <left> <right>) - [[..#left <left> - ..#right <right>]])) - -(def for_when - Test - (do [! random.monad] - [expected_nat (at ! each (n.% 1) random.nat) - expected_int (at ! each (i.% +1) random.int) - expected_rev (random.either (in .5) - (in .25)) - expected_frac (random.either (in +0.5) - (in +1.25)) - expected_text (random.either (in "+0.5") - (in "+1.25"))] - (all _.and - (_.coverage [/.when] - (and (/.when expected_nat - 0 true - _ false) - (/.when expected_int - +0 true - _ false) - (/.when expected_rev - .5 true - .25 true - _ false) - (/.when expected_frac - +0.5 true - +1.25 true - _ false) - (/.when expected_text - "+0.5" true - "+1.25" true - _ false) - (/.when [expected_nat expected_int] - [0 +0] true - _ false) - (/.when [..#left expected_nat ..#right expected_int] - [..#left 0 ..#right +0] true - _ false) - (/.when (is (Either Nat Int) {.#Left expected_nat}) - {.#Left 0} true - _ false) - (/.when (is (Either Nat Int) {.#Right expected_int}) - {.#Right +0} true - _ false) - )) - ... (_.coverage [/.pattern] - ... (/.when [..#left expected_nat ..#right expected_int] - ... (!pair 0 +0) - ... true - - ... _ - ... false)) - (_.coverage [/.let] - (and (/.let [actual_nat expected_nat] - (/.same? expected_nat actual_nat)) - (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] - (and (/.same? expected_nat actual_left) - (/.same? expected_int actual_right))))) - ))) - -(def for_control_flow - Test - (all _.and - (do random.monad - [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) - iterations (random#each (n.% 10) random.nat) - .let [expected (n.* factor iterations)]] - (_.coverage [/.loop] - (n.= expected - (/.loop (again [counter 0 - value 0]) - (if (n.< iterations counter) - (again (++ counter) (n.+ factor value)) - value))))) - (do random.monad - [pre random.nat - post (random.only (|>> (n.= pre) not) random.nat) - .let [box (atom.atom pre)]] - (_.coverage [/.exec] - (and (same? pre (io.run! (atom.read! box))) - (/.exec - (io.run! (atom.write! post box)) - (same? post (io.run! (atom.read! box))))))) - )) - -(def identity/constant - (All (_ a) (-> a a)) - (function (_ value) - value)) - -(def (identity/function value) - (All (_ a) (-> a a)) - value) - -(def for_def - Test - (do random.monad - [expected random.nat] - (_.coverage [/.def] - (and (same? expected (identity/constant expected)) - (same? expected (identity/function expected)))))) - -(def possible_targets - (Set @.Target) - (<| (set.of_list text.hash) - (list @.old - @.js - @.jvm - @.lua - @.python - @.ruby))) - -(def for_meta|Info - (syntax (_ []) - (function (_ lux) - (let [info (the .#info lux) - - conforming_target! - (set.member? ..possible_targets (the .#target info)) - - compiling! - (when (the .#mode info) - {.#Build} true - _ false)] - {.#Right [lux (list (code.bit (and conforming_target! - compiling!)))]})))) - -(def for_meta|Module_State - (syntax (_ []) - (do meta.monad - [prelude (meta.module .prelude)] - (in (list (code.bit (when (the .#module_state prelude) - {.#Active} false - _ true))))))) - -(def for_meta - Test - (all _.and - (_.coverage [/.Mode /.Info] - (for_meta|Info)) - (_.coverage [/.Module_State] - (for_meta|Module_State)) - )) - -(def for_export - Test - (all _.and - (_.coverage [/.public /.private] - (and /.public (not /.private))) - (_.coverage [/.global /.local] - (and (bit#= /.public /.global) - (bit#= /.private /.local))) - )) - -(for @.old (these) - (these (def for_bindings|test - (syntax (_ lux_state - [fn/0 <code>.local - var/0 <code>.local - let/0 <code>.local - - fn/1 <code>.local - var/1 <code>.local - let/1 <code>.local - - fn/2 <code>.local - var/2 <code>.local - let/2 <code>.local - - let/3 <code>.local]) - (in (list (code.bit (when (the .#scopes lux_state) - (list.partial scope/2 _) - (let [locals/2 (the .#locals scope/2) - expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 - let/3)) - actual_locals/2 (|> locals/2 - (the .#mappings) - (list#each product.left) - (set.of_list text.hash)) - - correct_locals! - (and (n.= 4 (the .#counter locals/2)) - (set#= expected_locals/2 - actual_locals/2)) - - captured/2 (the .#captured scope/2) - - local? (is (-> Ref Bit) - (function (_ ref) - (when ref - {.#Local _} true - {.#Captured _} false))) - captured? (is (-> Ref Bit) - (|>> local? not)) - binding? (is (-> (-> Ref Bit) Text Bit) - (function (_ is? name) - (|> captured/2 - (the .#mappings) - (property.value name) - (maybe#each (|>> product.right is?)) - (maybe.else false)))) - - correct_closure! - (and (n.= 6 (the .#counter captured/2)) - (binding? local? fn/1) - (binding? local? var/1) - (binding? local? let/1) - (binding? captured? fn/0) - (binding? captured? var/0) - (binding? captured? let/0))] - (and correct_locals! - correct_closure!)) - - _ - false)))))) - - (def for_bindings - Test - ((<| (template.with_locals [fn/0 var/0 let/0 - fn/1 var/1 let/1 - fn/2 var/2 let/2 - let/3]) - (function (fn/0 var/0)) (let [let/0 123]) - (function (fn/1 var/1)) (let [let/1 456]) - (function (fn/2 var/2)) (let [let/2 789]) - (let [let/3 [fn/0 var/0 let/0 - fn/1 var/1 let/1 - fn/2 var/2 let/2] - verdict (for_bindings|test fn/0 var/0 let/0 - fn/1 var/1 let/1 - fn/2 var/2 let/2 - let/3)] - (_.coverage [/.Bindings /.Ref] - verdict))) - 0 1 2)))) - -(def test|lux - Test - (`` (`` (all _.and - ..for_bit - ... ..for_try - ... ..for_list - ... ..for_interface - ... ..for_module - ... ..for_pipe - ... ..for_code - ... ..for_macro - ... ..for_type - ... ..for_i64 - ... ..for_function - ... ..for_template - ... ..for_static - ... ..for_slot - ... ..for_associative - ... ..for_expansion - ... ..for_value - ... ..for_when - ... ..for_control_flow - ... ..for_def - ... ..for_meta - ... ..for_export - ... (,, (for @.old (,, (these)) - ... (,, (these ..for_bindings)))) - )))) - -(def test - Test - (<| (_.covering /._) - (_.in_parallel - (list ..test|lux - - ... /abstract.test - ... /control.test - ... /data.test - ... /debug.test - - ... /documentation.test - ... /math.test - - ... /meta.test - ... /program.test - ... /test/property.test - - ... /world.test - - ... /ffi.test - )))) + ... ["[0]" / + ... ["[1][0]" abstract] + ... ["[1][0]" control] + ... ["[1][0]" data] + ... ["[1][0]" debug] + + ... ["[1][0]" documentation] + ... ["[1][0]" math] + + ... ["[1][0]" meta] + ... ["[1][0]" program] + ... ["[1][0]" test/property] + + ... ["[1][0]" world] + + ... ["[1][0]" ffi]] + ) + +... (def for_bit +... Test +... (do random.monad +... [expected random.nat +... dummy random.nat] +... (_.for [/.Bit /.if] +... (all _.and +... (_.coverage [/.false] +... (n.= expected +... (/.if /.false +... dummy +... expected))) +... (_.coverage [/.true] +... (n.= expected +... (/.if /.true +... expected +... dummy))) +... (_.coverage [/.or] +... (and (not (/.or /.false /.false)) +... (/.or /.false /.true) +... (/.or /.true /.false) +... (/.or /.true /.true))) +... (_.coverage [/.and] +... (and (not (/.and /.false /.false)) +... (not (/.and /.false /.true)) +... (not (/.and /.true /.false)) +... (/.and /.true /.true))) +... (_.coverage [/.not] +... (and (bit#= /.true (/.not /.false)) +... (bit#= /.false (/.not /.true)))) +... (_.coverage [/.cond] +... (and (n.= expected +... (/.cond /.true +... expected + +... ... else +... dummy)) +... (n.= expected +... (/.cond /.false +... dummy + +... ... else +... expected)) +... (n.= expected +... (/.cond /.true +... expected + +... /.false +... dummy + +... ... else +... dummy)) +... (n.= expected +... (/.cond /.false +... dummy + +... /.true +... expected + +... ... else +... dummy)))) +... )))) + +... (def for_try +... Test +... (do random.monad +... [expected_error (random.lower_case 5) +... expected random.nat] +... (all _.and +... (_.coverage [/.try] +... (when (/.try expected) +... {.#Left _} +... false + +... {.#Right actual} +... (n.= expected actual))) +... (_.coverage [/.undefined] +... (when (/.try (/.undefined)) +... {.#Left _} +... true + +... {.#Right _} +... false)) +... (_.coverage [/.panic!] +... (when (/.try (/.panic! expected_error)) +... {.#Left actual_error} +... (text.contains? expected_error actual_error) + +... {.#Right _} +... false)) +... ))) + +... (def for_list +... Test +... (do random.monad +... [e/0 random.nat +... e/1 random.nat +... e/2 random.nat +... e/3 random.nat] +... (all _.and +... (_.coverage [/.list] +... (when (/.list e/0 e/1) +... (/.list a/0 a/1) +... (and (n.= e/0 a/0) +... (n.= e/1 a/1)) + +... _ +... false)) +... ))) + +... (type (Returner a) +... (/.Interface +... (is (-> Any a) +... return))) + +... (def (global_returner value) +... (All (_ a) (-> a (Returner a))) +... (/.implementation +... (def (return _) +... value))) + +... (def static_return 123) + +... (/.use "global#[0]" (..global_returner ..static_return)) + +... (def for_interface +... Test +... (do random.monad +... [expected random.nat +... .let [local_returner (is (Returner Nat) +... (/.implementation +... (def (return _) +... expected)))]] +... (_.for [/.Interface] +... (all _.and +... (_.coverage [/.implementation] +... (n.= expected (at local_returner return []))) +... (_.coverage [/.use] +... (n.= static_return (global#return []))) +... (_.coverage [/.open] +... (let [(/.open "local#[0]") local_returner] +... (n.= expected (local#return [])))) +... (_.coverage [/.at] +... (n.= expected (/.at local_returner return []))) +... )))) + +... (def for_module +... Test +... (all _.and +... (let [[module short] (/.symbol .example)] +... (_.coverage [/.symbol /.prelude] +... (and (text#= /.prelude module) +... (text#= short "example")))) +... (let [[module short] (/.symbol ..example)] +... (_.coverage [/.module_separator] +... (and (text.contains? /.module_separator module) +... (not (text.contains? /.module_separator short))))) +... )) + +... (def for_pipe +... Test +... (do random.monad +... [start random.nat +... factor random.nat +... .let [expected (n.* factor (++ start))]] +... (all _.and +... (_.coverage [/.|>] +... (n.= expected +... (/.|> start ++ (n.* factor)))) +... (_.coverage [/.|>>] +... (n.= expected +... ((/.|>> ++ (n.* factor)) start))) +... (_.coverage [/.<|] +... (n.= expected +... (/.<| (n.* factor) ++ start))) +... (_.coverage [/.<<|] +... (n.= expected +... ((/.<<| (n.* factor) ++) start))) +... ))) + +... (def example_symbol "YOLO") +... (def i8 8) + +... (def current_module +... Text +... (let [[module _] (symbol .._)] +... module)) + +... (def for_code/' +... Test +... (do random.monad +... [example_nat random.nat] +... (_.coverage [/.' /.literal_quote] +... (and (code#= (code.nat 0) (/.' 0)) +... (code#= (code.int -1) (/.' -1)) +... (code#= (code.rev .2) (/.' .2)) +... (code#= (code.frac +3.4) (/.' +3.4)) +... (code#= (code.text "5") (/.' "5")) +... (code#= (code.symbol ["" "example_symbol"]) +... (/.' example_symbol)) +... (code#= (code.symbol [/.prelude "example_symbol"]) +... (/.' .example_symbol)) +... (code#= (code.symbol [..current_module "example_symbol"]) +... (/.' ..example_symbol)) +... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) +... (/.' (6 +7 .8))) +... (code#= (code.variant (list (code.frac +9.0) +... (code.text "9") +... (code.symbol ["" "i8"]))) +... (/.' {+9.0 "9" i8})) +... (code#= (code.tuple (list (code.frac +9.0) +... (code.text "9") +... (code.symbol ["" "i8"]))) +... (/.' [+9.0 "9" i8])) +... )))) + +... (def for_code/` +... Test +... (do random.monad +... [example_nat random.nat] +... (_.coverage [/.` /.syntax_quote] +... (and (code#= (code.nat 0) (/.` 0)) +... (code#= (code.int -1) (/.` -1)) +... (code#= (code.rev .2) (/.` .2)) +... (code#= (code.frac +3.4) (/.` +3.4)) +... (code#= (code.text "5") (/.` "5")) +... (code#= (code.symbol [..current_module "example_symbol"]) +... (/.` example_symbol)) +... (code#= (code.symbol [/.prelude "example_symbol"]) +... (/.` .example_symbol)) +... (code#= (code.symbol [..current_module "example_symbol"]) +... (/.` ..example_symbol)) +... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) +... (/.` (6 +7 .8))) +... (code#= (code.variant (list (code.frac +9.0) +... (code.text "9") +... (code.symbol [..current_module "i8"]))) +... (/.` {+9.0 "9" i8})) +... (code#= (code.tuple (list (code.frac +9.0) +... (code.text "9") +... (code.symbol [..current_module "i8"]))) +... (/.` [+9.0 "9" i8])) +... )))) + +... (def for_code/`' +... Test +... (do random.monad +... [example_nat random.nat] +... (_.coverage [/.`' /.partial_quote] +... (and (code#= (code.nat 0) (/.`' 0)) +... (code#= (code.int -1) (/.`' -1)) +... (code#= (code.rev .2) (/.`' .2)) +... (code#= (code.frac +3.4) (/.`' +3.4)) +... (code#= (code.text "5") (/.`' "5")) +... (code#= (code.symbol ["" "example_symbol"]) +... (/.`' example_symbol)) +... (code#= (code.symbol [/.prelude "example_symbol"]) +... (/.`' .example_symbol)) +... (code#= (code.symbol [..current_module "example_symbol"]) +... (/.`' ..example_symbol)) +... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) +... (/.`' (6 +7 .8))) +... (code#= (code.variant (list (code.frac +9.0) +... (code.text "9") +... (code.symbol ["" "i8"]))) +... (/.`' {+9.0 "9" i8})) +... (code#= (code.tuple (list (code.frac +9.0) +... (code.text "9") +... (code.symbol ["" "i8"]))) +... (/.`' [+9.0 "9" i8])) +... )))) + +... (def for_code +... Test +... (do [! random.monad] +... [example (at ! each code.nat random.nat) +... example_bit random.bit +... example_nat random.nat +... example_int random.int] +... (all _.and +... (_.for [/.Code /.Code'] +... (all _.and +... ..for_code/' +... ..for_code/` +... ..for_code/`' +... )) +... (_.coverage [/.Ann] +... (|> example +... (the /.#meta) +... (location#= location.dummy))) +... (_.for [/.UnQuote] +... (all _.and +... (_.coverage [/.unquote_macro] +... (exec +... (is /.Macro' +... (/.unquote_macro /.,)) +... (is /.Macro' +... (/.unquote_macro /.,')) +... true)) +... (_.coverage [/.unquote] +... (exec +... (is /.UnQuote +... (/.unquote ("lux macro" (/.unquote_macro /.,)))) +... (is /.UnQuote +... (/.unquote ("lux macro" (/.unquote_macro /.,')))) +... true)) +... (_.coverage [/., /.but] +... (with_expansions [<nat> (code.nat example_nat)] +... (and (not (code#= <nat> +... (/.' (/., <nat>)))) +... (code#= <nat> +... (/.` (/., <nat>))) +... (code#= <nat> +... (/.`' (/., <nat>)))))) +... (_.coverage [/.,* /.also] +... (with_expansions [<bit> (code.bit example_bit) +... <nat> (code.nat example_nat) +... <int> (code.int example_int) +... <expected> (code.tuple (list <bit> <nat> <int>)) +... <actual> [(/.,* (list <bit> <nat> <int>))]] +... (and (not (code#= <expected> +... (/.' <actual>))) +... (code#= <expected> +... (/.` <actual>)) +... (code#= <expected> +... (/.`' <actual>))))) +... (_.coverage [/.,' /.literally] +... (with_expansions [<bit> (code.bit example_bit) +... <nat> (code.nat example_nat) +... <int> (code.int example_int) +... <expected> (/.' [(list <bit> <nat> <int>)]) +... <actual> [(/.,' (list <bit> <nat> <int>))]] +... (and (not (code#= <expected> +... (/.' <actual>))) +... (code#= <expected> +... (/.` <actual>)) +... (code#= <expected> +... (/.`' <actual>))))) +... )) +... ))) + +... (def identity_macro +... (/.macro (_ tokens) +... (at meta.monad in tokens))) + +... (def crosshair +... "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") + +... (def found_crosshair? +... (macro (_ tokens lux) +... (let [[_ _ source_code] (the .#source lux)] +... {.#Right [lux (list (code.bit (text.contains? ..crosshair source_code)))]}))) + +... (def for_macro +... Test +... (let [macro (is /.Macro' +... (function (_ tokens lux) +... {.#Right [lux (list)]}))] +... (do random.monad +... [expected random.nat] +... (`` (`` (all _.and +... (_.coverage [/.Macro'] +... (|> macro +... (is /.Macro') +... (same? macro))) +... (_.coverage [/.Macro] +... (|> macro +... "lux macro" +... (is /.Macro) +... (is Any) +... (same? (is Any macro)))) +... (_.coverage [/.macro] +... (same? expected (..identity_macro expected))) +... (,, (for @.old (,, (these)) +... (_.coverage [/.Source] +... (..found_crosshair?)))) +... ... (_.coverage [/.require] +... ... (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) +... ... <alias> (static.random code.text (random.lower_case 1)) +... ... <definition> (static.random code.local (random.lower_case 1)) +... ... <module/0> (static.random code.text (random.lower_case 2)) +... ... <module/0>' (template.symbol [<module/0>]) +... ... <module/1> (static.random code.text (random.lower_case 3)) +... ... <module/1>' (template.symbol [<module/1>]) +... ... <module/2> (static.random code.text (random.lower_case 4)) +... ... <module/2>' (template.symbol [<module/2>]) +... ... <m0/1> (template.text [<module/0> "/" <module/1>]) +... ... <//> (template.text [// <module/2>']) +... ... <//>' (template.symbol [<//>]) +... ... <\\> (template.text [\\ <module/2>']) +... ... <\\>' (template.symbol [<\\>]) +... ... <m0/2> (template.text [<module/0> "/" <module/2>]) +... ... <m2/1> (template.text [<module/2> "/" <module/1>]) +... ... <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) +... ... <open/0> (template.text [<module/0> "#[0]"])] +... ... (and (,, (with_template [<input> <module> <referrals>] +... ... [(with_expansions [<input>' (macro.final <input>)] +... ... (let [scenario (is (-> Any Bit) +... ... (function (_ _) +... ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. +... ... (`` (for @.python (when (' [<input>']) +... ... (^.` [<module> +... ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) +... ... (,, (template.spliced <referrals>))]) +... ... true + +... ... _ +... ... false) +... ... (when (' [<input>']) +... ... (^.` [<module> (,, (template.spliced <referrals>))]) +... ... true + +... ... _ +... ... false)))))] +... ... (scenario [])))] + +... ... [(.require [<module/0>']) +... ... ("lux def module" []) +... ... []] + +... ... [(.require [<alias> <module/0>' (.except)]) +... ... ("lux def module" [[<module/0> <alias>]]) +... ... [(<referral> <module/0> (.except))]] + +... ... [(.require [<alias> <module/0>' (.only <definition>)]) +... ... ("lux def module" [[<module/0> <alias>]]) +... ... [(<referral> <module/0> (.only <definition>))]] + +... ... [(.require [<alias> <module/0>' (.except <definition>)]) +... ... ("lux def module" [[<module/0> <alias>]]) +... ... [(<referral> <module/0> (.except <definition>))]] + +... ... [(.require [<alias> <module/0>']) +... ... ("lux def module" []) +... ... []] + +... ... [(.require [<module/0>' +... ... [<alias> <module/1>']]) +... ... ("lux def module" [[<m0/1> <alias>]]) +... ... [(<referral> <m0/1>)]] + +... ... [(.require ["[0]" <module/0>' +... ... ["[0]" <module/1>']]) +... ... ("lux def module" [[<module/0> <module/0>] +... ... [<m0/1> <module/1>]]) +... ... [(<referral> <module/0>) +... ... (<referral> <m0/1>)]] + +... ... [(.require ["[0]" <module/0>' +... ... ["[1]" <module/1>']]) +... ... ("lux def module" [[<m0/1> <module/0>]]) +... ... [(<referral> <m0/1>)]] + +... ... [(.require ["[0]" <module/0>' +... ... ["[1]" <module/1>' +... ... ["[2]" <module/2>']]]) +... ... ("lux def module" [[<m0/1/2> <module/0>]]) +... ... [(<referral> <m0/1/2>)]] + +... ... [(.require [<module/0>' +... ... ["[0]" <module/1>' +... ... ["[0]" <//>']]]) +... ... ("lux def module" [[<m0/1> <module/1>] +... ... [<m0/2> <//>]]) +... ... [(<referral> <m0/1>) +... ... (<referral> <m0/2>)]] + +... ... [(.require ["[0]" <module/0>' +... ... [<module/1>' +... ... ["[0]" <\\>']]]) +... ... ("lux def module" [[<module/0> <module/0>] +... ... [<m2/1> <\\>]]) +... ... [(<referral> <module/0>) +... ... (<referral> <m2/1>)]] + +... ... [(.require ["[0]" <module/0>' (.use "[1]#[0]" <definition>)]) +... ... ("lux def module" [[<module/0> <module/0>]]) +... ... [(<referral> <module/0> (<open/0> <definition>))]] +... ... )))))) +... )))))) + +... (/.type for_type/variant +... (Variant +... {#Case/0} +... {#Case/1 Nat} +... {#Case/2 Int Text})) + +... (/.type for_type/record +... (Record +... [#slot/0 Bit +... #slot/1 Rev])) + +... (/.type (for_type/all parameter) +... [parameter parameter]) + +... (def for_type +... Test +... (do [! random.monad] +... [expected random.nat + +... expected_left random.nat +... expected_right random.nat + +... .let [existential_type (at ! each (|>> {.#Ex}) random.nat)] +... expected/0 existential_type +... expected/1 existential_type] +... (<| (_.for [/.Type]) +... (all _.and +... (_.coverage [/.is] +... (|> expected +... (/.is Any) +... (same? (/.is Any expected)))) +... (_.coverage [/.as] +... (|> expected +... (/.is Any) +... (/.as /.Nat) +... (same? expected))) +... (_.coverage [/.as_expected] +... (|> expected +... (/.is Any) +... /.as_expected +... (/.is /.Nat) +... (same? expected))) +... (_.coverage [/.type_of] +... (same? /.Nat (/.type_of expected))) +... (_.coverage [/.Primitive] +... (when (/.Primitive "foo" [expected/0 expected/1]) +... {.#Primitive "foo" (list actual/0 actual/1)} +... (and (same? expected/0 actual/0) +... (same? expected/1 actual/1)) + +... _ +... false)) +... (_.coverage [/.type_literal] +... (and (when (/.type_literal [expected/0 expected/1]) +... {.#Product actual/0 actual/1} +... (and (same? expected/0 actual/0) +... (same? expected/1 actual/1)) + +... _ +... false) +... (when (/.type_literal (/.Or expected/0 expected/1)) +... {.#Sum actual/0 actual/1} +... (and (same? expected/0 actual/0) +... (same? expected/1 actual/1)) + +... _ +... false) +... (when (/.type_literal (-> expected/0 expected/1)) +... {.#Function actual/0 actual/1} +... (and (same? expected/0 actual/0) +... (same? expected/1 actual/1)) + +... _ +... false) +... (when (/.type_literal (expected/0 expected/1)) +... {.#Apply actual/1 actual/0} +... (and (same? expected/0 actual/0) +... (same? expected/1 actual/1)) + +... _ +... false))) +... (_.coverage [/.type] +... (exec +... (is /.Type ..for_type/variant) +... (is /.Type ..for_type/record) +... (is /.Type ..for_type/all) +... true)) +... (_.coverage [/.Variant] +... (exec +... (is for_type/variant +... {#Case/1 expected_left}) +... true)) +... (_.coverage [/.Record] +... (exec +... (is for_type/record +... [#slot/0 (n.= expected_left expected_right) +... #slot/1 (.rev expected_right)]) +... true)) +... )))) + +... (def for_i64 +... Test +... (do random.monad +... [expected random.i64] +... (all _.and +... (_.coverage [/.i64] +... (same? (is Any expected) +... (is Any (/.i64 expected)))) +... (_.coverage [/.nat] +... (same? (is Any expected) +... (is Any (/.nat expected)))) +... (_.coverage [/.int] +... (same? (is Any expected) +... (is Any (/.int expected)))) +... (_.coverage [/.rev] +... (same? (is Any expected) +... (is Any (/.rev expected)))) +... (_.coverage [/.++] +... (n.= 1 (n.- expected +... (/.++ expected)))) +... (_.coverage [/.--] +... (n.= 1 (n.- (/.-- expected) +... expected))) +... ))) + +... (def for_function +... Test +... (do random.monad +... [expected_left random.nat +... expected_right random.nat] +... (_.coverage [/.-> /.function] +... (and (let [actual (is (/.-> Nat Nat Nat) +... (/.function (_ actual_left actual_right) +... (n.* (++ actual_left) (-- actual_right))))] +... (n.= (n.* (++ expected_left) (-- expected_right)) +... (actual expected_left expected_right))) +... (let [actual (is (/.-> [Nat Nat] Nat) +... (/.function (_ [actual_left actual_right]) +... (n.* (++ actual_left) (-- actual_right))))] +... (n.= (n.* (++ expected_left) (-- expected_right)) +... (actual [expected_left expected_right]))))))) + +... (def !n/+ +... (/.template (_ <left> <right>) +... [(n.+ <left> <right>)])) + +... (def for_template +... Test +... (`` (all _.and +... (_.coverage [/.with_template] +... (let [bits (list (,, (/.with_template [_] +... [true] + +... [0] [1] [2] +... )))] +... (and (n.= 3 (list.size bits)) +... (list.every? (bit#= true) bits)))) +... (do random.monad +... [left random.nat +... right random.nat] +... (_.coverage [/.template] +... (n.= (n.+ left right) +... (!n/+ left right)))) +... ))) + +... (def option/0 "0") +... (def option/1 "1") +... (def static_char "@") + +... (def for_static +... Test +... (do random.monad +... [sample (random.either (in option/0) +... (in option/1))] +... (all _.and +... (_.coverage [/.static] +... (when sample +... (/.static option/0) true +... (/.static option/1) true +... _ false)) +... (_.coverage [/.char] +... (|> (`` (/.char (,, (/.static static_char)))) +... text.of_char +... (text#= static_char))) +... ))) + +... (type Small +... (Record +... [#small_left Nat +... #small_right Text])) + +... (type Big +... (Record +... [#big_left Nat +... #big_right Small])) + +... (def for_slot +... Test +... (do random.monad +... [start/s random.nat +... start/b random.nat +... shift/s random.nat +... shift/b random.nat +... text (random.lower_case 1) +... .let [expected/s (n.+ shift/s start/s) +... expected/b (n.+ shift/b start/b) + +... sample [#big_left start/b +... #big_right [#small_left start/s +... #small_right text]]]] +... (all _.and +... (_.coverage [/.the] +... (and (and (|> sample +... (/.the #big_left) +... (same? start/b)) +... (|> sample +... ((/.the #big_left)) +... (same? start/b))) +... (and (|> sample +... (/.the [#big_right #small_left]) +... (same? start/s)) +... (|> sample +... ((/.the [#big_right #small_left])) +... (same? start/s))))) +... (_.coverage [/.has] +... (and (and (|> sample +... (/.has #big_left shift/b) +... (/.the #big_left) +... (same? shift/b)) +... (|> sample +... ((/.has #big_left shift/b)) +... (/.the #big_left) +... (same? shift/b)) +... (|> sample +... ((/.has #big_left) shift/b) +... (/.the #big_left) +... (same? shift/b))) +... (and (|> sample +... (/.has [#big_right #small_left] shift/s) +... (/.the [#big_right #small_left]) +... (same? shift/s)) +... (|> sample +... ((/.has [#big_right #small_left] shift/s)) +... (/.the [#big_right #small_left]) +... (same? shift/s)) +... (|> sample +... ((/.has [#big_right #small_left]) shift/s) +... (/.the [#big_right #small_left]) +... (same? shift/s))))) +... (_.coverage [/.revised] +... (and (and (|> sample +... (/.revised #big_left (n.+ shift/b)) +... (/.the #big_left) +... (n.= expected/b)) +... (|> sample +... ((/.revised #big_left (n.+ shift/b))) +... (/.the #big_left) +... (n.= expected/b)) +... (|> sample +... ((is (-> (-> Nat Nat) (-> Big Big)) +... (/.revised #big_left)) +... (n.+ shift/b)) +... (/.the #big_left) +... (n.= expected/b))) +... (and (|> sample +... (/.revised [#big_right #small_left] (n.+ shift/s)) +... (/.the [#big_right #small_left]) +... (n.= expected/s)) +... (|> sample +... ((/.revised [#big_right #small_left] (n.+ shift/s))) +... (/.the [#big_right #small_left]) +... (n.= expected/s)) +... (|> sample +... ((is (-> (-> Nat Nat) (-> Big Big)) +... (/.revised [#big_right #small_left])) +... (n.+ shift/s)) +... (/.the [#big_right #small_left]) +... (n.= expected/s))))) +... ))) + +... (def for_associative +... Test +... (do random.monad +... [left (random.lower_case 1) +... mid (random.lower_case 1) +... right (random.lower_case 1) +... .let [expected (text.interposed "" (list left mid right))]] +... (_.coverage [/.all /.left] +... (with_expansions [<left_association> (/.left format +... left +... mid +... right) +... <right_association> (/.all format +... left +... mid +... right)] +... (and (text#= <left_association> +... <right_association>) +... (not (code#= (' <left_association>) +... (' <right_association>)))))))) + +... (def for_expansion +... Test +... (do random.monad +... [left random.nat +... right random.nat +... dummy random.nat +... .let [expected (n.+ left right)]] +... (all _.and +... (_.coverage [/.these] +... (`` (and (,, (these true +... true +... true))))) +... (_.coverage [/.with_expansions] +... (/.with_expansions [<operands> (these left right)] +... (n.= expected +... (n.+ <operands>)))) +... (_.coverage [/.comment] +... (/.with_expansions [<dummy> (/.comment dummy) +... <operands> (these left right)] +... (n.= expected +... (all n.+ <operands> <dummy>)))) +... (_.coverage [/.``] +... (n.= expected +... (/.`` (all n.+ +... (,, (these left right)) +... (,, (/.comment dummy)))))) +... (_.coverage [/.for] +... (and (n.= expected +... (/.for "fake host" dummy +... expected)) +... (n.= expected +... (/.for @.old expected +... @.jvm expected +... @.js expected +... @.python expected +... @.lua expected +... @.ruby expected +... @.php expected +... dummy)))) +... ))) + +... (def for_value +... Test +... (do random.monad +... [left random.nat +... right (random.lower_case 1) + +... item/0 random.nat +... item/1 random.nat +... item/2 random.nat] +... (all _.and +... (_.coverage [/.Either] +... (and (exec +... (is (/.Either Nat Text) +... {.#Left left}) +... true) +... (exec +... (is (/.Either Nat Text) +... {.#Right right}) +... true))) +... (_.coverage [/.Any] +... (and (exec +... (is /.Any +... left) +... true) +... (exec +... (is /.Any +... right) +... true))) +... (_.coverage [/.Nothing] +... (and (exec +... (is (-> /.Any /.Nothing) +... (function (_ _) +... (undefined))) +... true) +... (exec +... (is (-> /.Any /.Int) +... (function (_ _) +... (is /.Int (undefined)))) +... true))) +... (_.for [/.__adjusted_quantified_type__] +... (all _.and +... (_.coverage [/.All] +... (let [identity (is (/.All (_ a) (-> a a)) +... (|>>))] +... (and (exec +... (is Nat +... (identity left)) +... true) +... (exec +... (is Text +... (identity right)) +... true)))) +... (_.coverage [/.Ex] +... (let [hide (is (/.Ex (_ a) (-> Nat a)) +... (|>>))] +... (exec +... (is /.Any +... (hide left)) +... true))))) +... (_.coverage [/.same?] +... (let [not_left (atom.atom left) +... left (atom.atom left)] +... (and (/.same? left left) +... (/.same? not_left not_left) +... (not (/.same? left not_left))))) +... (_.coverage [/.Rec] +... (let [list (is (/.Rec NList +... (Maybe [Nat NList])) +... {.#Some [item/0 +... {.#Some [item/1 +... {.#Some [item/2 +... {.#None}]}]}]})] +... (when list +... {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} +... (and (same? item/0 actual/0) +... (same? item/1 actual/1) +... (same? item/2 actual/2)) + +... _ +... false))) +... ))) + +... (type (Pair l r) +... (Record +... [#left l +... #right r])) + +... (def !pair +... (template (_ <left> <right>) +... [[..#left <left> +... ..#right <right>]])) + +... (def for_when +... Test +... (do [! random.monad] +... [expected_nat (at ! each (n.% 1) random.nat) +... expected_int (at ! each (i.% +1) random.int) +... expected_rev (random.either (in .5) +... (in .25)) +... expected_frac (random.either (in +0.5) +... (in +1.25)) +... expected_text (random.either (in "+0.5") +... (in "+1.25"))] +... (all _.and +... (_.coverage [/.when] +... (and (/.when expected_nat +... 0 true +... _ false) +... (/.when expected_int +... +0 true +... _ false) +... (/.when expected_rev +... .5 true +... .25 true +... _ false) +... (/.when expected_frac +... +0.5 true +... +1.25 true +... _ false) +... (/.when expected_text +... "+0.5" true +... "+1.25" true +... _ false) +... (/.when [expected_nat expected_int] +... [0 +0] true +... _ false) +... (/.when [..#left expected_nat ..#right expected_int] +... [..#left 0 ..#right +0] true +... _ false) +... (/.when (is (Either Nat Int) {.#Left expected_nat}) +... {.#Left 0} true +... _ false) +... (/.when (is (Either Nat Int) {.#Right expected_int}) +... {.#Right +0} true +... _ false) +... )) +... ... (_.coverage [/.pattern] +... ... (/.when [..#left expected_nat ..#right expected_int] +... ... (!pair 0 +0) +... ... true + +... ... _ +... ... false)) +... (_.coverage [/.let] +... (and (/.let [actual_nat expected_nat] +... (/.same? expected_nat actual_nat)) +... (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] +... (and (/.same? expected_nat actual_left) +... (/.same? expected_int actual_right))))) +... ))) + +... (def for_control_flow +... Test +... (all _.and +... (do random.monad +... [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) +... iterations (random#each (n.% 10) random.nat) +... .let [expected (n.* factor iterations)]] +... (_.coverage [/.loop] +... (n.= expected +... (/.loop (again [counter 0 +... value 0]) +... (if (n.< iterations counter) +... (again (++ counter) (n.+ factor value)) +... value))))) +... (do random.monad +... [pre random.nat +... post (random.only (|>> (n.= pre) not) random.nat) +... .let [box (atom.atom pre)]] +... (_.coverage [/.exec] +... (and (same? pre (io.run! (atom.read! box))) +... (/.exec +... (io.run! (atom.write! post box)) +... (same? post (io.run! (atom.read! box))))))) +... )) + +... (def identity/constant +... (All (_ a) (-> a a)) +... (function (_ value) +... value)) + +... (def (identity/function value) +... (All (_ a) (-> a a)) +... value) + +... (def for_def +... Test +... (do random.monad +... [expected random.nat] +... (_.coverage [/.def] +... (and (same? expected (identity/constant expected)) +... (same? expected (identity/function expected)))))) + +... (def possible_targets +... (Set @.Target) +... (<| (set.of_list text.hash) +... (list @.old +... @.js +... @.jvm +... @.lua +... @.python +... @.ruby))) + +... (def for_meta|Info +... (syntax (_ []) +... (function (_ lux) +... (let [info (the .#info lux) + +... conforming_target! +... (set.member? ..possible_targets (the .#target info)) + +... compiling! +... (when (the .#mode info) +... {.#Build} true +... _ false)] +... {.#Right [lux (list (code.bit (and conforming_target! +... compiling!)))]})))) + +... (def for_meta|Module_State +... (syntax (_ []) +... (do meta.monad +... [prelude (meta.module .prelude)] +... (in (list (code.bit (when (the .#module_state prelude) +... {.#Active} false +... _ true))))))) + +... (def for_meta +... Test +... (all _.and +... (_.coverage [/.Mode /.Info] +... (for_meta|Info)) +... (_.coverage [/.Module_State] +... (for_meta|Module_State)) +... )) + +... (def for_export +... Test +... (all _.and +... (_.coverage [/.public /.private] +... (and /.public (not /.private))) +... (_.coverage [/.global /.local] +... (and (bit#= /.public /.global) +... (bit#= /.private /.local))) +... )) + +... (for @.old (these) +... (these (def for_bindings|test +... (syntax (_ lux_state +... [fn/0 <code>.local +... var/0 <code>.local +... let/0 <code>.local + +... fn/1 <code>.local +... var/1 <code>.local +... let/1 <code>.local + +... fn/2 <code>.local +... var/2 <code>.local +... let/2 <code>.local + +... let/3 <code>.local]) +... (in (list (code.bit (when (the .#scopes lux_state) +... (list.partial scope/2 _) +... (let [locals/2 (the .#locals scope/2) +... expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 +... let/3)) +... actual_locals/2 (|> locals/2 +... (the .#mappings) +... (list#each product.left) +... (set.of_list text.hash)) + +... correct_locals! +... (and (n.= 4 (the .#counter locals/2)) +... (set#= expected_locals/2 +... actual_locals/2)) + +... captured/2 (the .#captured scope/2) + +... local? (is (-> Ref Bit) +... (function (_ ref) +... (when ref +... {.#Local _} true +... {.#Captured _} false))) +... captured? (is (-> Ref Bit) +... (|>> local? not)) +... binding? (is (-> (-> Ref Bit) Text Bit) +... (function (_ is? name) +... (|> captured/2 +... (the .#mappings) +... (property.value name) +... (maybe#each (|>> product.right is?)) +... (maybe.else false)))) + +... correct_closure! +... (and (n.= 6 (the .#counter captured/2)) +... (binding? local? fn/1) +... (binding? local? var/1) +... (binding? local? let/1) +... (binding? captured? fn/0) +... (binding? captured? var/0) +... (binding? captured? let/0))] +... (and correct_locals! +... correct_closure!)) + +... _ +... false)))))) + +... (def for_bindings +... Test +... ((<| (template.with_locals [fn/0 var/0 let/0 +... fn/1 var/1 let/1 +... fn/2 var/2 let/2 +... let/3]) +... (function (fn/0 var/0)) (let [let/0 123]) +... (function (fn/1 var/1)) (let [let/1 456]) +... (function (fn/2 var/2)) (let [let/2 789]) +... (let [let/3 [fn/0 var/0 let/0 +... fn/1 var/1 let/1 +... fn/2 var/2 let/2] +... verdict (for_bindings|test fn/0 var/0 let/0 +... fn/1 var/1 let/1 +... fn/2 var/2 let/2 +... let/3)] +... (_.coverage [/.Bindings /.Ref] +... verdict))) +... 0 1 2)))) + +... (def test|lux +... Test +... (`` (`` (all _.and +... ..for_bit +... ..for_try +... ..for_list +... ..for_interface +... ..for_module +... ..for_pipe +... ..for_code +... ..for_macro +... ..for_type +... ..for_i64 +... ..for_function +... ..for_template +... ..for_static +... ..for_slot +... ..for_associative +... ..for_expansion +... ..for_value +... ..for_when +... ..for_control_flow +... ..for_def +... ..for_meta +... ..for_export +... (,, (for @.old (,, (these)) +... (,, (these ..for_bindings)))) +... )))) + +... (def test +... Test +... (<| (_.covering /._) +... (_.in_parallel +... (list ..test|lux + +... ... /abstract.test +... ... /control.test +... ... /data.test +... ... /debug.test + +... ... /documentation.test +... ... /math.test + +... ... /meta.test +... ... /program.test +... ... /test/property.test + +... ... /world.test + +... ... /ffi.test +... )))) (def _ (program args - (let [times (for @.old 100 - @.jvm 100 - @.js 10 - @.python 1 - @.lua 1 - @.ruby 1 - 100)] + (let [... times (for @.old 100 + ... @.jvm 100 + ... @.js 10 + ... @.python 1 + ... @.lua 1 + ... @.ruby 1 + ... 100) + ] (<| io.io - _.run! - (_.times times) - ..test)))) + ("lux io log" "Hello, World!") + ... _.run! + ... (_.times times) + ... ..test + )))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 0cb7e598e..9daf9ce78 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -12,7 +12,8 @@ ["[1]/[0]" thread] ["[1]/[0]" async] ["[1]/[0]" semaphore] - ["[1]/[0]" stm]] + ["[1]/[0]" stm] + ["[1]/[0]" event]] ["[1][0]" continuation] ["[1][0]" exception] ["[1][0]" function] @@ -42,6 +43,7 @@ /concurrency/async.test /concurrency/semaphore.test /concurrency/stm.test + /concurrency/event.test )) (def security diff --git a/stdlib/source/test/lux/control/concurrency/event.lux b/stdlib/source/test/lux/control/concurrency/event.lux new file mode 100644 index 000000000..966c340fa --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/event.lux @@ -0,0 +1,81 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.use "[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" list]]] + [math + ["[0]" random] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [loop_name (at ! each %.nat random.nat) + error (at ! each %.nat random.nat) + expected_events (at ! each (n.% 10) random.nat)] + (all _.and + (_.coverage [/.loop] + (and (let [[schedule! run!] (/.loop loop_name)] + (io.run! (do [! io.monad] + [_ (|> (in []) + (list.repeated expected_events) + (monad.each ! (schedule! 0))) + events_processed run!] + (in (|> events_processed + (try#each (n.= expected_events)) + (try.else false)))))) + (let [[schedule! run!] (/.loop loop_name)] + (io.run! (do [! io.monad] + [_ (|> (do ! + [_ (in [])] + (schedule! 0 (in []))) + (list.repeated expected_events) + (monad.each ! (schedule! 0))) + events_processed run!] + (in (|> events_processed + (try#each (n.= (n.* 2 expected_events))) + (try.else false)))))))) + (_.coverage [/.already_started] + (let [[schedule! run!] (/.loop loop_name)] + (io.run! (do io.monad + [events_processed run! + failure run!] + (in (and (|> events_processed + (try#each (n.= 0)) + (try.else false)) + (when failure + {try.#Failure error} + (and (exception.match? /.already_started error) + (text.contains? loop_name error)) + + _ + false))))))) + (_.coverage [/.error_during_execution] + (let [[schedule! run!] (/.loop loop_name)] + (io.run! (do io.monad + [_ (schedule! 0 (io.io (panic! error))) + failure run!] + (in (when failure + {try.#Failure error} + (and (exception.match? /.error_during_execution error) + (text.contains? loop_name error) + (text.contains? error error)) + + _ + false)))))) + )))) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index a41f52a8d..26023e7aa 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -268,7 +268,9 @@ (ffi.import sys "[1]::[0]" - ("static" stdout io/StringIO)))) + ("static" stdout io/StringIO))) + ... else + (these)) (def with_out (template (_ <body>) diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux index 2de0e2ec8..b2b7e0eda 100644 --- a/stdlib/source/test/lux/meta/macro.lux +++ b/stdlib/source/test/lux/meta/macro.lux @@ -238,6 +238,12 @@ n/1 (static.random_nat)] (n.= (..sum n/0 n/1 n/1) (..sum' n/0 n/1 n/1)))) + (_.coverage [/.macro] + (|> ..sum + /.function + /.macro + (is Macro) + (same? ..sum))) )) ..test|expansion |