diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/library/lux/control/exception.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/library/lux/control/function/variadic.lux | 68 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 17 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function/variadic.lux | 76 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math/random.lux | 243 |
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)) + )) + )))) |