aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2022-08-18 21:34:21 -0400
committerEduardo Julian2022-08-18 21:34:21 -0400
commit81b6e0d7038a99c66456033c8285f740a3b0c719 (patch)
tree4d09e45791f19bd40170260502ebc958b07ee1af /stdlib
parentecda0d219cf7dc25bd9b0b76815a8880e20232c2 (diff)
Added support for Communicating Sequential Processes (CSP).
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/control/concurrency/cps.lux76
-rw-r--r--stdlib/source/test/lux.lux2533
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/cps.lux92
-rw-r--r--stdlib/source/test/lux/meta/static.lux29
5 files changed, 1463 insertions, 1271 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/cps.lux b/stdlib/source/library/lux/control/concurrency/cps.lux
new file mode 100644
index 000000000..f8cd41a77
--- /dev/null
+++ b/stdlib/source/library/lux/control/concurrency/cps.lux
@@ -0,0 +1,76 @@
+(.require
+ [library
+ [lux (.except try)
+ [abstract
+ [functor (.only Functor)]
+ [monad (.only Monad do)]]
+ [control
+ ["[0]" try (.only Try) (.use "[1]#[0]" monad)]
+ ["[0]" exception (.only Exception)]]]]
+ [//
+ ["[0]" async (.only Async) (.use "[1]#[0]" monad)]
+ ["[0]" frp]])
+
+(type .public (Process a)
+ (Async (Try a)))
+
+(type .public Channel' frp.Channel')
+(type .public Channel frp.Channel)
+(type .public Sink frp.Sink)
+
+(def .public channel
+ (All (_ a) (-> Any [(Channel a) (Sink a)]))
+ frp.channel)
+
+(def .public functor
+ (Functor Process)
+ (implementation
+ (def (each $)
+ (async#each (try#each $)))))
+
+(def .public monad
+ (Monad Process)
+ (implementation
+ (def functor ..functor)
+ (def in (|>> try#in async#in))
+ (def (conjoint atatx)
+ (do async.monad
+ [tatx atatx]
+ (when tatx
+ {try.#Success atx}
+ atx
+
+ {try.#Failure error}
+ (in {try.#Failure error}))))))
+
+(exception.def .public channel_has_been_closed)
+
+(def .public (read it)
+ (All (_ r w)
+ (-> (Channel' r w) (Process [r (Channel' r w)])))
+ (let [[output resolver] (async.async [])]
+ (exec
+ (async.future
+ (async.upon! (function (_ head,tail)
+ (resolver (when head,tail
+ {.#Some [head tail]}
+ {try.#Success [head tail]}
+
+ {.#None}
+ (exception.except ..channel_has_been_closed []))))
+ it))
+ output)))
+
+(def .public (write value sink)
+ (All (_ w)
+ (-> w (Sink w) (Process Any)))
+ (async.future (at sink feed value)))
+
+(def .public (close sink)
+ (All (_ w)
+ (-> (Sink w) (Process Any)))
+ (async.future (at sink close)))
+
+(def .public try
+ (All (_ a) (-> (Process a) (Process (Try a))))
+ (async#each (|>> {try.#Success})))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 46ef4d8b0..fb2df3a0c 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -6,1279 +6,1272 @@
[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]]
+ ["[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 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 [_ ("lux io log" "[[[0]]]")
- ... times (for @.old 100
- ... @.jvm 100
- ... @.js 10
- ... @.python 1
- ... @.lua 1
- ... @.ruby 1
- ... 100)
- ]
- (exec
- ("lux io log" "[[[1]]]")
- (<| io.io
- ("lux io log" "Hello, World!")
- ... _.run!
- ... (_.times times)
- ... ..test
- )))))
+ (let [times (for @.old 100
+ @.jvm 100
+ @.js 10
+ @.python 1
+ @.lua 1
+ @.ruby 1
+ 100)]
+ (<| io.io
+ _.run!
+ (_.times times)
+ ..test
+ ))))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 9daf9ce78..bdef6e1b1 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -13,7 +13,8 @@
["[1]/[0]" async]
["[1]/[0]" semaphore]
["[1]/[0]" stm]
- ["[1]/[0]" event]]
+ ["[1]/[0]" event]
+ ["[1]/[0]" cps]]
["[1][0]" continuation]
["[1][0]" exception]
["[1][0]" function]
@@ -44,6 +45,7 @@
/concurrency/semaphore.test
/concurrency/stm.test
/concurrency/event.test
+ /concurrency/cps.test
))
(def security
diff --git a/stdlib/source/test/lux/control/concurrency/cps.lux b/stdlib/source/test/lux/control/concurrency/cps.lux
new file mode 100644
index 000000000..5bf53cb96
--- /dev/null
+++ b/stdlib/source/test/lux/control/concurrency/cps.lux
@@ -0,0 +1,92 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]
+ [\\specification
+ ["$[0]" functor (.only Injection Comparison)]
+ ["$[0]" monad]]]
+ [control
+ ["[0]" io]
+ ["[0]" try]
+ ["[0]" exception]]
+ [math
+ ["[0]" random]]
+ [test
+ ["_" property (.only Test)]
+ ["[0]" unit]]]]
+ [\\library
+ ["[0]" / (.only)
+ [//
+ ["[0]" async]]]])
+
+(def injection
+ (Injection /.Process)
+ (at /.monad in))
+
+(def comparison
+ (Comparison /.Process)
+ (function (_ == left right)
+ (io.run!
+ (do io.monad
+ [?left (async.value left)
+ ?right (async.value right)]
+ (in (when [?left ?right]
+ [{.#Some {try.#Success left}}
+ {.#Some {try.#Success right}}]
+ (== left right)
+
+ _
+ false))))))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [expected random.nat]
+ (all _.and
+ (_.for [/.Process]
+ (all _.and
+ (_.for [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.for [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
+ ))
+ (_.coverage [/.Channel /.Channel' /.Sink /.channel]
+ ... This is already been tested for the FRP module.
+ true)
+ (in (do async.monad
+ [it (do /.monad
+ [.let [[channel sink] (/.channel [])]
+ _ (/.write expected sink)
+ [actual channel] (/.read channel)]
+ (in (same? expected actual)))]
+ (unit.coverage [/.read /.write]
+ (try.else false it))))
+ (in (do async.monad
+ [it (do /.monad
+ [.let [[channel sink] (/.channel [])]
+ _ (/.close sink)
+ it (/.try (/.write expected sink))]
+ (in (when it
+ {try.#Failure _}
+ true
+
+ _
+ false)))]
+ (unit.coverage [/.close /.try]
+ (try.else false it))))
+ (in (do async.monad
+ [it (do /.monad
+ [.let [[channel sink] (/.channel [])]
+ _ (/.close sink)
+ it (/.try (/.read channel))]
+ (in (when it
+ {try.#Failure error}
+ (exception.match? /.channel_has_been_closed error)
+
+ _
+ false)))]
+ (unit.coverage [/.channel_has_been_closed]
+ (try.else false it))))
+ ))))
diff --git a/stdlib/source/test/lux/meta/static.lux b/stdlib/source/test/lux/meta/static.lux
index a7169d6af..2b69d4cb6 100644
--- a/stdlib/source/test/lux/meta/static.lux
+++ b/stdlib/source/test/lux/meta/static.lux
@@ -2,6 +2,7 @@
[library
[lux (.except)
[data
+ ["[0]" bit (.use "[1]#[0]" equivalence)]
["[0]" text (.use "[1]#[0]" equivalence)
["%" \\format (.only format)]]
[collection
@@ -39,6 +40,7 @@
_
false)))]
+ [/.bit /.random_bit bit#= and .#Bit]
[/.nat /.random_nat n.= n.+ .#Nat]
[/.int /.random_int i.= i.+ .#Int]
[/.rev /.random_rev r.= r.+ .#Rev]
@@ -91,4 +93,31 @@
l/* (/.literals code.nat (list l/0 l/1 l/2))]
(n.= (all n.+ l/0 l/1 l/2)
(all n.+ l/*))))
+ (_.coverage [/.if]
+ (with_expansions [<?> (/.random_bit)
+ <then> (/.random_nat)
+ <else> (/.random_nat)]
+ (n.= (if <?> <then> <else>)
+ (/.if <?> <then> <else>))))
+ (_.coverage [/.cond]
+ (with_expansions [<?> (/.random_bit)
+ <then> (/.random_nat)
+ <else> (/.random_nat)
+ <never> (/.random_frac)]
+ (n.= (if <?> <then> <else>)
+ (/.cond <?> <then>
+ (not <?>) <else>
+ ... never
+ <never>))))
+ (_.coverage [/.when]
+ (with_expansions [<0> (/.random_nat)
+ <1> (/.random_nat)
+ <2> (/.random_nat)]
+ (and (n.= (all n.+ <0> <1>)
+ (`` (all n.+ <0> <1> (,, (/.when false <2>)))))
+ (n.= (all n.+ <0> <1> <2>)
+ (`` (all n.+ <0> <1> (,, (/.when true <2>))))))))
+ (_.coverage [/.seed]
+ (not (n.= (/.seed)
+ (/.seed))))
))))