aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/library/lux/control/exception.lux8
-rw-r--r--stdlib/source/library/lux/control/function/variadic.lux68
-rw-r--r--stdlib/source/test/lux.lux17
-rw-r--r--stdlib/source/test/lux/control/function.lux4
-rw-r--r--stdlib/source/test/lux/control/function/variadic.lux76
-rw-r--r--stdlib/source/test/lux/math.lux2
-rw-r--r--stdlib/source/test/lux/math/random.lux243
7 files changed, 406 insertions, 12 deletions
diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux
index 8d39a9daf..474ca07d3 100644
--- a/stdlib/source/library/lux/control/exception.lux
+++ b/stdlib/source/library/lux/control/exception.lux
@@ -37,9 +37,6 @@
(-> (Exception e) (-> Text a) (Try a)
(Try a)))
(.when try
- {//.#Success output}
- {//.#Success output}
-
{//.#Failure error}
(let [reference (the #label exception)]
(if (text.starts_with? reference error)
@@ -47,7 +44,10 @@
(text.clip_since (text.size reference))
maybe.trusted
then)}
- {//.#Failure error}))))
+ {//.#Failure error}))
+
+ success
+ success))
(.def .public (otherwise else try)
(All (_ a)
diff --git a/stdlib/source/library/lux/control/function/variadic.lux b/stdlib/source/library/lux/control/function/variadic.lux
new file mode 100644
index 000000000..5b53bbe83
--- /dev/null
+++ b/stdlib/source/library/lux/control/function/variadic.lux
@@ -0,0 +1,68 @@
+... https://en.wikipedia.org/wiki/Variadic_function
+(.require
+ [library
+ [lux (.except def)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["?" parser]
+ ["[0]" exception (.only Exception)]]
+ [data
+ ["[0]" text (.only)
+ ["%" \\format]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" monad)]
+ ["[0]" set]]]
+ [math
+ [number
+ ["n" nat]]]
+ ["[0]" meta (.only)
+ ["[0]" code (.only)
+ ["?[1]" \\parser]]
+ [macro (.only with_symbols)
+ [syntax (.only syntax)
+ ["[0]" export]]]]]])
+
+(exception.def .public (duplicate_parameters [definition parameters])
+ (Exception [Symbol (List Text)])
+ (exception.report
+ (list ["Definition" (%.symbol definition)]
+ ["Parameters" (%.list %.text parameters)])))
+
+(exception.def .public (must_have_rest_parameter definition)
+ (Exception Symbol)
+ (exception.report
+ (list ["Definition" (%.symbol definition)])))
+
+(.def .public def
+ (syntax (_ [[exported? [name parameters] type body]
+ (export.parser (all ?.and
+ (?code.form (?.and ?code.local (?.some ?code.local)))
+ ?code.any
+ ?code.any))])
+ (do meta.monad
+ [here meta.current_module_name]
+ (if (n.= (list.size parameters)
+ (set.size (set.of_list text.hash parameters)))
+ (with_symbols [g!function]
+ (when (list.reversed parameters)
+ (list.partial &rest mandatory)
+ (let [mandatory (list#each code.local (list.reversed mandatory))
+ &rest (code.local &rest)]
+ (in (list (` (.def (, exported?) ((, g!function) (,* mandatory) (, &rest))
+ (, type)
+ (, body)))
+ (` (.def (, exported?) (, (code.local name))
+ (syntax ((, (code.local name)) [(,* (|> mandatory
+ (list#each (function (_ parameter)
+ (list parameter (` ?code.any))))
+ list#conjoint))
+ (, &rest) (?.some ?code.any)])
+ (at meta.monad (,' in)
+ (list (` ((, g!function)
+ (,* (list#each (|>> , ((,' .,)) `) mandatory))
+ (list ((,' .,*) (, &rest)))))))))))))
+
+ _
+ (meta.failure (exception.error ..must_have_rest_parameter [[here name]]))))
+ (meta.failure (exception.error ..duplicate_parameters [[here name] parameters]))))))
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 08a1f75cd..46ef4d8b0 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -1265,7 +1265,8 @@
(def _
(program args
- (let [... times (for @.old 100
+ (let [_ ("lux io log" "[[[0]]]")
+ ... times (for @.old 100
... @.jvm 100
... @.js 10
... @.python 1
@@ -1273,9 +1274,11 @@
... @.ruby 1
... 100)
]
- (<| io.io
- ("lux io log" "Hello, World!")
- ... _.run!
- ... (_.times times)
- ... ..test
- ))))
+ (exec
+ ("lux io log" "[[[1]]]")
+ (<| io.io
+ ("lux io log" "Hello, World!")
+ ... _.run!
+ ... (_.times times)
+ ... ..test
+ )))))
diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux
index 0c4fa2ad3..b3e79f47d 100644
--- a/stdlib/source/test/lux/control/function.lux
+++ b/stdlib/source/test/lux/control/function.lux
@@ -20,7 +20,8 @@
["[1][0]" mixin]
["[1][0]" mutual]
["[1][0]" inline]
- ["[1][0]" predicate]])
+ ["[1][0]" predicate]
+ ["[1][0]" variadic]])
(def .public test
Test
@@ -67,4 +68,5 @@
/mutual.test
/inline.test
/predicate.test
+ /variadic.test
))))
diff --git a/stdlib/source/test/lux/control/function/variadic.lux b/stdlib/source/test/lux/control/function/variadic.lux
new file mode 100644
index 000000000..35a7d5f36
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/variadic.lux
@@ -0,0 +1,76 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" try]
+ ["[0]" exception]]
+ [data
+ ["[0]" text]
+ [collection
+ ["[0]" list (.use "[1]#[0]" mix)]]]
+ [math
+ ["[0]" random]
+ [number
+ ["n" nat]]]
+ [meta
+ ["[0]" code (.only)
+ ["<[1]>" \\parser]]
+ [macro
+ [syntax (.only syntax)]
+ ["[0]" expansion]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def macro_error
+ (syntax (_ [macro <code>.any])
+ (function (_ compiler)
+ (when ((expansion.complete macro) compiler)
+ {try.#Failure error}
+ {try.#Success [compiler (list (code.text error))]}
+
+ {try.#Success _}
+ {try.#Failure "OOPS!"}))))
+
+(/.def (+ left right extra)
+ (-> Nat Nat (List Nat) Nat)
+ (list#mix n.+ (n.+ left right) extra))
+
+(def .public test
+ Test
+ (do [! random.monad]
+ [p0 random.nat
+ p1 random.nat
+ p2 random.nat
+ p3 random.nat
+ p4 random.nat
+ p5 random.nat]
+ (<| (_.covering /._)
+ (all _.and
+ (_.coverage [/.def]
+ (and (n.= (all n.+ p0 p1)
+ (+ p0 p1))
+ (n.= (all n.+ p0 p1 p2)
+ (+ p0 p1 p2))
+ (n.= (all n.+ p0 p1 p2 p3)
+ (+ p0 p1 p2 p3))
+ (n.= (all n.+ p0 p1 p2 p3 p4)
+ (+ p0 p1 p2 p3 p4))
+ (n.= (all n.+ p0 p1 p2 p3 p4 p5)
+ (+ p0 p1 p2 p3 p4 p5))))
+ (_.coverage [/.duplicate_parameters]
+ (text.contains? (the exception.#label /.duplicate_parameters)
+ (macro_error
+ (/.def .public (- _ _)
+ (-> Nat (List Nat) Nat)
+ (undefined)))))
+ (_.coverage [/.must_have_rest_parameter]
+ (text.contains? (the exception.#label /.must_have_rest_parameter)
+ (macro_error
+ (/.def .public (-)
+ (-> Nat (List Nat) Nat)
+ (undefined)))))
+ ))))
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index 1eaab1664..db993c324 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -26,6 +26,7 @@
["[1][0]" modulus]
["[1][0]" modular]
["[1][0]" number]
+ ["[1][0]" random]
["[1][0]" logic
["[1]/[0]" continuous]
["[1]/[0]" fuzzy]]])
@@ -141,6 +142,7 @@
/modulus.test
/modular.test
/number.test
+ /random.test
/logic/continuous.test
/logic/fuzzy.test
))))
diff --git a/stdlib/source/test/lux/math/random.lux b/stdlib/source/test/lux/math/random.lux
new file mode 100644
index 000000000..80e02b2e0
--- /dev/null
+++ b/stdlib/source/test/lux/math/random.lux
@@ -0,0 +1,243 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [equivalence (.only Equivalence)]
+ [monad (.only do)]
+ [\\specification
+ ["$[0]" functor (.only Injection Comparison)]
+ ["$[0]" apply]
+ ["$[0]" monad]]]
+ [control
+ ["[0]" maybe]]
+ [data
+ ["[0]" sum]
+ ["[0]" product]
+ ["[0]" bit]
+ ["[0]" text (.only)
+ ["[0]" unicode
+ ["[1]" set]]]
+ [collection
+ ["[0]" list]
+ ["[0]" sequence]
+ ["[0]" array]
+ ["[0]" queue]
+ ["[0]" stack]
+ ["[0]" set]
+ ["[0]" dictionary]]]
+ [math
+ [number
+ ["[0]" i64]
+ ["[0]" nat]
+ ["[0]" int]
+ ["[0]" rev]
+ ["[0]" frac]
+ ["[0]" ratio]
+ ["[0]" complex]]]
+ [meta
+ [type
+ ["[0]" refinement]]]
+ [world
+ ["[0]" time (.only)
+ ["[0]" instant]
+ ["[0]" date]
+ ["[0]" duration]
+ ["[0]" month]
+ ["[0]" day]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" / (.only Random)]])
+
+(def injection
+ (Injection Random)
+ (at /.monad in))
+
+(def (comparison increase,seed)
+ (-> [(I64 Any) (I64 Any)] (Comparison Random))
+ (function (_ == left right)
+ (|> (do /.monad
+ [left left
+ right right]
+ (in (== left right)))
+ (/.result (/.pcg_32 increase,seed))
+ product.right)))
+
+(def (distinct equivalence random)
+ (All (_ a) (-> (Equivalence a) (Random a) (Random Bit)))
+ (do /.monad
+ [reference random
+ example (/.only (|>> (at equivalence = reference) not)
+ random)]
+ (in (not (same? reference example)))))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do /.monad
+ [increase,seed (/.and /.nat /.nat)
+ .let [[increase seed] increase,seed]])
+ (_.for [/.Random])
+ (`` (all _.and
+ (_.for [/.functor]
+ ($functor.spec ..injection (..comparison increase,seed) /.functor))
+ (_.for [/.apply]
+ ($apply.spec ..injection (..comparison increase,seed) /.apply))
+ (_.for [/.monad]
+ ($monad.spec ..injection (..comparison increase,seed) /.monad))
+
+ (_.coverage [/.result]
+ (|> (in true)
+ (/.result (/.pcg_32 increase,seed))
+ product.right))
+
+ (do /.monad
+ [? (distinct (maybe.equivalence nat.equivalence) (/.maybe /.nat))]
+ (_.coverage [/.maybe]
+ ?))
+
+ (do /.monad
+ [predicate (/.either (in nat.even?)
+ (in nat.odd?))
+ sample (/.only predicate /.nat)]
+ (_.coverage [/.only]
+ (predicate sample)))
+
+ (do /.monad
+ [predicate (/.either (in nat.even?)
+ (in nat.odd?))
+ .let [refiner (refinement.refiner predicate)]
+ sample (/.refined refiner /.nat)]
+ (_.coverage [/.refined]
+ (and (same? predicate (refinement.predicate sample))
+ (predicate (refinement.value sample)))))
+
+ (do /.monad
+ [predicate (/.either (in nat.even?)
+ (in nat.odd?))
+ sample (/.one (function (_ it)
+ (if (predicate it)
+ {.#Some it}
+ {.#None}))
+ /.nat)]
+ (_.coverage [/.one]
+ (predicate sample)))
+
+ (,, (with_template [<random> <equivalence>]
+ [(do /.monad
+ [? (distinct <equivalence> <random>)]
+ (_.coverage [<random>]
+ ?))]
+
+ [/.bit bit.equivalence]
+ [/.i64 i64.equivalence]
+ [/.nat nat.equivalence]
+ [/.int int.equivalence]
+ [/.rev rev.equivalence]
+ [/.safe_frac frac.equivalence]
+
+ [/.ratio ratio.equivalence]
+ [/.complex complex.equivalence]
+
+ [/.time time.equivalence]
+ [/.instant instant.equivalence]
+ [/.date date.equivalence]
+ [/.duration duration.equivalence]
+ [/.month month.equivalence]
+ [/.day day.equivalence]
+ ))
+ (do /.monad
+ [? (distinct frac.equivalence (/.only frac.number? /.frac))]
+ (_.coverage [/.frac]
+ ?))
+
+ (,, (with_template [<random>]
+ [(do /.monad
+ [? (distinct text.equivalence (<random> 1))]
+ (_.coverage [<random>]
+ ?))]
+
+ [/.unicode]
+ [/.ascii]
+ [/.alphabetic]
+ [/.alpha_numeric]
+ [/.numeric]
+ [/.upper_case]
+ [/.lower_case]
+ ))
+ (do /.monad
+ [? (distinct nat.equivalence (/.char unicode.character))]
+ (_.coverage [/.char]
+ ?))
+ (do /.monad
+ [? (distinct text.equivalence (/.text (/.char unicode.character) 1))]
+ (_.coverage [/.text]
+ ?))
+
+ (,, (with_template [<random> <equivalence>]
+ [(do /.monad
+ [? (distinct (<equivalence> nat.equivalence)
+ (<random> 2 /.nat))]
+ (_.coverage [<random>]
+ ?))]
+
+ [/.list list.equivalence]
+ [/.sequence sequence.equivalence]
+ [/.array array.equivalence]
+ [/.queue queue.equivalence]
+ [/.stack stack.equivalence]
+ ))
+ (do /.monad
+ [? (distinct set.equivalence
+ (/.set nat.hash 2 /.nat))]
+ (_.coverage [/.set]
+ ?))
+ (do /.monad
+ [? (distinct (dictionary.equivalence nat.equivalence)
+ (/.dictionary nat.hash 2 /.nat /.nat))]
+ (_.coverage [/.dictionary]
+ ?))
+ (do /.monad
+ [? (distinct (list.equivalence nat.equivalence)
+ (is (Random (List Nat))
+ (/.rec (function (_ it)
+ (/.or (in [])
+ (/.and /.nat
+ it))))))]
+ (_.coverage [/.rec]
+ ?))
+
+ (,, (with_template [<random> <equivalence>]
+ [(do /.monad
+ [? (distinct (<equivalence> nat.equivalence nat.equivalence)
+ (<random> /.nat /.nat))]
+ (_.coverage [<random>]
+ ?))]
+
+ [/.or sum.equivalence]
+ [/.and product.equivalence]
+ ))
+ (do /.monad
+ [? (distinct nat.equivalence
+ (/.either /.nat /.nat))]
+ (_.coverage [/.either]
+ ?))
+
+ (_.for [/.PRNG]
+ (all _.and
+ (,, (with_template [<prng> <seed>]
+ [(_.coverage [<prng>]
+ (|> (distinct nat.equivalence /.nat)
+ (/.result (<prng> <seed>))
+ product.right))]
+
+ [/.pcg_32 increase,seed]
+ [/.xoroshiro_128+ increase,seed]
+ [/.split_mix_64 seed]
+ ))
+ (_.coverage [/.prng]
+ (|> (distinct nat.equivalence /.nat)
+ (/.result (/.prng ++ (|>> .i64) seed))
+ product.right))
+ ))
+ ))))