aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/project.lux3
-rw-r--r--stdlib/source/library/lux/control/concurrency/event.lux107
-rw-r--r--stdlib/source/library/lux/control/concurrency/thread.lux79
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/loop.lux4
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/runtime.lux92
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/js/when.lux6
-rw-r--r--stdlib/source/library/lux/world/environment.lux4
-rw-r--r--stdlib/source/library/lux/world/file.lux2
-rw-r--r--stdlib/source/test/lux.lux2482
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/event.lux81
-rw-r--r--stdlib/source/test/lux/debug.lux4
-rw-r--r--stdlib/source/test/lux/meta/macro.lux6
13 files changed, 1546 insertions, 1328 deletions
diff --git a/stdlib/project.lux b/stdlib/project.lux
index c2611040d..930b8949b 100644
--- a/stdlib/project.lux
+++ b/stdlib/project.lux
@@ -5,8 +5,7 @@
"identity" ["com.github.luxlang" "stdlib" "0.8.0-SNAPSHOT"]
... Every piece of information, and the whole "info" bundle, are optional.
- "info" ["name" "stdlib"
- "description" "Standard library for the Lux programming language."
+ "info" ["description" "Standard library for the Lux programming language."
"url" "https://github.com/LuxLang/lux"
"scm" "https://github.com/LuxLang/lux.git"
"licenses" [["name" "Lux License v0.1.2"
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