diff options
| author | Eduardo Julian | 2019-02-05 19:09:31 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2019-02-05 19:09:31 -0400 |
| commit | 47b97c128bde837fa803a605f3e011a3e9ddd71c (patch) | |
| tree | 5e8a84d1b1812ec4a157d4049c778ec2e4e434c4 /stdlib/test | |
| parent | be5710d104e6ee085dcb9d871be0b80305e48f8b (diff) | |
Integrated tests into normal source code.
Diffstat (limited to 'stdlib/test')
95 files changed, 0 insertions, 9581 deletions
diff --git a/stdlib/test/test.lux b/stdlib/test/test.lux deleted file mode 100644 index f5b23ac95..000000000 --- a/stdlib/test/test.lux +++ /dev/null @@ -1,195 +0,0 @@ -(.module: - [lux #* - [cli (#+ program:)] - ["." io (#+ io)] - ["_" test] - - ## These modules do not need to be tested. - [type - [variance (#+)]] - [locale (#+) - [language (#+)] - [territory (#+)]] - - ## TODO: Test these modules - [data - [format - [css (#+)] - [markdown (#+)]]] - ## [control - ## ["._" contract] - ## ["._" concatenative] - ## ["._" predicate] - ## [monad - ## ["._" free]]] - ## [data - ## ["._" env] - ## ["._" trace] - ## ["._" store] - ## [format - ## ["._" context] - ## ["._" html] - ## ["._" css] - ## ["._" binary]] - ## [collection - ## [tree - ## [rose - ## ["._" parser]]] - ## [dictionary - ## ["._" plist]] - ## [set - ## ["._" multi]]] - ## [text - ## ["._" buffer]]] - ## ["._" macro - ## [poly - ## ["._" json]]] - ## [type - ## ["._" unit] - ## ["._" refinement] - ## ["._" quotient]] - ## [world - ## ["._" environment] - ## ["._" console]] - ## [compiler - ## [host - ## [".H" scheme]] - ## ["._" cli] - ## ["._" default - ## ["._" evaluation] - ## [phase - ## ["._" translation - ## [scheme - ## ["._scheme" primitive] - ## ["._scheme" structure] - ## ["._scheme" reference] - ## ["._scheme" function] - ## ["._scheme" loop] - ## ["._scheme" case] - ## ["._scheme" extension] - ## ["._scheme" extension/common] - ## ["._scheme" expression]]] - ## [extension - ## ["._" statement]]] - ## ["._default" cache]] - ## [meta - ## ["._meta" io - ## ["._meta_io" context] - ## ["._meta_io" archive]] - ## ["._meta" archive] - ## ["._meta" cache]]] - ## ["._" interpreter - ## ["._interpreter" type]] - ] - ## TODO: Must have 100% coverage on tests. - [/ - ["/." lux - ## [control - ## ## [interval (#+)] - ## ## [pipe (#+)] - ## ## [continuation (#+)] - ## ## [reader (#+)] - ## ## [writer (#+)] - ## ## [state (#+)] - ## ## [parser (#+)] - ## ## [thread (#+)] - ## ## [region (#+)] - ## ## [security - ## ## [privacy (#+)] - ## ## [integrity (#+)]] - ## [concurrency - ## [actor (#+)] - ## [atom (#+)] - ## [frp (#+)] - ## [promise (#+)] - ## [stm (#+)] - ## ## [semaphore (#+)] - ## ]] - ## [data - ## [bit (#+)] - ## [color (#+)] - ## [error (#+)] - ## [name (#+)] - ## [identity (#+)] - ## [lazy (#+)] - ## [maybe (#+)] - ## [product (#+)] - ## [sum (#+)] - ## [number (#+) ## TODO: FIX Specially troublesome... - ## [i64 (#+)] - ## [ratio (#+)] - ## [complex (#+)]] - ## [text (#+) - ## ## [format (#+)] - ## [lexer (#+)] - ## [regex (#+)]] - ## [format - ## ## [json (#+)] - ## [xml (#+)]] - ## ## [collection - ## ## [array (#+)] - ## ## [bits (#+)] - ## ## [list (#+)] - ## ## [stack (#+)] - ## ## [row (#+)] - ## ## [sequence (#+)] - ## ## [dictionary (#+) - ## ## ["dictionary_." ordered]] - ## ## [set (#+) - ## ## ["set_." ordered]] - ## ## [queue (#+) - ## ## [priority (#+)]] - ## ## [tree - ## ## [rose (#+) - ## ## [zipper (#+)]]]] - ## ] - ## [math (#+) - ## [random (#+)] - ## [modular (#+)] - ## [logic - ## [continuous (#+)] - ## [fuzzy (#+)]]] - ## [macro - ## [code (#+)] - ## [syntax (#+)] - ## [poly - ## ["poly_." equivalence] - ## ["poly_." functor]]] - ## [type ## (#+) - ## ## [check (#+)] - ## ## [implicit (#+)] ## TODO: FIX Specially troublesome... - ## ## [resource (#+)] - ## [dynamic (#+)]] - ## [time - ## [instant (#+)] - ## [duration (#+)] - ## [date (#+)]] - ## [compiler - ## [default - ## ["_default/." syntax] - ## [phase - ## [analysis - ## ["_.A" primitive] - ## ["_.A" structure] - ## ["_.A" reference] - ## ["_.A" case] - ## ["_.A" function] - ## [procedure - ## ["_.A" common]]] - ## [synthesis - ## ["_.S" primitive] - ## ["_.S" structure] - ## ["_.S" case] - ## ["_.S" function]]]]] - ## [world - ## [binary (#+)] - ## [file (#+)] - ## [net - ## [tcp (#+)] - ## [udp (#+)]]] - ]] - ) - -(program: args - (io (_.run! (<| (_.times 100) - /lux.test)))) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux deleted file mode 100644 index f47d9302f..000000000 --- a/stdlib/test/test/lux.lux +++ /dev/null @@ -1,248 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - [predicate (#+ Predicate)]] - [data - [number - ["." i64]]] - ["." function] - ["." math - ["r" random (#+ Random) ("r/." functor)]] - ["_" test (#+ Test)]] - [/ - ["/." cli] - ["/." io] - ["/." host - ["/." jvm]] - ["/." control]]) - -(def: identity - Test - (do r.monad - [self (r.unicode 1)] - ($_ _.and - (_.test "Every value is identical to itself." - (is? self self)) - (_.test "The identity function doesn't change values in any way." - (is? self (function.identity self))) - (do @ - [other (r.unicode 1)] - (_.test "Values created separately can't be identical." - (not (is? self other)))) - ))) - -(def: increment-and-decrement - Test - (do r.monad - [value r.i64] - ($_ _.and - (_.test "'inc' and 'dec' are different." - (not (n/= (inc value) - (dec value)))) - (_.test "'inc' and 'dec' are opposites." - (and (|> value inc dec (n/= value)) - (|> value dec inc (n/= value)))) - (_.test "'inc' and 'dec' shift the number by 1." - (let [shift 1] - (and (n/= (n/+ shift value) - (inc value)) - (n/= (n/- shift value) - (dec value)))))))) - -(def: (check-neighbors has-property? value) - (All [a] (-> (Predicate (I64 a)) (I64 a) Bit)) - (and (|> value inc has-property?) - (|> value dec has-property?))) - -(def: (even-or-odd rand-gen even? odd?) - (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) - (do r.monad - [value rand-gen] - ($_ _.and - (_.test "Every number is either even or odd." - (if (even? value) - (not (odd? value)) - (odd? value))) - (_.test "Every odd/even number is surrounded by two of the other kind." - (if (even? value) - (check-neighbors odd? value) - (check-neighbors even? value)))))) - -(type: (Choice a) - (-> a a a)) - -(type: (Order a) - (-> a a Bit)) - -(type: (Equivalence a) - (-> a a Bit)) - -(def: (choice rand-gen = [< choose]) - (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) - (do r.monad - [left rand-gen - right rand-gen - #let [choice (choose left right)]] - ($_ _.and - (_.test "The choice between 2 values is one of them." - (or (= left choice) - (= right choice))) - (_.test "The choice between 2 values implies an order relationship between them." - (if (= left choice) - (< right choice) - (< left choice)))))) - -(def: (minimum-and-maximum rand-gen = min' max') - (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test)) - ($_ _.and - (<| (_.context "Minimum.") - (choice rand-gen = min')) - (<| (_.context "Maximum.") - (choice rand-gen = max')))) - -(def: (conversion rand-gen forward backward =) - (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) - (do r.monad - [value rand-gen] - (_.test "Can convert between types in a lossless way." - (|> value forward backward (= value))))) - -(def: frac-rev - (r.Random Rev) - (|> r.rev - (:: r.functor map (|>> (i64.left-shift 11) (i64.logical-right-shift 11))))) - -(def: prelude-macros - Test - ($_ _.and - (do r.monad - [factor (r/map (|>> (n/% 10) (n/max 1)) r.nat) - iterations (r/map (n/% 100) r.nat) - #let [expected (n/* factor iterations)]] - (_.test "Can write loops." - (n/= expected - (loop [counter 0 - value 0] - (if (n/< iterations counter) - (recur (inc counter) (n/+ factor value)) - value))))) - - (do r.monad - [first r.nat - second r.nat - third r.nat] - (_.test "Can create lists easily through macros." - (and (case (list first second third) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n/= first first') - (n/= second second') - (n/= third third')) - - _ - false) - (case (list& first (list second third)) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n/= first first') - (n/= second second') - (n/= third third')) - - _ - false) - (case (list& first second (list third)) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n/= first first') - (n/= second second') - (n/= third third')) - - _ - false)))) - )) - -(template: (hypotenuse cat0 cat1) - (n/+ (n/* cat0 cat0) (n/* cat1 cat1))) - -(def: template - Test - (do r.monad - [cat0 r.nat - cat1 r.nat] - (_.test "Template application is a stand-in for the templated code." - (n/= (n/+ (n/* cat0 cat0) (n/* cat1 cat1)) - (hypotenuse cat0 cat1))))) - -(def: cross-platform-support - Test - (do r.monad - [on-default r.nat - on-fake-host r.nat - on-valid-host r.nat] - ($_ _.and - (_.test "Can provide default in case there is no particular host/platform support." - (n/= on-default - (for {"" on-fake-host} - on-default))) - (_.test "Can pick code depending on the host/platform being targeted." - (n/= on-valid-host - (for {"JVM" on-valid-host - "JS" on-valid-host} - on-default)))))) - -(def: #export test - ($_ _.and - (<| (_.context "Identity.") - ..identity) - (<| (_.context "Increment & decrement.") - ..increment-and-decrement) - (<| (_.context "Even or odd.") - ($_ _.and - (<| (_.context "Natural numbers.") - (..even-or-odd r.nat n/even? n/odd?)) - (<| (_.context "Integers.") - (..even-or-odd r.int i/even? i/odd?)))) - (<| (_.context "Minimum and maximum.") - (`` ($_ _.and - (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>] - [(<| (_.context <context>) - (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] - - [i/= i/< i/min i/> i/max r.int "Integers."] - [n/= n/< n/min n/> n/max r.nat "Natural numbers."] - [r/= r/< r/min r/> r/max r.rev "Revolutions."] - [f/= f/< f/min f/> f/max r.frac "Fractions."] - ))))) - (<| (_.context "Conversion.") - (`` ($_ _.and - (~~ (do-template [<context> <=> <forward> <backward> <gen>] - [(<| (_.context <context>) - (..conversion <gen> <forward> <backward> <=>))] - - ["Int -> Nat" - i/= .nat .int (r/map (i/% +1_000_000) r.int)] - ["Nat -> Int" - n/= .int .nat (r/map (n/% 1_000_000) r.nat)] - ["Int -> Frac" - i/= int-to-frac frac-to-int (r/map (i/% +1_000_000) r.int)] - ["Frac -> Int" - f/= frac-to-int int-to-frac (r/map math.floor r.frac)] - ["Rev -> Frac" - r/= rev-to-frac frac-to-rev frac-rev] - ))))) - (<| (_.context "Prelude macros.") - ..prelude-macros) - (<| (_.context "Templates.") - ..template) - (<| (_.context "Cross-platform support.") - ..cross-platform-support) - (<| (_.context "/cli Command-Line Interface.") - /cli.test) - (<| (_.context "/io I/O (input/output)") - /io.test) - (<| (_.context "/host Host-platform interoperation") - ($_ _.and - /host.test - (<| (_.context "/jvm JVM (Java Virtual Machine)") - /jvm.test))) - (<| (_.context "/control") - /control.test) - )) diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux deleted file mode 100644 index e202b3aa7..000000000 --- a/stdlib/test/test/lux/cli.lux +++ /dev/null @@ -1,75 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)] - pipe - ["p" parser]] - [data - ["." error] - [number - ["." nat ("nat/." decimal)]] - [text ("text/." equivalence) - format] - [collection - ["." list]]] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." /]}) - -(def: #export test - Test - (do r.monad - [num-args (|> r.nat (:: @ map (n/% 10))) - #let [gen-arg (:: @ map nat/encode r.nat)] - yes gen-arg - #let [gen-ignore (r.filter (|>> (text/= yes) not) - (r.unicode 5))] - no gen-ignore - pre-ignore (r.list 5 gen-ignore) - post-ignore (r.list 5 gen-ignore)] - ($_ _.and - (_.test "Can read any argument." - (|> (/.run (list yes) /.any) - (case> (#error.Failure _) - #0 - - (#error.Success arg) - (text/= arg yes)))) - (_.test "Can test tokens." - (and (|> (/.run (list yes) (/.this yes)) - (case> (#error.Failure _) - #0 - - (#error.Success _) - #1)) - (|> (/.run (list no) (/.this yes)) - (case> (#error.Failure _) - #1 - - (#error.Success _) - #0)))) - (_.test "Can use custom token parsers." - (|> (/.run (list yes) (/.parse nat/decode)) - (case> (#error.Failure _) - #0 - - (#error.Success parsed) - (text/= (nat/encode parsed) - yes)))) - (_.test "Can query if there are any more inputs." - (and (|> (/.run (list) /.end) - (case> (#error.Success []) #1 _ #0)) - (|> (/.run (list yes) (p.not /.end)) - (case> (#error.Success []) #0 _ #1)))) - (_.test "Can parse CLI input anywhere." - (|> (/.run (list.concat (list pre-ignore (list yes) post-ignore)) - (|> (/.somewhere (/.this yes)) - (p.before (p.some /.any)))) - (case> (#error.Failure _) - #0 - - (#error.Success _) - #1))) - ))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux deleted file mode 100644 index 2bf02bb0e..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux +++ /dev/null @@ -1,198 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)] - pipe] - [data - ["." product] - ["." maybe] - ["." text ("text/." equivalence)] - [collection - ["." list ("list/." monad)] - ["." set]]] - [math - ["r" random ("random/." monad)]] - ["." type - ["." check]] - [macro - ["." code]] - [compiler - [default - ["." phase - ["." analysis - ["." module] - [".A" type] - ["/" case]]]]] - test] - [// - ["_." primitive] - ["_." structure]]) - -(def: (exhaustive-weaving branchings) - (-> (List (List Code)) (List (List Code))) - (case branchings - #.Nil - #.Nil - - (#.Cons head+ #.Nil) - (list/map (|>> list) head+) - - (#.Cons head+ tail++) - (do list.monad - [tail+ (exhaustive-weaving tail++) - head head+] - (wrap (#.Cons head tail+))))) - -(def: #export (exhaustive-branches allow-literals? variantTC inputC) - (-> Bit (List [Code Code]) Code (r.Random (List Code))) - (case inputC - [_ (#.Bit _)] - (random/wrap (list (' #1) (' #0))) - - (^template [<tag> <gen> <wrapper>] - [_ (<tag> _)] - (if allow-literals? - (do r.monad - [?sample (r.maybe <gen>)] - (case ?sample - (#.Some sample) - (do @ - [else (exhaustive-branches allow-literals? variantTC inputC)] - (wrap (list& (<wrapper> sample) else))) - - #.None - (wrap (list (' _))))) - (random/wrap (list (' _))))) - ([#.Nat r.nat code.nat] - [#.Int r.int code.int] - [#.Rev r.rev code.rev] - [#.Frac r.frac code.frac] - [#.Text (r.unicode 5) code.text]) - - (^ [_ (#.Tuple (list))]) - (random/wrap (list (' []))) - - (^ [_ (#.Record (list))]) - (random/wrap (list (' {}))) - - [_ (#.Tuple members)] - (do r.monad - [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] - (wrap (|> member-wise-patterns - exhaustive-weaving - (list/map code.tuple)))) - - [_ (#.Record kvs)] - (do r.monad - [#let [ks (list/map product.left kvs) - vs (list/map product.right kvs)] - member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)] - (wrap (|> member-wise-patterns - exhaustive-weaving - (list/map (|>> (list.zip2 ks) code.record))))) - - (^ [_ (#.Form (list [_ (#.Tag _)] _))]) - (do r.monad - [bundles (monad.map @ - (function (_ [_tag _code]) - (do @ - [v-branches (exhaustive-branches allow-literals? variantTC _code)] - (wrap (list/map (function (_ pattern) (` ((~ _tag) (~ pattern)))) - v-branches)))) - variantTC)] - (wrap (list/join bundles))) - - _ - (random/wrap (list)) - )) - -(def: #export (input variant-tags record-tags primitivesC) - (-> (List Code) (List Code) (List Code) (r.Random Code)) - (r.rec - (function (_ input) - ($_ r.either - (random/map product.right _primitive.primitive) - (do r.monad - [choice (|> r.nat (:: @ map (n/% (list.size variant-tags)))) - #let [choiceT (maybe.assume (list.nth choice variant-tags)) - choiceC (maybe.assume (list.nth choice primitivesC))]] - (wrap (` ((~ choiceT) (~ choiceC))))) - (do r.monad - [size (|> r.nat (:: @ map (n/% 3))) - elems (r.list size input)] - (wrap (code.tuple elems))) - (random/wrap (code.record (list.zip2 record-tags primitivesC))) - )))) - -(def: (branch body pattern) - (-> Code Code [Code Code]) - [pattern body]) - -(context: "Pattern-matching." - ## #seed 9253409297339902486 - ## #seed 3793366152923578600 - (<| (seed 5004137551292836565) - ## (times 100) - (do @ - [module-name (r.unicode 5) - variant-name (r.unicode 5) - record-name (|> (r.unicode 5) (r.filter (|>> (text/= variant-name) not))) - size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - primitivesTC (r.list size _primitive.primitive) - #let [primitivesT (list/map product.left primitivesTC) - primitivesC (list/map product.right primitivesTC) - code-tag (|>> [module-name] code.tag) - variant-tags+ (list/map code-tag variant-tags) - record-tags+ (list/map code-tag record-tags) - variantTC (list.zip2 variant-tags+ primitivesC)] - inputC (input variant-tags+ record-tags+ primitivesC) - [outputT outputC] _primitive.primitive - [heterogeneousT heterogeneousC] (r.filter (|>> product.left (check.checks? outputT) not) - _primitive.primitive) - exhaustive-patterns (exhaustive-branches #1 variantTC inputC) - redundant-patterns (exhaustive-branches #0 variantTC inputC) - redundancy-idx (|> r.nat (:: @ map (n/% (list.size redundant-patterns)))) - heterogeneous-idx (|> r.nat (:: @ map (n/% (list.size exhaustive-patterns)))) - #let [exhaustive-branchesC (list/map (branch outputC) - exhaustive-patterns) - non-exhaustive-branchesC (list.take (dec (list.size exhaustive-branchesC)) - exhaustive-branchesC) - redundant-branchesC (<| (list/map (branch outputC)) - list.concat - (list (list.take redundancy-idx redundant-patterns) - (list (maybe.assume (list.nth redundancy-idx redundant-patterns))) - (list.drop redundancy-idx redundant-patterns))) - heterogeneous-branchesC (list.concat (list (list.take heterogeneous-idx exhaustive-branchesC) - (list (let [[_pattern _body] (maybe.assume (list.nth heterogeneous-idx exhaustive-branchesC))] - [_pattern heterogeneousC])) - (list.drop (inc heterogeneous-idx) exhaustive-branchesC))) - analyse-pm (|>> (/.case _primitive.phase inputC) - (typeA.with-type outputT) - analysis.with-scope - (do phase.monad - [_ (module.declare-tags variant-tags #0 - (#.Named [module-name variant-name] - (type.variant primitivesT))) - _ (module.declare-tags record-tags #0 - (#.Named [module-name record-name] - (type.tuple primitivesT)))]) - (module.with-module 0 module-name))]] - ($_ seq - (test "Will reject empty pattern-matching (no branches)." - (|> (analyse-pm (list)) - _structure.check-fails)) - (test "Can analyse exhaustive pattern-matching." - (|> (analyse-pm exhaustive-branchesC) - _structure.check-succeeds)) - (test "Will reject non-exhaustive pattern-matching." - (|> (analyse-pm non-exhaustive-branchesC) - _structure.check-fails)) - (test "Will reject redundant pattern-matching." - (|> (analyse-pm redundant-branchesC) - _structure.check-fails)) - (test "Will reject pattern-matching if the bodies of the branches do not all have the same type." - (|> (analyse-pm heterogeneous-branchesC) - _structure.check-fails))) - ))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux deleted file mode 100644 index 0ec5d4766..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux +++ /dev/null @@ -1,118 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error] - ["." maybe] - ["." product] - [text ("text/." equivalence) - format] - [collection - ["." list ("list/." functor)]]] - [math - ["r" random]] - ["." type] - ["." macro - ["." code]] - [compiler - [default - ["." reference] - ["." init] - ["." phase - ["." analysis (#+ Analysis Operation) - [".A" type] - ["." expression] - ["/" function]] - [extension - [".E" analysis]]]]] - test] - [// - ["_." primitive] - ["_." structure]]) - -(def: (check-apply expectedT num-args analysis) - (-> Type Nat (Operation Analysis) Bit) - (|> analysis - (typeA.with-type expectedT) - (phase.run _primitive.state) - (case> (#error.Success applyA) - (let [[funcA argsA] (analysis.application applyA)] - (n/= num-args (list.size argsA))) - - (#error.Failure error) - #0))) - -(context: "Function definition." - (<| (times 100) - (do @ - [func-name (r.unicode 5) - arg-name (|> (r.unicode 5) (r.filter (|>> (text/= func-name) not))) - [outputT outputC] _primitive.primitive - [inputT _] _primitive.primitive - #let [g!arg (code.local-identifier arg-name)]] - ($_ seq - (test "Can analyse function." - (and (|> (typeA.with-type (All [a] (-> a outputT)) - (/.function _primitive.phase func-name arg-name outputC)) - _structure.check-succeeds) - (|> (typeA.with-type (All [a] (-> a a)) - (/.function _primitive.phase func-name arg-name g!arg)) - _structure.check-succeeds))) - (test "Generic functions can always be specialized." - (and (|> (typeA.with-type (-> inputT outputT) - (/.function _primitive.phase func-name arg-name outputC)) - _structure.check-succeeds) - (|> (typeA.with-type (-> inputT inputT) - (/.function _primitive.phase func-name arg-name g!arg)) - _structure.check-succeeds))) - (test "The function's name is bound to the function's type." - (|> (typeA.with-type (Rec self (-> inputT self)) - (/.function _primitive.phase func-name arg-name (code.local-identifier func-name))) - _structure.check-succeeds)) - )))) - -(context: "Function application." - (<| (times 100) - (do @ - [full-args (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - partial-args (|> r.nat (:: @ map (n/% full-args))) - var-idx (|> r.nat (:: @ map (|>> (n/% full-args) (n/max 1)))) - inputsTC (r.list full-args _primitive.primitive) - #let [inputsT (list/map product.left inputsTC) - inputsC (list/map product.right inputsTC)] - [outputT outputC] _primitive.primitive - #let [funcT (type.function inputsT outputT) - partialT (type.function (list.drop partial-args inputsT) outputT) - varT (#.Parameter 1) - polyT (<| (type.univ-q 1) - (type.function (list.concat (list (list.take var-idx inputsT) - (list varT) - (list.drop (inc var-idx) inputsT)))) - varT) - poly-inputT (maybe.assume (list.nth var-idx inputsT)) - partial-poly-inputsT (list.drop (inc var-idx) inputsT) - partial-polyT1 (<| (type.function partial-poly-inputsT) - poly-inputT) - partial-polyT2 (<| (type.univ-q 1) - (type.function (#.Cons varT partial-poly-inputsT)) - varT) - dummy-function (#analysis.Function (list) (#analysis.Reference (reference.local 1)))]] - ($_ seq - (test "Can analyse monomorphic type application." - (|> (/.apply _primitive.phase funcT dummy-function inputsC) - (check-apply outputT full-args))) - (test "Can partially apply functions." - (|> (/.apply _primitive.phase funcT dummy-function (list.take partial-args inputsC)) - (check-apply partialT partial-args))) - (test "Can apply polymorphic functions." - (|> (/.apply _primitive.phase polyT dummy-function inputsC) - (check-apply poly-inputT full-args))) - (test "Polymorphic partial application propagates found type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (list.take (inc var-idx) inputsC)) - (check-apply partial-polyT1 (inc var-idx)))) - (test "Polymorphic partial application preserves quantification for type-vars." - (|> (/.apply _primitive.phase polyT dummy-function (list.take var-idx inputsC)) - (check-apply partial-polyT2 var-idx))) - )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux deleted file mode 100644 index de079094b..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux +++ /dev/null @@ -1,100 +0,0 @@ -(.module: - [lux (#- primitive) - [control - [monad (#+ do)] - pipe - ["ex" exception (#+ exception:)]] - [data - ["." error (#+ Error)] - [text - format]] - [math - ["r" random ("random/." monad)]] - [".L" type ("type/." equivalence)] - [macro - ["." code]] - [compiler - [default - ["." init] - [evaluation (#+ Eval)] - ["." phase - ["." analysis (#+ Analysis Operation) - [".A" type] - ["." expression]] - [extension - [".E" analysis]]]]] - test]) - -(def: #export phase - analysis.Phase - expression.compile) - -(def: #export state - analysis.State+ - [(analysisE.bundle (:coerce Eval [])) (init.compiler [])]) - -(def: unit - (r.Random Code) - (random/wrap (' []))) - -(def: #export primitive - (r.Random [Type Code]) - (`` ($_ r.either - (~~ (do-template [<type> <code-wrapper> <value-gen>] - [(r.and (random/wrap <type>) (random/map <code-wrapper> <value-gen>))] - - [Any code.tuple (r.list 0 ..unit)] - [Bit code.bit r.bit] - [Nat code.nat r.nat] - [Int code.int r.int] - [Rev code.rev r.rev] - [Frac code.frac r.frac] - [Text code.text (r.unicode 5)] - ))))) - -(exception: (wrong-inference {expected Type} {inferred Type}) - (ex.report ["Expected" (%type expected)] - ["Inferred" (%type inferred)])) - -(def: (infer-primitive expected-type analysis) - (-> Type (Operation Analysis) (Error Analysis)) - (|> analysis - typeA.with-inference - (phase.run ..state) - (case> (#error.Success [inferred-type output]) - (if (is? expected-type inferred-type) - (#error.Success output) - (ex.throw wrong-inference [expected-type inferred-type])) - - (#error.Failure error) - (#error.Failure error)))) - -(context: "Primitives" - ($_ seq - (test "Can analyse unit." - (|> (infer-primitive Any (..phase (' []))) - (case> (^ (#error.Success (#analysis.Primitive (#analysis.Unit output)))) - (is? [] output) - - _ - #0))) - (<| (times 100) - (`` ($_ seq - (~~ (do-template [<desc> <type> <tag> <random> <constructor>] - [(do @ - [sample <random>] - (test (format "Can analyse " <desc> ".") - (|> (infer-primitive <type> (..phase (<constructor> sample))) - (case> (#error.Success (#analysis.Primitive (<tag> output))) - (is? sample output) - - _ - #0))))] - - ["bit" Bit #analysis.Bit r.bit code.bit] - ["nat" Nat #analysis.Nat r.nat code.nat] - ["int" Int #analysis.Int r.int code.int] - ["rev" Rev #analysis.Rev r.rev code.rev] - ["frac" Frac #analysis.Frac r.frac code.frac] - ["text" Text #analysis.Text (r.unicode 5) code.text] - ))))))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux deleted file mode 100644 index 6576ae90d..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ /dev/null @@ -1,187 +0,0 @@ -(.module: - [lux #* - [io] - [control - [monad (#+ do)] - pipe] - [concurrency - ["." atom]] - [data - ["." error] - ["." product] - [text - format]] - [math - ["r" random]] - [type ("type/." equivalence)] - [macro - ["." code]] - [compiler - [default - ["." init] - ["." phase - [analysis - ["." scope] - [".A" type]] - [extension - [".E" analysis]]]]] - test] - [/// - ["_." primitive]]) - -(do-template [<name> <success> <failure>] - [(def: (<name> procedure params output-type) - (-> Text (List Code) Type Bit) - (|> (scope.with-scope "" - (typeA.with-type output-type - (_primitive.phase (` ((~ (code.text procedure)) (~+ params)))))) - (phase.run _primitive.state) - (case> (#error.Success _) - <success> - - (#error.Failure error) - <failure>)))] - - [check-success+ #1 #0] - [check-failure+ #0 #1] - ) - -(context: "Lux procedures" - (<| (times 100) - (do @ - [[primT primC] _primitive.primitive - [antiT antiC] (|> _primitive.primitive - (r.filter (|>> product.left (type/= primT) not)))] - ($_ seq - (test "Can test for reference equality." - (check-success+ "lux is" (list primC primC) Bit)) - (test "Reference equality must be done with elements of the same type." - (check-failure+ "lux is" (list primC antiC) Bit)) - (test "Can 'try' risky IO computations." - (check-success+ "lux try" - (list (` ([(~' _) (~' _)] (~ primC)))) - (type (Either Text primT)))) - )))) - -(context: "Bit procedures" - (<| (times 100) - (do @ - [subjectC (|> r.nat (:: @ map code.nat)) - signedC (|> r.int (:: @ map code.int)) - paramC (|> r.nat (:: @ map code.nat))] - ($_ seq - (test "Can perform bit 'and'." - (check-success+ "lux bit and" (list subjectC paramC) Nat)) - (test "Can perform bit 'or'." - (check-success+ "lux bit or" (list subjectC paramC) Nat)) - (test "Can perform bit 'xor'." - (check-success+ "lux bit xor" (list subjectC paramC) Nat)) - (test "Can shift bit pattern to the left." - (check-success+ "lux bit left-shift" (list subjectC paramC) Nat)) - (test "Can shift bit pattern to the right." - (check-success+ "lux bit logical-right-shift" (list subjectC paramC) Nat)) - (test "Can shift signed bit pattern to the right." - (check-success+ "lux bit arithmetic-right-shift" (list signedC paramC) Int)) - )))) - -(context: "Int procedures" - (<| (times 100) - (do @ - [subjectC (|> r.int (:: @ map code.int)) - paramC (|> r.int (:: @ map code.int))] - ($_ seq - (test "Can add integers." - (check-success+ "lux int +" (list subjectC paramC) Int)) - (test "Can subtract integers." - (check-success+ "lux int -" (list subjectC paramC) Int)) - (test "Can multiply integers." - (check-success+ "lux int *" (list subjectC paramC) Int)) - (test "Can divide integers." - (check-success+ "lux int /" (list subjectC paramC) Int)) - (test "Can calculate remainder of integers." - (check-success+ "lux int %" (list subjectC paramC) Int)) - (test "Can test equivalence of integers." - (check-success+ "lux int =" (list subjectC paramC) Bit)) - (test "Can compare integers." - (check-success+ "lux int <" (list subjectC paramC) Bit)) - (test "Can convert integer to fraction." - (check-success+ "lux int to-frac" (list subjectC) Frac)) - (test "Can convert integer to text." - (check-success+ "lux int char" (list subjectC) Text)) - )))) - -(context: "Frac procedures" - (<| (times 100) - (do @ - [subjectC (|> r.frac (:: @ map code.frac)) - paramC (|> r.frac (:: @ map code.frac)) - encodedC (|> (r.unicode 5) (:: @ map code.text))] - ($_ seq - (test "Can add frac numbers." - (check-success+ "lux frac +" (list subjectC paramC) Frac)) - (test "Can subtract frac numbers." - (check-success+ "lux frac -" (list subjectC paramC) Frac)) - (test "Can multiply frac numbers." - (check-success+ "lux frac *" (list subjectC paramC) Frac)) - (test "Can divide frac numbers." - (check-success+ "lux frac /" (list subjectC paramC) Frac)) - (test "Can calculate remainder of frac numbers." - (check-success+ "lux frac %" (list subjectC paramC) Frac)) - (test "Can test equivalence of frac numbers." - (check-success+ "lux frac =" (list subjectC paramC) Bit)) - (test "Can compare frac numbers." - (check-success+ "lux frac <" (list subjectC paramC) Bit)) - (test "Can obtain minimum frac number." - (check-success+ "lux frac min" (list) Frac)) - (test "Can obtain maximum frac number." - (check-success+ "lux frac max" (list) Frac)) - (test "Can obtain smallest frac number." - (check-success+ "lux frac smallest" (list) Frac)) - (test "Can convert frac number to integer." - (check-success+ "lux frac to-int" (list subjectC) Int)) - (test "Can convert frac number to text." - (check-success+ "lux frac encode" (list subjectC) Text)) - (test "Can convert text to frac number." - (check-success+ "lux frac decode" (list encodedC) (type (Maybe Frac)))) - )))) - -(context: "Text procedures" - (<| (times 100) - (do @ - [subjectC (|> (r.unicode 5) (:: @ map code.text)) - paramC (|> (r.unicode 5) (:: @ map code.text)) - replacementC (|> (r.unicode 5) (:: @ map code.text)) - fromC (|> r.nat (:: @ map code.nat)) - toC (|> r.nat (:: @ map code.nat))] - ($_ seq - (test "Can test text equivalence." - (check-success+ "lux text =" (list subjectC paramC) Bit)) - (test "Compare texts in lexicographical order." - (check-success+ "lux text <" (list subjectC paramC) Bit)) - (test "Can concatenate one text to another." - (check-success+ "lux text concat" (list subjectC paramC) Text)) - (test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check-success+ "lux text index" (list subjectC paramC fromC) (type (Maybe Nat)))) - (test "Can query the size/length of a text." - (check-success+ "lux text size" (list subjectC) Nat)) - (test "Can obtain the character code of a text at a given index." - (check-success+ "lux text char" (list subjectC fromC) Nat)) - (test "Can clip a piece of text between 2 indices." - (check-success+ "lux text clip" (list subjectC fromC toC) Text)) - )))) - -(context: "IO procedures" - (<| (times 100) - (do @ - [logC (|> (r.unicode 5) (:: @ map code.text)) - exitC (|> r.int (:: @ map code.int))] - ($_ seq - (test "Can log messages to standard output." - (check-success+ "lux io log" (list logC) Any)) - (test "Can throw a run-time error." - (check-success+ "lux io error" (list logC) Nothing)) - (test "Can exit the program." - (check-success+ "lux io exit" (list exitC) Nothing)) - (test "Can query the current time (as milliseconds since epoch)." - (check-success+ "lux io current-time" (list) Int)) - )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux deleted file mode 100644 index 18ab58fa9..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux +++ /dev/null @@ -1,107 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error (#+ Error)] - [name ("name/." equivalence)] - [text ("text/." equivalence)]] - [math - ["r" random]] - [type ("type/." equivalence)] - [macro - ["." code]] - [compiler - [default - ["." reference] - ["." init] - ["." phase - ["." analysis - ["." scope] - ["." module] - [".A" type] - ["." expression]] - [extension - [".E" analysis]]]]] - test] - [// - ["_." primitive]]) - -(type: Check (-> (Error Any) Bit)) - -(do-template [<name> <on-success> <on-failure>] - [(def: <name> - Check - (|>> (case> (#error.Success _) - <on-success> - - (#error.Failure _) - <on-failure>)))] - - [success? #1 #0] - [failure? #0 #1] - ) - -(def: (reach-test var-name [export? def-module] [import? dependent-module] check!) - (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do phase.monad - [_ (module.with-module 0 def-module - (module.define var-name [Any - (if export? - (' {#.export? #1}) - (' {})) - []]))] - (module.with-module 0 dependent-module - (do @ - [_ (if import? - (module.import def-module) - (wrap []))] - (typeA.with-inference - (_primitive.phase (code.identifier [def-module var-name])))))) - (phase.run _primitive.state) - check!)) - -(context: "References" - (<| (times 100) - (do @ - [[expectedT _] _primitive.primitive - def-module (r.unicode 5) - scope-name (r.unicode 5) - var-name (r.unicode 5) - dependent-module (|> (r.unicode 5) - (r.filter (|>> (text/= def-module) not)))] - ($_ seq - (test "Can analyse variable." - (|> (scope.with-scope scope-name - (scope.with-local [var-name expectedT] - (typeA.with-inference - (_primitive.phase (code.local-identifier var-name))))) - (phase.run _primitive.state) - (case> (^ (#error.Success [inferredT (#analysis.Reference (reference.local var))])) - (and (type/= expectedT inferredT) - (n/= 0 var)) - - _ - #0))) - (test "Can analyse definition (in the same module)." - (let [def-name [def-module var-name]] - (|> (do phase.monad - [_ (module.define var-name [expectedT (' {}) []])] - (typeA.with-inference - (_primitive.phase (code.identifier def-name)))) - (module.with-module 0 def-module) - (phase.run _primitive.state) - (case> (^ (#error.Success [_ inferredT (#analysis.Reference (reference.constant constant-name))])) - (and (type/= expectedT inferredT) - (name/= def-name constant-name)) - - _ - #0)))) - (test "Can analyse definition (if exported from imported module)." - (reach-test var-name [#1 def-module] [#1 dependent-module] success?)) - (test "Cannot analyse definition (if not exported from imported module)." - (reach-test var-name [#0 def-module] [#1 dependent-module] failure?)) - (test "Cannot analyse definition (if exported from non-imported module)." - (reach-test var-name [#1 def-module] [#0 dependent-module] failure?)) - )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux deleted file mode 100644 index 63c6da493..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux +++ /dev/null @@ -1,297 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - [bit ("bit/." equivalence)] - ["e" error] - ["." product] - ["." maybe] - ["." text] - [collection - ["." list ("list/." functor)] - ["." set]]] - [math - ["r" random]] - ["." type ("type/." equivalence) - ["." check]] - [macro - ["." code]] - [compiler - [default - ["." init] - ["." phase - ["." analysis (#+ Analysis Variant Tag Operation) - ["." module] - [".A" type] - ["/" structure] - ["." expression]] - [extension - [".E" analysis]]]]] - test] - [// - ["_." primitive]]) - -(do-template [<name> <on-success> <on-error>] - [(def: #export <name> - (All [a] (-> (Operation a) Bit)) - (|>> (phase.run _primitive.state) - (case> (#e.Success _) - <on-success> - - _ - <on-error>)))] - - [check-succeeds #1 #0] - [check-fails #0 #1] - ) - -(def: (check-sum' size tag variant) - (-> Nat Tag (Variant Analysis) Bit) - (let [variant-tag (if (get@ #analysis.right? variant) - (inc (get@ #analysis.lefts variant)) - (get@ #analysis.lefts variant))] - (|> size dec (n/= tag) - (bit/= (get@ #analysis.right? variant)) - (and (n/= tag variant-tag))))) - -(def: (check-sum type size tag analysis) - (-> Type Nat Tag (Operation Analysis) Bit) - (|> analysis - (typeA.with-type type) - (phase.run _primitive.state) - (case> (^ (#e.Success (analysis.variant variant))) - (check-sum' size tag variant) - - _ - #0))) - -(def: (tagged module tags type) - (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a]))) - (|>> (do phase.monad - [_ (module.declare-tags tags #0 type)]) - (module.with-module 0 module))) - -(def: (check-variant module tags type size tag analysis) - (-> Text (List module.Tag) Type Nat Tag (Operation Analysis) Bit) - (|> analysis - (tagged module tags type) - (typeA.with-type type) - (phase.run _primitive.state) - (case> (^ (#e.Success [_ (analysis.variant variant)])) - (check-sum' size tag variant) - - _ - #0))) - -(def: (right-size? size) - (-> Nat (-> Analysis Bit)) - (|>> (case> (^ (analysis.tuple elems)) - (|> elems - list.size - (n/= size)) - - _ - false))) - -(def: (check-record-inference module tags type size analysis) - (-> Text (List module.Tag) Type Nat (Operation [Type Analysis]) Bit) - (|> analysis - (tagged module tags type) - (phase.run _primitive.state) - (case> (#e.Success [_ productT productA]) - (and (type/= type productT) - (right-size? size productA)) - - _ - #0))) - -(context: "Sums" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - choice (|> r.nat (:: @ map (n/% size))) - primitives (r.list size _primitive.primitive) - +choice (|> r.nat (:: @ map (n/% (inc size)))) - [_ +valueC] _primitive.primitive - #let [variantT (type.variant (list/map product.left primitives)) - [valueT valueC] (maybe.assume (list.nth choice primitives)) - +size (inc size) - +primitives (list.concat (list (list.take choice primitives) - (list [(#.Parameter 1) +valueC]) - (list.drop choice primitives))) - [+valueT +valueC] (maybe.assume (list.nth +choice +primitives)) - +variantT (type.variant (list/map product.left +primitives))]] - ($_ seq - (test "Can analyse sum." - (check-sum variantT size choice - (/.sum _primitive.phase choice valueC))) - (test "Can analyse sum through bound type-vars." - (|> (do phase.monad - [[_ varT] (typeA.with-env check.var) - _ (typeA.with-env - (check.check varT variantT))] - (typeA.with-type varT - (/.sum _primitive.phase choice valueC))) - (phase.run _primitive.state) - (case> (^ (#e.Success (analysis.variant variant))) - (check-sum' size choice variant) - - _ - #0))) - (test "Cannot analyse sum through unbound type-vars." - (|> (do phase.monad - [[_ varT] (typeA.with-env check.var)] - (typeA.with-type varT - (/.sum _primitive.phase choice valueC))) - check-fails)) - (test "Can analyse sum through existential quantification." - (|> (typeA.with-type (type.ex-q 1 +variantT) - (/.sum _primitive.phase +choice +valueC)) - check-succeeds)) - (test "Can analyse sum through universal quantification." - (let [check-outcome (if (not (n/= choice +choice)) - check-succeeds - check-fails)] - (|> (typeA.with-type (type.univ-q 1 +variantT) - (/.sum _primitive.phase +choice +valueC)) - check-outcome))) - )))) - -(context: "Products" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - primitives (r.list size _primitive.primitive) - choice (|> r.nat (:: @ map (n/% size))) - [_ +valueC] _primitive.primitive - #let [tupleT (type.tuple (list/map product.left primitives)) - [singletonT singletonC] (|> primitives (list.nth choice) maybe.assume) - +primitives (list.concat (list (list.take choice primitives) - (list [(#.Parameter 1) +valueC]) - (list.drop choice primitives))) - +tupleT (type.tuple (list/map product.left +primitives))]] - ($_ seq - (test "Can analyse product." - (|> (typeA.with-type tupleT - (/.product _primitive.phase (list/map product.right primitives))) - (phase.run _primitive.state) - (case> (#e.Success tupleA) - (right-size? size tupleA) - - _ - #0))) - (test "Can infer product." - (|> (typeA.with-inference - (/.product _primitive.phase (list/map product.right primitives))) - (phase.run _primitive.state) - (case> (#e.Success [_type tupleA]) - (and (type/= tupleT _type) - (right-size? size tupleA)) - - _ - #0))) - (test "Can analyse pseudo-product (singleton tuple)" - (|> (typeA.with-type singletonT - (_primitive.phase (` [(~ singletonC)]))) - check-succeeds)) - (test "Can analyse product through bound type-vars." - (|> (do phase.monad - [[_ varT] (typeA.with-env check.var) - _ (typeA.with-env - (check.check varT (type.tuple (list/map product.left primitives))))] - (typeA.with-type varT - (/.product _primitive.phase (list/map product.right primitives)))) - (phase.run _primitive.state) - (case> (#e.Success tupleA) - (right-size? size tupleA) - - _ - #0))) - (test "Can analyse product through existential quantification." - (|> (typeA.with-type (type.ex-q 1 +tupleT) - (/.product _primitive.phase (list/map product.right +primitives))) - check-succeeds)) - (test "Cannot analyse product through universal quantification." - (|> (typeA.with-type (type.univ-q 1 +tupleT) - (/.product _primitive.phase (list/map product.right +primitives))) - check-fails)) - )))) - -(context: "Tagged Sums" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - choice (|> r.nat (:: @ map (n/% size))) - other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not))) - primitives (r.list size _primitive.primitive) - module-name (r.unicode 5) - type-name (r.unicode 5) - #let [varT (#.Parameter 1) - primitivesT (list/map product.left primitives) - [choiceT choiceC] (maybe.assume (list.nth choice primitives)) - [other-choiceT other-choiceC] (maybe.assume (list.nth other-choice primitives)) - variantT (type.variant primitivesT) - namedT (#.Named [module-name type-name] variantT) - named-polyT (|> (type.variant (list.concat (list (list.take choice primitivesT) - (list varT) - (list.drop (inc choice) primitivesT)))) - (type.univ-q 1) - (#.Named [module-name type-name])) - choice-tag (maybe.assume (list.nth choice tags)) - other-choice-tag (maybe.assume (list.nth other-choice tags))]] - ($_ seq - (test "Can infer tagged sum." - (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) - (check-variant module-name tags namedT choice size))) - (test "Tagged sums specialize when type-vars get bound." - (|> (/.tagged-sum _primitive.phase [module-name choice-tag] choiceC) - (check-variant module-name tags named-polyT choice size))) - (test "Tagged sum inference retains universal quantification when type-vars are not bound." - (|> (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC) - (check-variant module-name tags named-polyT other-choice size))) - (test "Can specialize generic tagged sums." - (|> (typeA.with-type variantT - (/.tagged-sum _primitive.phase [module-name other-choice-tag] other-choiceC)) - (check-variant module-name tags named-polyT other-choice size))) - )))) - -(context: "Records" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) - primitives (r.list size _primitive.primitive) - module-name (r.unicode 5) - type-name (r.unicode 5) - choice (|> r.nat (:: @ map (n/% size))) - #let [varT (#.Parameter 1) - tagsC (list/map (|>> [module-name] code.tag) tags) - primitivesT (list/map product.left primitives) - primitivesC (list/map product.right primitives) - tupleT (type.tuple primitivesT) - namedT (#.Named [module-name type-name] tupleT) - recordC (list.zip2 tagsC primitivesC) - named-polyT (|> (type.tuple (list.concat (list (list.take choice primitivesT) - (list varT) - (list.drop (inc choice) primitivesT)))) - (type.univ-q 1) - (#.Named [module-name type-name]))]] - ($_ seq - (test "Can infer record." - (|> (typeA.with-inference - (/.record _primitive.phase recordC)) - (check-record-inference module-name tags namedT size))) - (test "Records specialize when type-vars get bound." - (|> (typeA.with-inference - (/.record _primitive.phase recordC)) - (check-record-inference module-name tags named-polyT size))) - (test "Can specialize generic records." - (|> (do phase.monad - [recordA (typeA.with-type tupleT - (/.record _primitive.phase recordC))] - (wrap [tupleT recordA])) - (check-record-inference module-name tags named-polyT size))) - )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux deleted file mode 100644 index 319d4ab57..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." error ("error/." functor)]] - [compiler - [default - ["." reference] - ["." phase - ["." analysis (#+ Branch Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(context: "Dummy variables." - (<| (times 100) - (do @ - [maskedA //primitive.primitive - temp (|> r.nat (:: @ map (n/% 100))) - #let [maskA (analysis.control/case - [maskedA - [[(#analysis.Bind temp) - (#analysis.Reference (reference.local temp))] - (list)]])]] - (test "Dummy variables created to mask expressions get eliminated during synthesis." - (|> maskA - expression.phase - (phase.run [bundle.empty //.init]) - (error/map (//primitive.corresponds? maskedA)) - (error.default #0)))))) - -(context: "Let expressions." - (<| (times 100) - (do @ - [registerA r.nat - inputA //primitive.primitive - outputA //primitive.primitive - #let [letA (analysis.control/case - [inputA - [[(#analysis.Bind registerA) - outputA] - (list)]])]] - (test "Can detect and reify simple 'let' expressions." - (|> letA - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.branch/let [inputS registerS outputS]))) - (and (n/= registerA registerS) - (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? outputA outputS)) - - _ - #0)))))) - -(context: "If expressions." - (<| (times 100) - (do @ - [then|else r.bit - inputA //primitive.primitive - thenA //primitive.primitive - elseA //primitive.primitive - #let [thenB (: Branch - [(#analysis.Simple (#analysis.Bit #1)) - thenA]) - elseB (: Branch - [(#analysis.Simple (#analysis.Bit #0)) - elseA]) - ifA (if then|else - (analysis.control/case [inputA [thenB (list elseB)]]) - (analysis.control/case [inputA [elseB (list thenB)]]))]] - (test "Can detect and reify simple 'if' expressions." - (|> ifA - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.branch/if [inputS thenS elseS]))) - (and (//primitive.corresponds? inputA inputS) - (//primitive.corresponds? thenA thenS) - (//primitive.corresponds? elseA elseS)) - - _ - #0)))))) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux deleted file mode 100644 index f2565dfa0..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux +++ /dev/null @@ -1,174 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - ["." product] - ["." maybe] - ["." error] - ["." number] - [text - format] - [collection - ["." list ("list/." functor fold)] - ["dict" dictionary (#+ Dictionary)] - ["." set]]] - [compiler - [default - ["." reference (#+ Variable) ("variable/." equivalence)] - ["." phase - ["." analysis (#+ Arity Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(def: constant-function - (r.Random [Arity Analysis Analysis]) - (r.rec - (function (_ constant-function) - (do r.monad - [function? r.bit] - (if function? - (do @ - [[arity bodyA predictionA] constant-function] - (wrap [(inc arity) - (#analysis.Function (list) bodyA) - predictionA])) - (do @ - [predictionA //primitive.primitive] - (wrap [0 predictionA predictionA]))))))) - -(def: (pick scope-size) - (-> Nat (r.Random Nat)) - (|> r.nat (:: r.monad map (n/% scope-size)))) - -(def: function-with-environment - (r.Random [Arity Analysis Variable]) - (do r.monad - [num-locals (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - #let [indices (list.n/range 0 (dec num-locals)) - local-env (list/map (|>> #reference.Local) indices) - foreign-env (list/map (|>> #reference.Foreign) indices)] - [arity bodyA predictionA] (: (r.Random [Arity Analysis Variable]) - (loop [arity 1 - current-env foreign-env] - (let [current-env/size (list.size current-env) - resolver (list/fold (function (_ [idx var] resolver) - (dict.put idx var resolver)) - (: (Dictionary Nat Variable) - (dict.new number.hash)) - (list.enumerate current-env))] - (do @ - [nest? r.bit] - (if nest? - (do @ - [num-picks (:: @ map (n/max 1) (pick (inc current-env/size))) - picks (|> (r.set number.hash num-picks (pick current-env/size)) - (:: @ map set.to-list)) - [arity bodyA predictionA] (recur (inc arity) - (list/map (function (_ pick) - (maybe.assume (list.nth pick current-env))) - picks)) - #let [picked-env (list/map (|>> #reference.Foreign) picks)]] - (wrap [arity - (#analysis.Function picked-env bodyA) - predictionA])) - (do @ - [chosen (pick (list.size current-env))] - (wrap [arity - (#analysis.Reference (reference.foreign chosen)) - (maybe.assume (dict.get chosen resolver))])))))))] - (wrap [arity - (#analysis.Function local-env bodyA) - predictionA]))) - -(def: local-function - (r.Random [Arity Analysis Variable]) - (loop [arity 0 - nest? #1] - (if nest? - (do r.monad - [nest?' r.bit - [arity' bodyA predictionA] (recur (inc arity) nest?')] - (wrap [arity' - (#analysis.Function (list) bodyA) - predictionA])) - (do r.monad - [chosen (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))] - (wrap [arity - (#analysis.Reference (reference.local chosen)) - (|> chosen (n/+ (dec arity)) #reference.Local)]))))) - -(context: "Abstraction." - (<| (times 100) - (do @ - [[arity//constant function//constant prediction//constant] constant-function - [arity//environment function//environment prediction//environment] function-with-environment - [arity//local function//local prediction//local] local-function] - ($_ seq - (test "Nested functions will get folded together." - (|> function//constant - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity output]))) - (and (n/= arity//constant arity) - (//primitive.corresponds? prediction//constant output)) - - _ - (n/= 0 arity//constant)))) - (test "Folded functions provide direct access to environment variables." - (|> function//environment - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) - (and (n/= arity//environment arity) - (variable/= prediction//environment output)) - - _ - #0))) - (test "Folded functions properly offset local variables." - (|> function//local - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) - (and (n/= arity//local arity) - (variable/= prediction//local output)) - - _ - #0))) - )))) - -(context: "Application." - (<| (times 100) - (do @ - [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1)))) - funcA //primitive.primitive - argsA (r.list arity //primitive.primitive)] - ($_ seq - (test "Can synthesize function application." - (|> (analysis.apply [funcA argsA]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.function/apply [funcS argsS]))) - (and (//primitive.corresponds? funcA funcS) - (list.every? (product.uncurry //primitive.corresponds?) - (list.zip2 argsA argsS))) - - _ - #0))) - (test "Function application on no arguments just synthesizes to the function itself." - (|> (analysis.apply [funcA (list)]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (#error.Success funcS) - (//primitive.corresponds? funcA funcS) - - _ - #0))) - )))) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux deleted file mode 100644 index 87dccc9f5..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux +++ /dev/null @@ -1,97 +0,0 @@ -(.module: - [lux (#- primitive) - [control - [monad (#+ do)] - pipe] - [data - ["." error] - [text - format]] - [compiler - [default - ["." phase - ["." analysis (#+ Analysis)] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test]) - -(def: #export primitive - (r.Random Analysis) - (do r.monad - [primitive (: (r.Random analysis.Primitive) - ($_ r.or - (wrap []) - r.bit - r.nat - r.int - r.rev - r.frac - (r.unicode 5)))] - (wrap (#analysis.Primitive primitive)))) - -(def: #export (corresponds? analysis synthesis) - (-> Analysis Synthesis Bit) - (case [synthesis analysis] - [(#//.Primitive (#//.Text valueS)) - (#analysis.Primitive (#analysis.Unit valueA))] - (is? valueS (:coerce Text valueA)) - - [(#//.Primitive (#//.Bit valueS)) - (#analysis.Primitive (#analysis.Bit valueA))] - (is? valueS valueA) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Nat valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Int valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.I64 valueS)) - (#analysis.Primitive (#analysis.Rev valueA))] - (is? (.i64 valueS) (.i64 valueA)) - - [(#//.Primitive (#//.F64 valueS)) - (#analysis.Primitive (#analysis.Frac valueA))] - (is? valueS valueA) - - [(#//.Primitive (#//.Text valueS)) - (#analysis.Primitive (#analysis.Text valueA))] - (is? valueS valueA) - - _ - #0)) - -(context: "Primitives." - (<| (times 100) - (do @ - [|bit| r.bit - |nat| r.nat - |int| r.int - |rev| r.rev - |frac| r.frac - |text| (r.unicode 5)] - (`` ($_ seq - (~~ (do-template [<desc> <analysis> <synthesis> <sample>] - [(test (format "Can synthesize " <desc> ".") - (|> (#analysis.Primitive (<analysis> <sample>)) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (#error.Success (#//.Primitive (<synthesis> value))) - (is? <sample> value) - - _ - #0)))] - - ["unit" #analysis.Unit #//.Text //.unit] - ["bit" #analysis.Bit #//.Bit |bit|] - ["nat" #analysis.Nat #//.I64 (.i64 |nat|)] - ["int" #analysis.Int #//.I64 (.i64 |int|)] - ["rev" #analysis.Rev #//.I64 (.i64 |rev|)] - ["frac" #analysis.Frac #//.F64 |frac|] - ["text" #analysis.Text #//.Text |text|]))))))) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux deleted file mode 100644 index 7f9eae209..000000000 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux +++ /dev/null @@ -1,67 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - pipe] - [data - [bit ("bit/." equivalence)] - ["." product] - ["." error] - [collection - ["." list]]] - [compiler - [default - ["." phase - ["." analysis] - ["//" synthesis (#+ Synthesis) - ["." expression]] - [extension - ["." bundle]]]]] - [math - ["r" random]] - test] - ["." //primitive]) - -(context: "Variants" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2)))) - tagA (|> r.nat (:: @ map (n/% size))) - #let [right? (n/= (dec size) tagA) - lefts (if right? - (dec tagA) - tagA)] - memberA //primitive.primitive] - ($_ seq - (test "Can synthesize variants." - (|> (analysis.variant [lefts right? memberA]) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.variant [leftsS right?S valueS]))) - (let [tagS (if right?S (inc leftsS) leftsS)] - (and (n/= tagA tagS) - (|> tagS (n/= (dec size)) (bit/= right?S)) - (//primitive.corresponds? memberA valueS))) - - _ - #0))) - )))) - -(context: "Tuples" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - membersA (r.list size //primitive.primitive)] - ($_ seq - (test "Can synthesize tuple." - (|> (analysis.tuple membersA) - expression.phase - (phase.run [bundle.empty //.init]) - (case> (^ (#error.Success (//.tuple membersS))) - (and (n/= size (list.size membersS)) - (list.every? (product.uncurry //primitive.corresponds?) - (list.zip2 membersA membersS))) - - _ - #0))) - )))) diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux deleted file mode 100644 index fb83bda4c..000000000 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ /dev/null @@ -1,147 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - ["." error] - ["." text - format - ["l" lexer]] - [collection - ["." list] - ["." dictionary (#+ Dictionary)]]] - [math - ["r" random ("r/." monad)]] - [macro - ["." code]] - [compiler - [default - ["&" syntax]]] - test]) - -(def: default-cursor - Cursor - {#.module "" - #.line 0 - #.column 0}) - -(def: name-part^ - (r.Random Text) - (do r.monad - [#let [digits "0123456789" - delimiters (format "()[]{}#." &.text-delimiter) - space (format " " text.new-line) - invalid-range (format digits delimiters space) - char-gen (|> r.nat - (:: @ map (|>> (n/% 256) (n/max 1))) - (r.filter (function (_ sample) - (not (text.contains? (text.from-code sample) - invalid-range)))))] - size (|> r.nat (:: @ map (|>> (n/% 20) (n/max 1))))] - (r.text char-gen size))) - -(def: name^ - (r.Random Name) - (r.and name-part^ name-part^)) - -(def: code^ - (r.Random Code) - (let [numeric^ (: (r.Random Code) - ($_ r.either - (|> r.bit (r/map code.bit)) - (|> r.nat (r/map code.nat)) - (|> r.int (r/map code.int)) - (|> r.rev (r/map code.rev)) - (|> r.frac (r/map code.frac)))) - textual^ (: (r.Random Code) - ($_ r.either - (do r.monad - [size (|> r.nat (r/map (n/% 20)))] - (|> (r.unicode size) (r/map code.text))) - (|> name^ (r/map code.identifier)) - (|> name^ (r/map code.tag)))) - simple^ (: (r.Random Code) - ($_ r.either - numeric^ - textual^))] - (r.rec - (function (_ code^) - (let [multi^ (do r.monad - [size (|> r.nat (r/map (n/% 3)))] - (r.list size code^)) - composite^ (: (r.Random Code) - ($_ r.either - (|> multi^ (r/map code.form)) - (|> multi^ (r/map code.tuple)) - (do r.monad - [size (|> r.nat (r/map (n/% 3)))] - (|> (r.list size (r.and code^ code^)) - (r/map code.record)))))] - (r.either simple^ - composite^)))))) - -(context: "Lux code syntax." - (<| (times 100) - (do @ - [sample code^ - other code^] - ($_ seq - (test "Can parse Lux code." - (case (let [source-code (%code sample)] - (&.parse "" (dictionary.new text.hash) (text.size source-code) - [default-cursor 0 source-code])) - (#error.Failure error) - #0 - - (#error.Success [_ parsed]) - (:: code.equivalence = parsed sample))) - (test "Can parse Lux multiple code nodes." - (let [source-code (format (%code sample) " " (%code other)) - source-code//size (text.size source-code)] - (case (&.parse "" (dictionary.new text.hash) source-code//size - [default-cursor 0 source-code]) - (#error.Failure error) - #0 - - (#error.Success [remaining =sample]) - (case (&.parse "" (dictionary.new text.hash) source-code//size - remaining) - (#error.Failure error) - #0 - - (#error.Success [_ =other]) - (and (:: code.equivalence = sample =sample) - (:: code.equivalence = other =other)))))) - )))) - -(def: comment-text^ - (r.Random Text) - (let [char-gen (|> r.nat (r.filter (|>> (n/= (`` (char (~~ (static text.new-line))))) not)))] - (do r.monad - [size (|> r.nat (r/map (n/% 20)))] - (r.text char-gen size)))) - -(def: comment^ - (r.Random Text) - (do r.monad - [comment comment-text^] - (wrap (format "## " comment text.new-line)))) - -(context: "Multi-line text & comments." - (<| (seed 12137892244981970631) - ## (times 100) - (do @ - [sample code^ - comment comment^] - ($_ seq - (test "Can handle comments." - (case (let [source-code (format comment (%code sample)) - source-code//size (text.size source-code)] - (&.parse "" (dictionary.new text.hash) source-code//size - [default-cursor 0 source-code])) - (#error.Failure error) - #0 - - (#error.Success [_ parsed]) - (:: code.equivalence = parsed sample))) - )))) diff --git a/stdlib/test/test/lux/control.lux b/stdlib/test/test/lux/control.lux deleted file mode 100644 index f50bdf7a7..000000000 --- a/stdlib/test/test/lux/control.lux +++ /dev/null @@ -1,11 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)]] - [/ - ["/." exception]]) - -(def: #export test - Test - ($_ _.and - (<| (_.context "/exception Exception-handling.") - /exception.test))) diff --git a/stdlib/test/test/lux/control/apply.lux b/stdlib/test/test/lux/control/apply.lux deleted file mode 100644 index 01fb33797..000000000 --- a/stdlib/test/test/lux/control/apply.lux +++ /dev/null @@ -1,69 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ Apply)]} - [// - [functor (#+ Injection Comparison)]]) - -(def: (identity (^open "_/.") injection comparison) - (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] - (_.test "Identity." - ((comparison n/=) - (_/apply (injection function.identity) sample) - sample)))) - -(def: (homomorphism (^open "_/.") injection comparison) - (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Homomorphism." - ((comparison n/=) - (_/apply (injection increase) (injection sample)) - (injection (increase sample)))))) - -(def: (interchange (^open "_/.") injection comparison) - (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Interchange." - ((comparison n/=) - (_/apply (injection increase) (injection sample)) - (_/apply (injection (function (_ f) (f sample))) (injection increase)))))) - -(def: (composition (^open "_/.") injection comparison) - (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat) - decrease (:: @ map n/- r.nat)] - (_.test "Composition." - ((comparison n/=) - (_$ _/apply - (injection function.compose) - (injection increase) - (injection decrease) - (injection sample)) - ($_ _/apply - (injection increase) - (injection decrease) - (injection sample)))))) - -(def: #export (laws apply injection comparison) - (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) - (_.context "Apply laws." - ($_ _.and - (..identity apply injection comparison) - (..homomorphism apply injection comparison) - (..interchange apply injection comparison) - (..composition apply injection comparison) - ))) diff --git a/stdlib/test/test/lux/control/concurrency/actor.lux b/stdlib/test/test/lux/control/concurrency/actor.lux deleted file mode 100644 index c035cabe2..000000000 --- a/stdlib/test/test/lux/control/concurrency/actor.lux +++ /dev/null @@ -1,75 +0,0 @@ -(.module: - [lux #* - ["." io (#+ IO io)] - [control - ["M" monad (#+ do Monad)] - ["ex" exception] - [concurrency - ["P" promise ("promise/." monad)] - ["T" task] - ["&" actor (#+ actor: message:)]]] - [data - ["." error] - [text - format]]] - lux/test) - -(actor: Counter - Nat - - ((handle message state self) - (do t.monad - [#let [_ (log! "BEFORE")] - output (message state self) - #let [_ (log! "AFTER")]] - (wrap output))) - - ((stop cause state) - (promise/wrap (log! (if (ex.match? &.poisoned cause) - (format "Counter was poisoned: " (%n state)) - cause))))) - -(message: #export Counter - (count! {increment Nat} state self Nat) - (let [state' (n/+ increment state)] - (T.return [state' state']))) - -(context: "Actors" - ($_ seq - (test "Can check if an actor is alive." - (io.run (do io.monad - [counter (new@Counter 0)] - (wrap (&.alive? counter))))) - - (test "Can poison actors." - (io.run (do io.monad - [counter (new@Counter 0) - poisoned? (&.poison counter)] - (wrap (and poisoned? - (not (&.alive? counter))))))) - - (test "Cannot poison an already dead actor." - (io.run (do io.monad - [counter (new@Counter 0) - first-time (&.poison counter) - second-time (&.poison counter)] - (wrap (and first-time - (not second-time)))))) - - (wrap (do p.monad - [result (do t.monad - [#let [counter (io.run (new@Counter 0))] - output-1 (count! 1 counter) - output-2 (count! 1 counter) - output-3 (count! 1 counter)] - (wrap (and (n/= 1 output-1) - (n/= 2 output-2) - (n/= 3 output-3))))] - (assert "Can send messages to actors." - (case result - (#error.Success outcome) - outcome - - (#error.Failure error) - #0)))) - )) diff --git a/stdlib/test/test/lux/control/concurrency/atom.lux b/stdlib/test/test/lux/control/concurrency/atom.lux deleted file mode 100644 index 720547e27..000000000 --- a/stdlib/test/test/lux/control/concurrency/atom.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - ["M" monad (#+ do Monad)] - [concurrency - ["&" atom]]] - [math - ["r" random]]] - lux/test) - -(context: "Atoms" - (<| (times 100) - (do @ - [value r.nat - swap-value r.nat - set-value r.nat - #let [box (&.atom value)]] - ($_ seq - (test "Can obtain the value of an atom." - (n/= value (io.run (&.read box)))) - - (test "Can swap the value of an atom." - (and (io.run (&.compare-and-swap value swap-value box)) - (n/= swap-value (io.run (&.read box))))) - - (test "Can update the value of an atom." - (exec (io.run (&.update inc box)) - (n/= (inc swap-value) (io.run (&.read box))))) - - (test "Can immediately set the value of an atom." - (exec (io.run (&.write set-value box)) - (n/= set-value (io.run (&.read box))))) - )))) diff --git a/stdlib/test/test/lux/control/concurrency/frp.lux b/stdlib/test/test/lux/control/concurrency/frp.lux deleted file mode 100644 index cfe70ff0e..000000000 --- a/stdlib/test/test/lux/control/concurrency/frp.lux +++ /dev/null @@ -1,53 +0,0 @@ -(.module: - [lux #* - ["." io (#+ IO io)] - [control - ["." monad (#+ do Monad)] - [concurrency - ["." promise ("promise/." monad)] - ["." frp (#+ Channel)] - ["." atom (#+ Atom atom)]]] - [data - ["." number] - [collection - ["." list]]]] - lux/test) - -(context: "FRP" - (let [(^open "list/.") (list.equivalence number.equivalence)] - ($_ seq - (wrap (do promise.monad - [output (|> (list +0 +1 +2 +3 +4 +5) - (frp.sequential 0) - (frp.filter i/even?) - frp.consume)] - (assert "Can filter a channel's elements." - (list/= (list +0 +2 +4) output)))) - - (wrap (do promise.monad - [output (|> (list +0 +1 +2 +3 +4 +5) - (frp.sequential 0) - (:: frp.functor map inc) - frp.consume)] - (assert "Functor goes over every element in a channel." - (list/= (list +1 +2 +3 +4 +5 +6) - output)))) - - (wrap (do promise.monad - [output (frp.consume (:: frp.apply apply - (frp.sequential 0 (list inc)) - (frp.sequential 0 (list +12345))))] - (assert "Apply works over all channel values." - (list/= (list +12346) - output)))) - - (wrap (do promise.monad - [output (frp.consume - (do frp.monad - [f (frp.from-promise (promise/wrap inc)) - a (frp.from-promise (promise/wrap +12345))] - (wrap (f a))))] - (assert "Valid monad." - (list/= (list +12346) - output)))) - ))) diff --git a/stdlib/test/test/lux/control/concurrency/promise.lux b/stdlib/test/test/lux/control/concurrency/promise.lux deleted file mode 100644 index e50320901..000000000 --- a/stdlib/test/test/lux/control/concurrency/promise.lux +++ /dev/null @@ -1,68 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - ["M" monad (#+ Monad do)] - pipe - [concurrency - ["&" promise ("&/." monad)]]] - [math - ["r" random]]] - lux/test) - -(context: "Promises" - ($_ seq - (wrap (do &.monad - [running? (&.future (io.io #1))] - (assert "Can run IO actions in separate threads." - running?))) - - (wrap (do &.monad - [_ (&.wait 500)] - (assert "Can wait for a specified amount of time." - #1))) - - (wrap (do &.monad - [[left right] (&.and (&.future (io.io #1)) - (&.future (io.io #0)))] - (assert "Can combine promises sequentially." - (and left (not right))))) - - (wrap (do &.monad - [?left (&.or (&.delay 100 #1) - (&.delay 200 #0)) - ?right (&.or (&.delay 200 #1) - (&.delay 100 #0))] - (assert "Can combine promises alternatively." - (case [?left ?right] - [(#.Left #1) (#.Right #0)] - #1 - - _ - #0)))) - - (wrap (do &.monad - [?left (&.either (&.delay 100 #1) - (&.delay 200 #0)) - ?right (&.either (&.delay 200 #1) - (&.delay 100 #0))] - (assert "Can combine promises alternatively [Part 2]." - (and ?left (not ?right))))) - - (test "Can poll a promise for its value." - (and (|> (&.poll (&/wrap #1)) - (case> (#.Some #1) #1 _ #0)) - (|> (&.poll (&.delay 200 #1)) - (case> #.None #1 _ #0)))) - - (wrap (do &.monad - [?none (&.time-out 100 (&.delay 200 #1)) - ?some (&.time-out 200 (&.delay 100 #1))] - (assert "Can establish maximum waiting times for promises to be fulfilled." - (case [?none ?some] - [#.None (#.Some #1)] - #1 - - _ - #0)))) - )) diff --git a/stdlib/test/test/lux/control/concurrency/semaphore.lux b/stdlib/test/test/lux/control/concurrency/semaphore.lux deleted file mode 100644 index 0c4167ee7..000000000 --- a/stdlib/test/test/lux/control/concurrency/semaphore.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)] - [concurrency - ["/" semaphore] - ["." promise (#+ Promise)] - ["." atom (#+ Atom)]]] - [data - ["." maybe] - ["." text ("text/." equivalence monoid) - format] - [collection - ["." list ("list/." functor)]]] - ["." io] - [math - ["r" random]]] - lux/test) - -## (def: (wait-many-times times semaphore) -## (-> Nat /.Semaphore (Promise Any)) -## (loop [steps times] -## (if (n/> 0 steps) -## (do promise.monad -## [_ (/.wait semaphore)] -## (recur (dec steps))) -## (:: promise.monad wrap [])))) - -## (context: "Semaphore." -## (<| (times 100) -## (do @ -## [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] -## ($_ seq -## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.monad -## [_ (wait-many-times open-positions semaphore)] -## (assert "Can wait on a semaphore up to the number of open positions without blocking." -## true)))) -## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.monad -## [result (<| (promise.time-out 100) -## (wait-many-times (inc open-positions) semaphore))] -## (assert "Waiting on a semaphore more than the number of open positions blocks the process." -## (case result -## (#.Some _) -## false - -## #.None -## true))))) -## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.monad -## [_ (: (Promise Any) -## (loop [steps (n/* 2 open-positions)] -## (if (n/> 0 steps) -## (do @ -## [_ (/.wait semaphore) -## _ (/.signal semaphore)] -## (recur (dec steps))) -## (wrap []))))] -## (assert "Signaling a semaphore replenishes its open positions." -## true)))) -## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.monad -## [#let [resource (atom.atom "") -## blocked (do @ -## [_ (wait-many-times open-positions semaphore) -## _ (/.wait semaphore) -## #let [_ (io.run (atom.update (|>> (format "B")) -## resource))]] -## (wrap []))] -## _ (promise.wait 100) -## _ (exec (io.run (atom.update (|>> (format "A")) -## resource)) -## (/.signal semaphore)) -## _ blocked] -## (assert "A blocked process can be un-blocked by a signal somewhere else." -## (text/= "BA" -## (io.run (atom.read resource))))))) -## )))) - -## (context: "Mutex." -## (<| (times 100) -## (do @ -## [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] -## ($_ seq -## (let [mutex (/.mutex [])] -## (wrap (do promise.monad -## [#let [resource (atom.atom "") -## expected-As (text.join-with "" (list.repeat repetitions "A")) -## expected-Bs (text.join-with "" (list.repeat repetitions "B")) -## processA (<| (/.synchronize mutex) -## io.io -## promise.future -## (do io.monad -## [_ (<| (monad.seq @) -## (list.repeat repetitions) -## (atom.update (|>> (format "A")) resource))] -## (wrap []))) -## processB (<| (/.synchronize mutex) -## io.io -## promise.future -## (do io.monad -## [_ (<| (monad.seq @) -## (list.repeat repetitions) -## (atom.update (|>> (format "B")) resource))] -## (wrap [])))] -## _ processA -## _ processB -## #let [outcome (io.run (atom.read resource))]] -## (assert "Mutexes only allow one process to execute at a time." -## (or (text/= (format expected-As expected-Bs) -## outcome) -## (text/= (format expected-Bs expected-As) -## outcome)))))) -## )))) - -## (def: (waiter resource barrier id) -## (-> (Atom Text) /.Barrier Nat (Promise Any)) -## (do promise.monad -## [_ (/.block barrier) -## #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] -## (wrap []))) - -## (context: "Barrier." -## (let [limit 10 -## barrier (/.barrier (maybe.assume (/.limit limit))) -## resource (atom.atom "")] -## ($_ seq -## (wrap (do promise.monad -## [#let [ids (list.n/range 0 (dec limit)) -## waiters (list/map (function (_ id) -## (let [process (waiter resource barrier id)] -## (exec (io.run (atom.update (|>> (format "_")) resource)) -## process))) -## ids)] -## _ (monad.seq @ waiters) -## #let [outcome (io.run (atom.read resource))]] -## (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all." -## (and (text.ends-with? "__________" outcome) -## (list.every? (function (_ id) -## (text.contains? (%n id) outcome)) -## ids) -## ))))))) diff --git a/stdlib/test/test/lux/control/concurrency/stm.lux b/stdlib/test/test/lux/control/concurrency/stm.lux deleted file mode 100644 index 966ab6007..000000000 --- a/stdlib/test/test/lux/control/concurrency/stm.lux +++ /dev/null @@ -1,77 +0,0 @@ -(.module: - [lux #* - ["." io (#+ IO)] - [control - ["M" monad (#+ do Monad)] - [concurrency - ["." atom (#+ Atom atom)] - ["&" stm] - ["." process] - ["." promise] - ["." frp (#+ Channel)]]] - [data - ["." number] - [collection - ["." list ("list/." functor)]]] - [math - ["r" random]]] - lux/test) - -(def: (read! channel) - (All [a] (-> (Channel a) (IO (Atom (List a))))) - (do io.monad - [#let [output (atom (list))] - _ (frp.listen (function (_ value) - ## TODO: Simplify when possible. - (do @ - [_ (atom.update (|>> (#.Cons value)) output)] - (wrap []))) - channel)] - (wrap output))) - -(def: iterations-per-process Nat 100) - -(context: "STM" - ($_ seq - (wrap (do promise.monad - [output (&.commit (&.read (&.var 0)))] - (assert "Can read STM vars." - (n/= 0 output)))) - (wrap (do promise.monad - [#let [_var (&.var 0)] - output (&.commit (do &.monad - [_ (&.write 5 _var)] - (&.read _var)))] - (assert "Can write STM vars." - (n/= 5 output)))) - (wrap (do promise.monad - [#let [_var (&.var 5)] - output (&.commit (do &.monad - [_ (&.update (n/* 3) _var)] - (&.read _var)))] - (assert "Can update STM vars." - (n/= 15 output)))) - (wrap (do promise.monad - [#let [_var (&.var 0) - changes (io.run (read! (io.run (&.follow _var))))] - _ (&.commit (&.write 5 _var)) - _ (&.commit (&.update (n/* 3) _var)) - changes (promise.future (atom.read changes))] - (assert "Can follow all the changes to STM vars." - (:: (list.equivalence number.equivalence) = - (list 5 15) - (list.reverse changes))))) - (wrap (let [_concurrency-var (&.var 0)] - (do promise.monad - [_ (|> process.parallelism - (list.n/range 1) - (list/map (function (_ _) - (|> iterations-per-process - (list.n/range 1) - (M.map @ (function (_ _) (&.commit (&.update inc _concurrency-var))))))) - (M.seq @)) - last-val (&.commit (&.read _concurrency-var))] - (assert "Can modify STM vars concurrently from multiple threads." - (|> process.parallelism - (n/* iterations-per-process) - (n/= last-val)))))))) diff --git a/stdlib/test/test/lux/control/continuation.lux b/stdlib/test/test/lux/control/continuation.lux deleted file mode 100644 index 0dbbe7dc5..000000000 --- a/stdlib/test/test/lux/control/continuation.lux +++ /dev/null @@ -1,77 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ do Monad)] - ["&" continuation]] - [data - ["." number] - [collection - ["." list]]] - ["r" math/random]] - lux/test) - -(context: "Continuations" - (<| (times 100) - (do @ - [sample r.nat - #let [(^open "&/.") &.apply - (^open "&/.") &.monad] - elems (r.list 3 r.nat)] - ($_ seq - (test "Can run continuations to compute their values." - (n/= sample (&.run (&/wrap sample)))) - - (test "Can use functor." - (n/= (inc sample) (&.run (&/map inc (&/wrap sample))))) - - (test "Can use apply." - (n/= (inc sample) (&.run (&/apply (&/wrap inc) (&/wrap sample))))) - - (test "Can use monad." - (n/= (inc sample) (&.run (do &.monad - [func (wrap inc) - arg (wrap sample)] - (wrap (func arg)))))) - - (test "Can use the current-continuation as a escape hatch." - (n/= (n/* 2 sample) - (&.run (do &.monad - [value (&.call/cc - (function (_ k) - (do @ - [temp (k sample)] - ## If this code where to run, - ## the output would be - ## (n/* 4 sample) - (k temp))))] - (wrap (n/* 2 value)))))) - - (test "Can use the current-continuation to build a time machine." - (n/= (n/+ 100 sample) - (&.run (do &.monad - [[restart [output idx]] (&.portal [sample 0])] - (if (n/< 10 idx) - (restart [(n/+ 10 output) (inc idx)]) - (wrap output)))))) - - (test "Can use delimited continuations with shifting." - (let [(^open "&/.") &.monad - (^open "L/.") (list.equivalence number.equivalence) - visit (: (-> (List Nat) - (&.Cont (List Nat) (List Nat))) - (function (visit xs) - (case xs - #.Nil - (&/wrap #.Nil) - - (#.Cons x xs') - (do &.monad - [output (&.shift (function (_ k) - (do @ - [tail (k xs')] - (wrap (#.Cons x tail)))))] - (visit output)))))] - (L/= elems - (&.run (&.reset (visit elems)))) - )) - )))) diff --git a/stdlib/test/test/lux/control/equivalence.lux b/stdlib/test/test/lux/control/equivalence.lux deleted file mode 100644 index daa2c81b3..000000000 --- a/stdlib/test/test/lux/control/equivalence.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - [lux #* - [control - ["/" equivalence] - [monad (#+ do)]] - [math - ["r" random]] - test]) - -(def: #export (spec Equivalence<a> generator) - (All [a] (-> (/.Equivalence a) (r.Random a) Test)) - (do r.monad - [sample generator - another generator] - ($_ seq - (test "Equivalence is reflexive." - (:: Equivalence<a> = sample sample)) - (test "Equivalence is symmetric." - (if (:: Equivalence<a> = sample another) - (:: Equivalence<a> = another sample) - #1))))) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux deleted file mode 100644 index 434ffc5d0..000000000 --- a/stdlib/test/test/lux/control/exception.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ exception:)]}) - -(exception: (an-exception)) - -(exception: (another-exception)) - -(def: #export test - (do r.monad - [right r.nat - wrong (r.filter (|>> (n/= right) not) r.nat)] - ($_ _.and - (_.test "Can catch exceptions." - (n/= right - (|> (/.throw an-exception []) - (/.catch an-exception (function (_ ex) right)) - (/.otherwise (function (_ ex) wrong))))) - (_.test "Can catch multiple exceptions." - (n/= right - (|> (/.throw another-exception []) - (/.catch an-exception (function (_ ex) wrong)) - (/.catch another-exception (function (_ ex) right)) - (/.otherwise (function (_ ex) wrong))))) - (_.test "Can handle uncaught exceptions." - (n/= right - (|> (/.throw another-exception []) - (/.catch an-exception (function (_ ex) wrong)) - (/.otherwise (function (_ ex) right)))))))) diff --git a/stdlib/test/test/lux/control/functor.lux b/stdlib/test/test/lux/control/functor.lux deleted file mode 100644 index a93edc291..000000000 --- a/stdlib/test/test/lux/control/functor.lux +++ /dev/null @@ -1,56 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ Functor)]}) - -(type: #export (Injection f) - (All [a] (-> a (f a)))) - -(type: #export (Comparison f) - (All [a] - (-> (-> a a Bit) - (-> (f a) (f a) Bit)))) - -(def: (identity (^open "_/.") injection comparison) - (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] - (_.test "Identity." - ((comparison n/=) - (_/map function.identity sample) - sample)))) - -(def: (homomorphism (^open "_/.") injection comparison) - (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n/+ r.nat)] - (_.test "Homomorphism." - ((comparison n/=) - (_/map increase (injection sample)) - (injection (increase sample)))))) - -(def: (composition (^open "_/.") injection comparison) - (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample (:: @ map injection r.nat) - increase (:: @ map n/+ r.nat) - decrease (:: @ map n/- r.nat)] - (_.test "Composition." - ((comparison n/=) - (|> sample (_/map increase) (_/map decrease)) - (|> sample (_/map (|>> increase decrease))))))) - -(def: #export (laws functor injection comparison) - (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) - (_.context "Functor laws." - ($_ _.and - (..identity functor injection comparison) - (..homomorphism functor injection comparison) - (..composition functor injection comparison)))) diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux deleted file mode 100644 index 6d00a36e9..000000000 --- a/stdlib/test/test/lux/control/interval.lux +++ /dev/null @@ -1,235 +0,0 @@ -(.module: - lux/test - [lux #* - [control - ["M" monad (#+ do Monad)] - pipe - ["&" interval]] - [math - ["r" random]] - [data - ["." number] - [collection - ["S" set] - ["L" list]]]]) - -(context: "Equivalence." - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "Every interval is equal to itself." - (and (let [self (&.between number.enum bottom top)] - (&/= self self)) - (let [self (&.between number.enum top bottom)] - (&/= self self)) - (let [self (&.singleton number.enum bottom)] - (&/= self self)))))))) - -(context: "Boundaries" - (<| (times 100) - (do @ - [bottom r.int - top r.int - #let [interval (&.between number.enum bottom top)]] - ($_ seq - (test "Every boundary value belongs to it's interval." - (and (&.within? interval bottom) - (&.within? interval top))) - (test "Every interval starts with its bottom." - (&.starts-with? bottom interval)) - (test "Every interval ends with its top." - (&.ends-with? top interval)) - (test "The boundary values border the interval." - (and (&.borders? interval bottom) - (&.borders? interval top))) - )))) - -(def: (list-to-4tuple list) - (-> (List Int) [Int Int Int Int]) - (case list - (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined))) - - -(do-template [<name> <cmp>] - [(def: <name> - (r.Random (&.Interval Int)) - (do r.monad - [bottom r.int - top (|> r.int (r.filter (|>> (i/= bottom) not)))] - (if (<cmp> top bottom) - (wrap (&.between number.enum bottom top)) - (wrap (&.between number.enum top bottom)))))] - - [gen-inner i/<] - [gen-outer i/>] - ) - -(def: gen-singleton - (r.Random (&.Interval Int)) - (do r.monad - [point r.int] - (wrap (&.singleton number.enum point)))) - -(def: gen-interval - (r.Random (&.Interval Int)) - ($_ r.either - gen-inner - gen-outer - gen-singleton)) - -(context: "Unions" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The union of an interval to itself yields the same interval." - (&/= some-interval (&.union some-interval some-interval))) - (test "The union of 2 inner intervals is another inner interval." - (&.inner? (&.union left-inner right-inner))) - (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (&.overlaps? (&.complement left-outer) (&.complement right-outer)) - (&.outer? (&.union left-outer right-outer)) - (&.inner? (&.union left-outer right-outer)))) - )))) - -(context: "Intersections" - (<| (times 100) - (do @ - [some-interval gen-interval - left-inner gen-inner - right-inner gen-inner - left-singleton gen-singleton - right-singleton gen-singleton - left-outer gen-outer - right-outer gen-outer - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The intersection of an interval to itself yields the same interval." - (&/= some-interval (&.intersection some-interval some-interval))) - (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (&.overlaps? left-inner right-inner) - (&.inner? (&.intersection left-inner right-inner)) - (&.outer? (&.intersection left-inner right-inner)))) - (test "The intersection of 2 outer intervals is another outer interval." - (&.outer? (&.intersection left-outer right-outer))) - )))) - -(context: "Complement" - (<| (times 100) - (do @ - [some-interval gen-interval - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "The complement of a complement is the same as the original." - (&/= some-interval (|> some-interval &.complement &.complement))) - (test "The complement of an interval does not overlap it." - (not (&.overlaps? some-interval (&.complement some-interval)))) - )))) - -(context: "Positioning/location" - (<| (times 100) - (do @ - [[l m r] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] - - _ - (undefined))))) - #let [left (&.singleton number.enum l) - right (&.singleton number.enum r)]] - ($_ seq - (test "'precedes?' and 'succeeds?' are symetric." - (and (&.precedes? right left) - (&.succeeds? left right))) - (test "Can check if an interval is before or after some element." - (and (&.before? m left) - (&.after? m right))) - )))) - -(context: "Touching intervals" - (<| (times 100) - (do @ - [[b t1 t2] (|> (r.set number.hash 3 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list b t1 t2)) - [b t1 t2] - - _ - (undefined))))) - #let [int-left (&.between number.enum t1 t2) - int-right (&.between number.enum b t1)]] - ($_ seq - (test "An interval meets another if it's top is the other's bottom." - (&.meets? int-left int-right)) - (test "Two intervals touch one another if any one meets the other." - (&.touches? int-left int-right)) - (test "Can check if 2 intervals start together." - (&.starts? (&.between number.enum b t2) - (&.between number.enum b t1))) - (test "Can check if 2 intervals finish together." - (&.finishes? (&.between number.enum b t2) - (&.between number.enum t1 t2))) - )))) - -(context: "Nesting & overlap" - (<| (times 100) - (do @ - [some-interval gen-interval - [x0 x1 x2 x3] (|> (r.set number.hash 4 r.int) - (:: @ map (|>> S.to-list - (L.sort i/<) - (case> (^ (list x0 x1 x2 x3)) - [x0 x1 x2 x3] - - _ - (undefined)))))] - ($_ seq - (test "Every interval is nested into itself." - (&.nested? some-interval some-interval)) - (test "No interval overlaps with itself." - (not (&.overlaps? some-interval some-interval))) - (let [small-inner (&.between number.enum x1 x2) - large-inner (&.between number.enum x0 x3)] - (test "Inner intervals can be nested inside one another." - (and (&.nested? large-inner small-inner) - (not (&.nested? small-inner large-inner))))) - (let [left-inner (&.between number.enum x0 x2) - right-inner (&.between number.enum x1 x3)] - (test "Inner intervals can overlap one another." - (and (&.overlaps? left-inner right-inner) - (&.overlaps? right-inner left-inner)))) - (let [small-outer (&.between number.enum x2 x1) - large-outer (&.between number.enum x3 x0)] - (test "Outer intervals can be nested inside one another." - (and (&.nested? small-outer large-outer) - (not (&.nested? large-outer small-outer))))) - (let [left-inner (&.between number.enum x0 x1) - right-inner (&.between number.enum x2 x3) - outer (&.between number.enum x0 x3)] - (test "Inners can be nested inside outers." - (and (&.nested? outer left-inner) - (&.nested? outer right-inner)))) - (let [left-inner (&.between number.enum x0 x2) - right-inner (&.between number.enum x1 x3) - outer (&.between number.enum x1 x2)] - (test "Inners can overlap outers." - (and (&.overlaps? outer left-inner) - (&.overlaps? outer right-inner)))) - )))) diff --git a/stdlib/test/test/lux/control/monad.lux b/stdlib/test/test/lux/control/monad.lux deleted file mode 100644 index 412f3ab94..000000000 --- a/stdlib/test/test/lux/control/monad.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - [lux #* - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ Monad do)]} - [// - [functor (#+ Injection Comparison)]]) - -(def: (left-identity (^open "_/.") injection comparison) - (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - morphism (:: @ map (function (_ diff) - (|>> (n/+ diff) _/wrap)) - r.nat)] - (_.test "Left identity." - ((comparison n/=) - (|> (injection sample) (_/map morphism) _/join) - (morphism sample))))) - -(def: (right-identity (^open "_/.") injection comparison) - (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat] - (_.test "Right identity." - ((comparison n/=) - (|> (injection sample) (_/map _/wrap) _/join) - (injection sample))))) - -(def: (associativity (^open "_/.") injection comparison) - (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map (function (_ diff) - (|>> (n/+ diff) _/wrap)) - r.nat) - decrease (:: @ map (function (_ diff) - (|>> (n/- diff) _/wrap)) - r.nat)] - (_.test "Associativity." - ((comparison n/=) - (|> (injection sample) (_/map increase) _/join (_/map decrease) _/join) - (|> (injection sample) (_/map (|>> increase (_/map decrease) _/join)) _/join))))) - -(def: #export (laws monad injection comparison) - (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) - (_.context "Monad laws." - ($_ _.and - (..left-identity monad injection comparison) - (..right-identity monad injection comparison) - (..associativity monad injection comparison)))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux deleted file mode 100644 index c9d568495..000000000 --- a/stdlib/test/test/lux/control/parser.lux +++ /dev/null @@ -1,177 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ do)] - [equivalence (#+ Equivalence)] - ["&" parser]] - [data - ["." error (#+ Error)]] - [math - ["r" random]] - ["." macro - ["." code] - ["s" syntax (#+ syntax:)]]] - lux/test) - -## [Utils] -(def: (should-fail input) - (All [a] (-> (Error a) Bit)) - (case input - (#error.Failure _) - #1 - - _ - #0)) - -(def: (enforced? parser input) - (All [s] (-> (&.Parser s Any) s Bit)) - (case (&.run input parser) - (#error.Success [_ []]) - #1 - - _ - #0)) - -(def: (found? parser input) - (All [s] (-> (&.Parser s Bit) s Bit)) - (case (&.run input parser) - (#error.Success [_ #1]) - #1 - - _ - #0)) - -(def: (fails? input) - (All [a] (-> (Error a) Bit)) - (case input - (#error.Failure _) - #1 - - _ - #0)) - -(syntax: (match pattern input) - (wrap (list (` (case (~ input) - (^ (#error.Success [(~' _) (~ pattern)])) - #1 - - (~' _) - #0))))) - -## [Tests] -(context: "Assertions" - (test "Can make assertions while parsing." - (and (match [] - (&.run (list (code.bit #1) (code.int +123)) - (&.assert "yolo" #1))) - (fails? (&.run (list (code.bit #1) (code.int +123)) - (&.assert "yolo" #0)))))) - -(context: "Combinators [Part 1]" - ($_ seq - (test "Can optionally succeed with some parser." - (and (match (#.Some 123) - (&.run (list (code.nat 123)) - (&.maybe s.nat))) - (match #.None - (&.run (list (code.int -123)) - (&.maybe s.nat))))) - - (test "Can apply a parser 0 or more times." - (and (match (list 123 456 789) - (&.run (list (code.nat 123) (code.nat 456) (code.nat 789)) - (&.some s.nat))) - (match (list) - (&.run (list (code.int -123)) - (&.some s.nat))))) - - (test "Can apply a parser 1 or more times." - (and (match (list 123 456 789) - (&.run (list (code.nat 123) (code.nat 456) (code.nat 789)) - (&.many s.nat))) - (match (list 123) - (&.run (list (code.nat 123)) - (&.many s.nat))) - (fails? (&.run (list (code.int -123)) - (&.many s.nat))))) - - (test "Can use either parser." - (let [positive (: (s.Syntax Int) - (do &.monad - [value s.int - _ (&.assert "" (i/> +0 value))] - (wrap value)))] - (and (match +123 - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.either positive s.int))) - (match -123 - (&.run (list (code.int -123) (code.int +456) (code.int +789)) - (&.either positive s.int))) - (fails? (&.run (list (code.bit #1) (code.int +456) (code.int +789)) - (&.either positive s.int)))))) - - (test "Can create the opposite/negation of any parser." - (and (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.not s.int))) - (match [] - (&.run (list (code.bit #1) (code.int +456) (code.int +789)) - (&.not s.int))))) - )) - -(context: "Combinators Part [2]" - ($_ seq - (test "Can fail at will." - (should-fail (&.run (list) - (&.fail "Well, it really SHOULD fail...")))) - - (test "Can apply a parser N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 3 s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 2 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.exactly 4 s.int))))) - - (test "Can apply a parser at-least N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 3 s.int))) - (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 2 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-least 4 s.int))))) - - (test "Can apply a parser at-most N times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 3 s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 2 s.int))) - (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.at-most 4 s.int))))) - - (test "Can apply a parser between N and M times." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.between 3 10 s.int))) - (fails? (&.run (list (code.int +123) (code.int +456) (code.int +789)) - (&.between 4 10 s.int))))) - - (test "Can parse while taking separators into account." - (and (match (list +123 +456 +789) - (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.text "YOLO") (code.int +789)) - (&.sep-by (s.this (' "YOLO")) s.int))) - (match (list +123 +456) - (&.run (list (code.int +123) (code.text "YOLO") (code.int +456) (code.int +789)) - (&.sep-by (s.this (' "YOLO")) s.int))))) - - (test "Can obtain the whole of the remaining input." - (|> &.remaining - (&.run (list (code.int +123) (code.int +456) (code.int +789))) - (match (list [_ (#.Int +123)] [_ (#.Int +456)] [_ (#.Int +789)])))) - )) diff --git a/stdlib/test/test/lux/control/pipe.lux b/stdlib/test/test/lux/control/pipe.lux deleted file mode 100644 index aaaa18616..000000000 --- a/stdlib/test/test/lux/control/pipe.lux +++ /dev/null @@ -1,72 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)] - pipe] - [data - ["." identity] - [text ("text/." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(context: "Pipes" - ($_ seq - (test "Can dismiss previous pipeline results and begin a new line." - (|> +20 - (i/* +3) - (i/+ +4) - (new> +0 inc) - (i/= +1))) - - (test "Can give names to piped values within a pipeline's scope." - (|> +5 - (let> X [(i/+ X X)]) - (i/= +10))) - - (test "Can do branching in pipelines." - (and (|> +5 - (cond> [i/even?] [(i/* +2)] - [i/odd?] [(i/* +3)] - [(new> -1)]) - (i/= +15)) - (|> +4 - (cond> [i/even?] [(i/* +2)] - [i/odd?] [(i/* +3)] - []) - (i/= +8)) - (|> +5 - (cond> [i/even?] [(i/* +2)] - [(new> -1)]) - (i/= -1)))) - - (test "Can loop within pipelines." - (|> +1 - (loop> [(i/< +10)] - [inc]) - (i/= +10))) - - (test "Can use monads within pipelines." - (|> +5 - (do> identity.monad - [(i/* +3)] - [(i/+ +4)] - [inc]) - (i/= +20))) - - (test "Can pattern-match against piped values." - (|> +5 - (case> +0 "zero" - +1 "one" - +2 "two" - +3 "three" - +4 "four" - +5 "five" - +6 "six" - +7 "seven" - +8 "eight" - +9 "nine" - _ "???") - (text/= "five"))) - )) diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux deleted file mode 100644 index 638e11519..000000000 --- a/stdlib/test/test/lux/control/reader.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - [monad (#+ do)] - pipe - ["&" reader]]] - lux/test) - -(context: "Readers" - (let [(^open "&/.") &.apply - (^open "&/.") &.monad] - ($_ seq - (test "" (i/= +123 (&.run +123 &.ask))) - (test "" (i/= +246 (&.run +123 (&.local (i/* +2) &.ask)))) - (test "" (i/= +134 (&.run +123 (&/map inc (i/+ +10))))) - (test "" (i/= +10 (&.run +123 (&/wrap +10)))) - (test "" (i/= +30 (&.run +123 (&/apply (&/wrap (i/+ +10)) (&/wrap +20))))) - (test "" (i/= +30 (&.run +123 (do &.monad - [f (wrap i/+) - x (wrap +10) - y (wrap +20)] - (wrap (f x y))))))))) - -(context: "Monad transformer" - (let [(^open "io/.") io.monad] - (test "Can add reader functionality to any monad." - (|> (: (&.Reader Text (io.IO Int)) - (do (&.ReaderT io.monad) - [a (&.lift (io/wrap +123)) - b (wrap +456)] - (wrap (i/+ a b)))) - (&.run "") - io.run - (case> +579 #1 - _ #0))) - )) diff --git a/stdlib/test/test/lux/control/region.lux b/stdlib/test/test/lux/control/region.lux deleted file mode 100644 index ff6bdaeaf..000000000 --- a/stdlib/test/test/lux/control/region.lux +++ /dev/null @@ -1,106 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)] - ["/" region] - ["." thread (#+ Thread)] - ["ex" exception (#+ exception:)]] - [data - ["." error (#+ Error)] - [collection - ["." list]]] - [math - ["r" random]]] - lux/test) - -(exception: oops) - -(do-template [<name> <success> <error>] - [(def: (<name> result) - (All [a] (-> (Error a) Bit)) - (case result - (#error.Success _) - <success> - - (#error.Failure _) - <error>))] - - [success? #1 #0] - [error? #0 #1] - ) - -(context: "Regions." - (<| (times 100) - (do @ - [expected-clean-ups (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))] - ($_ seq - (test "Clean-up functions are always run when region execution is done." - (thread.run - (do thread.monad - [clean-up-counter (thread.box 0) - #let [@@ @ - count-clean-up (function (_ value) - (do @ - [_ (thread.update inc clean-up-counter)] - (wrap (#error.Success []))))] - outcome (/.run @ - (do (/.monad @) - [_ (monad.map @ (/.acquire @@ count-clean-up) - (list.n/range 1 expected-clean-ups))] - (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (success? outcome) - (n/= expected-clean-ups - actual-clean-ups)))))) - (test "Can clean-up despite errors." - (thread.run - (do thread.monad - [clean-up-counter (thread.box 0) - #let [@@ @ - count-clean-up (function (_ value) - (do @ - [_ (thread.update inc clean-up-counter)] - (wrap (#error.Success []))))] - outcome (/.run @ - (do (/.monad @) - [_ (monad.map @ (/.acquire @@ count-clean-up) - (list.n/range 1 expected-clean-ups)) - _ (/.throw @@ oops [])] - (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (error? outcome) - (n/= expected-clean-ups - actual-clean-ups)))))) - (test "Errors can propagate from the cleaners." - (thread.run - (do thread.monad - [clean-up-counter (thread.box 0) - #let [@@ @ - count-clean-up (function (_ value) - (do @ - [_ (thread.update inc clean-up-counter)] - (wrap (: (Error Any) (ex.throw oops [])))))] - outcome (/.run @ - (do (/.monad @) - [_ (monad.map @ (/.acquire @@ count-clean-up) - (list.n/range 1 expected-clean-ups))] - (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (or (n/= 0 expected-clean-ups) - (error? outcome)) - (n/= expected-clean-ups - actual-clean-ups)))))) - (test "Can lift operations." - (thread.run - (do thread.monad - [clean-up-counter (thread.box 0) - #let [@@ @] - outcome (/.run @ - (do (/.monad @) - [_ (/.lift @@ (thread.write expected-clean-ups clean-up-counter))] - (wrap []))) - actual-clean-ups (thread.read clean-up-counter)] - (wrap (and (success? outcome) - (n/= expected-clean-ups - actual-clean-ups)))))) - )))) diff --git a/stdlib/test/test/lux/control/security/integrity.lux b/stdlib/test/test/lux/control/security/integrity.lux deleted file mode 100644 index f306cf7e5..000000000 --- a/stdlib/test/test/lux/control/security/integrity.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - [lux #* - [control - [hash (#+ Hash)] - [monad (#+ do)] - [security - ["@" integrity]]] - [data - ["." error] - ["." text ("text/." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(context: "Taint." - (do @ - [raw (r.ascii 10) - #let [dirty (@.taint raw)]] - ($_ seq - (test "Can clean a tainted value by trusting it." - (text/= raw (@.trust dirty))) - (test "Can validate a tainted value." - (case (@.validate (function (_ value) - (if (|> value text.size (n/> 0)) - (#error.Success value) - (#error.Failure "Empty text is invalid."))) - dirty) - (#error.Success clean) - (text/= raw clean) - - (#error.Failure error) - false)) - ))) - -(context: "Structures." - (do @ - [#let [duplicate (: (-> Text Text) - (function (_ raw) (format raw raw)))] - raw (r.ascii 10) - #let [check (|>> @.trust (text/= (duplicate raw))) - (^open "@/.") @.functor - (^open "@/.") @.apply - (^open "@/.") @.monad]] - ($_ seq - (test "Can use Functor." - (check (@/map duplicate (@.taint raw)))) - (test "Can use Apply." - (check (@/apply (@/wrap duplicate) (@.taint raw)))) - (test "Can use Monad." - (check (do @.monad - [dirty (@.taint raw)] - (wrap (duplicate dirty))))) - ))) diff --git a/stdlib/test/test/lux/control/security/privacy.lux b/stdlib/test/test/lux/control/security/privacy.lux deleted file mode 100644 index 72c23e4c1..000000000 --- a/stdlib/test/test/lux/control/security/privacy.lux +++ /dev/null @@ -1,85 +0,0 @@ -(.module: - [lux #* - [control - [hash (#+ Hash)] - [monad (#+ do)] - [security - ["@" privacy (#+ Context Privilege Private with-privacy)]]] - [data - ["." text ("text/." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(type: Password (Private Text)) - -(signature: (Policy %) - (: (Hash (Password %)) - &hash) - - (: (-> Text (Password %)) - password) - - (: (Privilege %) - privilege)) - -(def: (policy _) - (Ex [%] (-> Any (Policy %))) - (with-privacy - (: (Context Policy) - (function (_ (^@ privilege (^open "%/."))) - (structure - (def: &hash - (structure - (def: eq - (structure (def: (= reference sample) - (text/= (%/reveal reference) - (%/reveal sample))))) - (def: hash - (|>> %/reveal - (:: text.hash hash))))) - - (def: password - %/conceal) - - (def: privilege privilege)))))) - -(context: "Policy labels." - (do @ - [#let [policy-0 (policy 0)] - raw-password (r.ascii 10) - #let [password (:: policy-0 password raw-password)]] - ($_ seq - (test "Can work with private values under the same label." - (and (:: policy-0 = password password) - (n/= (:: text.hash hash raw-password) - (:: policy-0 hash password)))) - (let [policy-1 (policy 1) - delegate (@.delegation (:: policy-0 reveal) (:: policy-1 conceal))] - (test "Can use delegation to share private values between policies." - (:: policy-1 = (delegate password) (delegate password)))) - ))) - -(context: "Structures." - (do @ - [#let [duplicate (: (-> Text Text) - (function (_ raw) (format raw raw))) - policy-0 (policy 0)] - raw-password (r.ascii 10) - #let [password (:: policy-0 password raw-password)] - #let [check (:: policy-0 = - (:: policy-0 password (duplicate raw-password))) - (^open "@/.") @.functor - (^open "@/.") @.apply - (^open "@/.") @.monad]] - ($_ seq - (test "Can use Functor." - (check (@/map duplicate password))) - (test "Can use Apply." - (check (@/apply (@/wrap duplicate) password))) - (test "Can use Monad." - (check (do @.monad - [raw-password' (:: policy-0 password raw-password)] - (wrap (duplicate raw-password'))))) - ))) diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux deleted file mode 100644 index 948cbd5bf..000000000 --- a/stdlib/test/test/lux/control/state.lux +++ /dev/null @@ -1,117 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - ["M" monad (#+ do Monad)] - pipe - ["&" state]] - [data - ["." product]] - [math - ["r" random]]] - lux/test) - -(def: (with-conditions [state output] computation) - (-> [Nat Nat] (&.State Nat Nat) Bit) - (|> computation - (&.run state) - product.right - (n/= output))) - -(context: "Basics" - (<| (times 100) - (do @ - [state r.nat - value r.nat] - ($_ seq - (test "Can get the state as a value." - (with-conditions [state state] - &.get)) - (test "Can replace the state." - (with-conditions [state value] - (do &.monad - [_ (&.put value)] - &.get))) - (test "Can update the state." - (with-conditions [state (n/* value state)] - (do &.monad - [_ (&.update (n/* value))] - &.get))) - (test "Can use the state." - (with-conditions [state (inc state)] - (&.use inc))) - (test "Can use a temporary (local) state." - (with-conditions [state (n/* value state)] - (&.local (n/* value) - &.get))) - )))) - -(context: "Structures" - (<| (times 100) - (do @ - [state r.nat - value r.nat - #let [(^open "&/.") &.functor - (^open "&/.") &.apply - (^open "&/.") &.monad]] - ($_ seq - (test "Can use functor." - (with-conditions [state (inc state)] - (&/map inc &.get))) - (test "Can use apply." - (and (with-conditions [state value] - (&/wrap value)) - (with-conditions [state (n/+ value value)] - (&/apply (&/wrap (n/+ value)) - (&/wrap value))))) - (test "Can use monad." - (with-conditions [state (n/+ value value)] - (: (&.State Nat Nat) - (do &.monad - [f (wrap n/+) - x (wrap value) - y (wrap value)] - (wrap (f x y)))))) - )))) - -(context: "Monad transformer" - (<| (times 100) - (do @ - [state r.nat - left r.nat - right r.nat] - (let [(^open "io/.") io.monad] - (test "Can add state functionality to any monad." - (|> (: (&.State' io.IO Nat Nat) - (do (&.monad io.monad) - [a (&.lift io.monad (io/wrap left)) - b (wrap right)] - (wrap (n/+ a b)))) - (&.run' state) - io.run - (case> [state' output'] - (and (n/= state state') - (n/= (n/+ left right) output'))))) - )))) - -(context: "Loops" - (<| (times 100) - (do @ - [limit (|> r.nat (:: @ map (n/% 10))) - #let [condition (do &.monad - [state &.get] - (wrap (n/< limit state)))]] - ($_ seq - (test "'while' will only execute if the condition is #1." - (|> (&.while condition (&.update inc)) - (&.run 0) - (case> [state' output'] - (n/= limit state')))) - (test "'do-while' will execute at least once." - (|> (&.do-while condition (&.update inc)) - (&.run 0) - (case> [state' output'] - (or (n/= limit state') - (and (n/= 0 limit) - (n/= 1 state')))))) - )))) diff --git a/stdlib/test/test/lux/control/thread.lux b/stdlib/test/test/lux/control/thread.lux deleted file mode 100644 index 8f31addbb..000000000 --- a/stdlib/test/test/lux/control/thread.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - ["/" thread]]]) - -(def: _test0_ - Nat - (/.run (do /.monad - [box (/.box 123) - old (/.update (n/* 2) box) - new (/.read box)] - (wrap (n/+ old new))))) - -(def: _test1_ - (All [!] (/.Thread ! Nat)) - (do /.monad - [box (/.box 123) - old (/.update (n/* 2) box) - new (/.read box)] - (wrap (n/+ old new)))) diff --git a/stdlib/test/test/lux/control/writer.lux b/stdlib/test/test/lux/control/writer.lux deleted file mode 100644 index b5fb372d8..000000000 --- a/stdlib/test/test/lux/control/writer.lux +++ /dev/null @@ -1,45 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - ["M" monad (#+ Monad do)] - pipe - ["&" writer]] - [data - ["." product] - ["." text ("text/." equivalence)]]] - lux/test) - -(context: "Writer." - (let [(^open "&/.") (&.monad text.monoid) - (^open "&/.") (&.apply text.monoid)] - ($_ seq - (test "Functor respects Writer." - (i/= +11 (product.right (&/map inc ["" +10])))) - - (test "Apply respects Writer." - (and (i/= +20 (product.right (&/wrap +20))) - (i/= +30 (product.right (&/apply (&/wrap (i/+ +10)) (&/wrap +20)))))) - - (test "Monad respects Writer." - (i/= +30 (product.right (do (&.monad text.monoid) - [f (wrap i/+) - a (wrap +10) - b (wrap +20)] - (wrap (f a b)))))) - - (test "Can log any value." - (text/= "YOLO" (product.left (&.log "YOLO")))) - ))) - -(context: "Monad transformer" - (let [lift (&.lift text.monoid io.monad) - (^open "io/.") io.monad] - (test "Can add writer functionality to any monad." - (|> (io.run (do (&.WriterT text.monoid io.monad) - [a (lift (io/wrap +123)) - b (wrap +456)] - (wrap (i/+ a b)))) - (case> ["" +579] #1 - _ #0))) - )) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux deleted file mode 100644 index d064a736b..000000000 --- a/stdlib/test/test/lux/data/bit.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)]] - [data - bit] - [math - ["r" random]]] - lux/test) - -(context: "Bit operations." - (<| (times 100) - (do @ - [value r.bit] - (test "" (and (not (and value (not value))) - (or value (not value)) - - (not (:: disjunction identity)) - (:: disjunction compose value (not value)) - (:: conjunction identity) - (not (:: conjunction compose value (not value))) - - (:: equivalence = value (not (not value))) - (not (:: equivalence = value (not value))) - - (not (:: equivalence = value ((complement id) value))) - (:: equivalence = value ((complement not) value)) - - (case (|> value - (:: codec encode) - (:: codec decode)) - (#.Right dec-value) - (:: equivalence = value dec-value) - - (#.Left _) - #0) - ))))) diff --git a/stdlib/test/test/lux/data/collection/array.lux b/stdlib/test/test/lux/data/collection/array.lux deleted file mode 100644 index 47c384cb7..000000000 --- a/stdlib/test/test/lux/data/collection/array.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - ["." number] - ["." maybe] - [collection - ["@" array (#+ Array)] - ["." list]]] - [math - ["r" random]]] - lux/test) - -(def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n/% 100) (n/+ 1))))) - -(context: "Arrays and their copies" - (<| (times 100) - (do @ - [size bounded-size - original (r.array size r.nat) - #let [clone (@.clone original) - copy (: (Array Nat) - (@.new size)) - manual-copy (: (Array Nat) - (@.new size))]] - ($_ seq - (test "Size function must correctly return size of array." - (n/= size (@.size original))) - (test "Cloning an array should yield and identical array, but not the same one." - (and (:: (@.equivalence number.equivalence) = original clone) - (not (is? original clone)))) - (test "Full-range manual copies should give the same result as cloning." - (exec (@.copy size 0 original 0 copy) - (and (:: (@.equivalence number.equivalence) = original copy) - (not (is? original copy))))) - (test "Array folding should go over all values." - (exec (:: @.fold fold - (function (_ x idx) - (exec (@.write idx x manual-copy) - (inc idx))) - 0 - original) - (:: (@.equivalence number.equivalence) = original manual-copy))) - (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values." - (|> original - @.to-list @.from-list - (:: (@.equivalence number.equivalence) = original))) - )))) - -(context: "Array mutation" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - array (|> (r.array size r.nat) - (r.filter (|>> @.to-list (list.any? n/odd?)))) - #let [value (maybe.assume (@.read idx array))]] - ($_ seq - (test "Shouldn't be able to find a value in an unoccupied cell." - (case (@.read idx (@.delete idx array)) - (#.Some _) #0 - #.None #1)) - (test "You should be able to access values put into the array." - (case (@.read idx (@.write idx value array)) - (#.Some value') (n/= value' value) - #.None #0)) - (test "All cells should be occupied on a full array." - (and (n/= size (@.occupied array)) - (n/= 0 (@.vacant array)))) - (test "Filtering mutates the array to remove invalid values." - (exec (@.filter! n/even? array) - (and (n/< size (@.occupied array)) - (n/> 0 (@.vacant array)) - (n/= size (n/+ (@.occupied array) - (@.vacant array)))))) - )))) - -(context: "Finding values." - (<| (times 100) - (do @ - [size bounded-size - array (|> (r.array size r.nat) - (r.filter (|>> @.to-list (list.any? n/even?))))] - ($_ seq - (test "Can find values inside arrays." - (|> (@.find n/even? array) - (case> (#.Some _) #1 - #.None #0))) - (test "Can find values inside arrays (with access to indices)." - (|> (@.find+ (function (_ idx n) - (and (n/even? n) - (n/< size idx))) - array) - (case> (#.Some _) #1 - #.None #0))))))) - -(context: "Functor" - (<| (times 100) - (do @ - [size bounded-size - array (r.array size r.nat)] - (let [(^open ".") @.functor - (^open ".") (@.equivalence number.equivalence)] - ($_ seq - (test "Functor shouldn't alter original array." - (let [copy (map id array)] - (and (= array copy) - (not (is? array copy))))) - (test "Functor should go over all available array elements." - (let [there (map inc array) - back-again (map dec there)] - (and (not (= array there)) - (= array back-again))))))))) - -(context: "Monoid" - (<| (times 100) - (do @ - [sizeL bounded-size - sizeR bounded-size - left (r.array sizeL r.nat) - right (r.array sizeR r.nat) - #let [(^open ".") @.monoid - (^open ".") (@.equivalence number.equivalence) - fusion (compose left right)]] - ($_ seq - (test "Appending two arrays should produce a new one twice as large." - (n/= (n/+ sizeL sizeR) (@.size fusion))) - (test "First elements of fused array should equal the first array." - (|> (: (Array Nat) - (@.new sizeL)) - (@.copy sizeL 0 fusion 0) - (= left))) - (test "Last elements of fused array should equal the second array." - (|> (: (Array Nat) - (@.new sizeR)) - (@.copy sizeR sizeL fusion 0) - (= right))) - )))) diff --git a/stdlib/test/test/lux/data/collection/bits.lux b/stdlib/test/test/lux/data/collection/bits.lux deleted file mode 100644 index aeeac1429..000000000 --- a/stdlib/test/test/lux/data/collection/bits.lux +++ /dev/null @@ -1,87 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - ["." predicate]] - [data - [collection - ["/" bits]]] - [math - ["r" random]]] - lux/test - [test - [lux - [control - ["_eq" equivalence]]]]) - -(def: (size min max) - (-> Nat Nat (r.Random Nat)) - (|> r.nat - (:: r.monad map (|>> (n/% max) (n/max min))))) - -(def: bits - (r.Random /.Bits) - (do r.monad - [size (size 1 1_000) - idx (|> r.nat (:: @ map (n/% size)))] - (wrap (|> /.empty (/.set idx))))) - -(context: "Bits." - (<| (times 100) - (do @ - [size (size 1 1_000) - idx (|> r.nat (:: @ map (n/% size))) - sample bits] - ($_ seq - (test "Can set individual bits." - (and (|> /.empty (/.get idx) not) - (|> /.empty (/.set idx) (/.get idx)))) - (test "Can clear individual bits." - (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not)) - (test "Can flip individual bits." - (and (|> /.empty (/.flip idx) (/.get idx)) - (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not))) - - (test "Bits (only) grow when (and as much as) necessary." - (and (n/= 0 (/.capacity /.empty)) - (|> /.empty (/.set idx) /.capacity - (n/- idx) - (predicate.union (n/>= 0) - (n/< /.chunk-size))))) - (test "Bits (must) shrink when (and as much as) possible." - (let [grown (/.flip idx /.empty)] - (and (n/> 0 (/.capacity grown)) - (is? /.empty (/.flip idx grown))))) - - (test "Intersection can be detected when there are set bits in common." - (and (not (/.intersects? /.empty - /.empty)) - (/.intersects? (/.set idx /.empty) - (/.set idx /.empty)) - (not (/.intersects? (/.set (inc idx) /.empty) - (/.set idx /.empty))))) - (test "Cannot intersect with one's opposite." - (not (/.intersects? sample (/.not sample)))) - - (test "'and' with oneself changes nothing" - (:: /.equivalence = sample (/.and sample sample))) - (test "'and' with one's opposite yields the empty bit-set." - (is? /.empty (/.and sample (/.not sample)))) - - (test "'or' with one's opposite fully saturates a bit-set." - (n/= (/.size (/.or sample (/.not sample))) - (/.capacity sample))) - - (test "'xor' with oneself yields the empty bit-set." - (is? /.empty (/.xor sample sample))) - (test "'xor' with one's opposite fully saturates a bit-set." - (n/= (/.size (/.xor sample (/.not sample))) - (/.capacity sample))) - - (test "Double negation results in original bit-set." - (:: /.equivalence = sample (/.not (/.not sample)))) - (test "Negation does not affect the empty bit-set." - (is? /.empty (/.not /.empty))) - - (_eq.spec /.equivalence ..bits) - )))) diff --git a/stdlib/test/test/lux/data/collection/dictionary.lux b/stdlib/test/test/lux/data/collection/dictionary.lux deleted file mode 100644 index 3ad45704e..000000000 --- a/stdlib/test/test/lux/data/collection/dictionary.lux +++ /dev/null @@ -1,129 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - ["eq" equivalence]] - [data - ["." number] - ["." maybe] - [collection - ["&" dictionary] - ["." list ("list/." fold functor)]]] - [math - ["r" random]]] - lux/test) - -(context: "Dictionaries." - (<| (times 100) - (do @ - [#let [capped-nat (:: r.monad map (n/% 100) r.nat)] - size capped-nat - dict (r.dictionary number.hash size r.nat capped-nat) - non-key (|> r.nat (r.filter (function (_ key) (not (&.contains? key dict))))) - test-val (|> r.nat (r.filter (function (_ val) (not (list.member? number.equivalence (&.values dict) val)))))] - ($_ seq - (test "Size function should correctly represent Dictionary size." - (n/= size (&.size dict))) - - (test "Dictionaries of size 0 should be considered empty." - (if (n/= 0 size) - (&.empty? dict) - (not (&.empty? dict)))) - - (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list.equivalence (eq.product number.equivalence number.equivalence)) = - (&.entries dict) - (list.zip2 (&.keys dict) - (&.values dict)))) - - (test "Dictionary should be able to recognize it's own keys." - (list.every? (function (_ key) (&.contains? key dict)) - (&.keys dict))) - - (test "Should be able to get every key." - (list.every? (function (_ key) (case (&.get key dict) - (#.Some _) #1 - _ #0)) - (&.keys dict))) - - (test "Shouldn't be able to access non-existant keys." - (case (&.get non-key dict) - (#.Some _) #0 - _ #1)) - - (test "Should be able to put and then get a value." - (case (&.get non-key (&.put non-key test-val dict)) - (#.Some v) (n/= test-val v) - _ #1)) - - (test "Should be able to put~ and then get a value." - (case (&.get non-key (&.put~ non-key test-val dict)) - (#.Some v) (n/= test-val v) - _ #1)) - - (test "Shouldn't be able to put~ an existing key." - (or (n/= 0 size) - (let [first-key (|> dict &.keys list.head maybe.assume)] - (case (&.get first-key (&.put~ first-key test-val dict)) - (#.Some v) (not (n/= test-val v)) - _ #1)))) - - (test "Removing a key should make it's value inaccessible." - (let [base (&.put non-key test-val dict)] - (and (&.contains? non-key base) - (not (&.contains? non-key (&.remove non-key base)))))) - - (test "Should be possible to update values via their keys." - (let [base (&.put non-key test-val dict) - updt (&.update non-key inc base)] - (case [(&.get non-key base) (&.get non-key updt)] - [(#.Some x) (#.Some y)] - (n/= (inc x) y) - - _ - #0))) - - (test "Additions and removals to a Dictionary should affect its size." - (let [plus (&.put non-key test-val dict) - base (&.remove non-key plus)] - (and (n/= (inc (&.size dict)) (&.size plus)) - (n/= (dec (&.size plus)) (&.size base))))) - - (test "A Dictionary should equal itself & going to<->from lists shouldn't change that." - (let [(^open ".") (&.equivalence number.equivalence)] - (and (= dict dict) - (|> dict &.entries (&.from-list number.hash) (= dict))))) - - (test "Merging a Dictionary to itself changes nothing." - (let [(^open ".") (&.equivalence number.equivalence)] - (= dict (&.merge dict dict)))) - - (test "If you merge, and the second dict has overlapping keys, it should overwrite yours." - (let [dict' (|> dict &.entries - (list/map (function (_ [k v]) [k (inc v)])) - (&.from-list number.hash)) - (^open ".") (&.equivalence number.equivalence)] - (= dict' (&.merge dict' dict)))) - - (test "Can merge values in such a way that they become combined." - (list.every? (function (_ [x x*2]) (n/= (n/* 2 x) x*2)) - (list.zip2 (&.values dict) - (&.values (&.merge-with n/+ dict dict))))) - - (test "Should be able to select subset of keys from dict." - (|> dict - (&.put non-key test-val) - (&.select (list non-key)) - &.size - (n/= 1))) - - (test "Should be able to re-bind existing values to different keys." - (or (n/= 0 size) - (let [first-key (|> dict &.keys list.head maybe.assume) - rebound (&.re-bind first-key non-key dict)] - (and (n/= (&.size dict) (&.size rebound)) - (&.contains? non-key rebound) - (not (&.contains? first-key rebound)) - (n/= (maybe.assume (&.get first-key dict)) - (maybe.assume (&.get non-key rebound))))))) - )))) diff --git a/stdlib/test/test/lux/data/collection/dictionary/ordered.lux b/stdlib/test/test/lux/data/collection/dictionary/ordered.lux deleted file mode 100644 index 6b1f131cb..000000000 --- a/stdlib/test/test/lux/data/collection/dictionary/ordered.lux +++ /dev/null @@ -1,91 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - [equivalence (#+ Equivalence)]] - [data - ["." product] - ["." number] - [collection - ["s" set] - ["dict" dictionary - ["&" ordered]] - ["." list ("list/." functor)]]] - [math - ["r" random]]] - lux/test) - -(context: "Dictionary" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (n/% 100))) - keys (r.set number.nat-hash size r.nat) - values (r.set number.nat-hash size r.nat) - extra-key (|> r.nat (r.filter (|>> (s.member? keys) not))) - extra-value r.nat - #let [pairs (list.zip2 (s.to-list keys) - (s.to-list values)) - sample (&.from-list number.nat-order pairs) - sorted-pairs (list.sort (function (_ [left _] [right _]) - (n/< left right)) - pairs) - sorted-values (list/map product.right sorted-pairs) - (^open "&/.") (&.equivalence number.nat-equivalence)]] - ($_ seq - (test "Can query the size of a dictionary." - (n/= size (&.size sample))) - - (test "Can query value for minimum key." - (case [(&.min sample) (list.head sorted-values)] - [#.None #.None] - #1 - - [(#.Some reference) (#.Some sample)] - (n/= reference sample) - - _ - #0)) - - (test "Can query value for maximum key." - (case [(&.max sample) (list.last sorted-values)] - [#.None #.None] - #1 - - [(#.Some reference) (#.Some sample)] - (n/= reference sample) - - _ - #0)) - - (test "Converting dictionaries to/from lists cannot change their values." - (|> sample - &.entries (&.from-list number.nat-order) - (&/= sample))) - - (test "Order is preserved." - (let [(^open "list/.") (list.equivalence (: (Equivalence [Nat Nat]) - (function (_ [kr vr] [ks vs]) - (and (n/= kr ks) - (n/= vr vs)))))] - (list/= (&.entries sample) - sorted-pairs))) - - (test "Every key in a dictionary must be identifiable." - (list.every? (function (_ key) (&.contains? key sample)) - (&.keys sample))) - - (test "Can add and remove elements in a dictionary." - (and (not (&.contains? extra-key sample)) - (let [sample' (&.put extra-key extra-value sample) - sample'' (&.remove extra-key sample')] - (and (&.contains? extra-key sample') - (not (&.contains? extra-key sample'')) - (case [(&.get extra-key sample') - (&.get extra-key sample'')] - [(#.Some found) #.None] - (n/= extra-value found) - - _ - #0))) - )) - )))) diff --git a/stdlib/test/test/lux/data/collection/list.lux b/stdlib/test/test/lux/data/collection/list.lux deleted file mode 100644 index 9919f3dd1..000000000 --- a/stdlib/test/test/lux/data/collection/list.lux +++ /dev/null @@ -1,239 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - [monad (#+ do Monad)] - pipe] - [data - ["." number] - ["." bit] - ["." product] - ["." maybe] - [collection - ["&" list]]] - [math - ["r" random]]] - lux/test) - -(def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n/% 100) (n/+ 10))))) - -(context: "Lists: Part 1" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - sample (r.list size r.nat) - other-size bounded-size - other-sample (r.list other-size r.nat) - separator r.nat - #let [(^open ".") (&.equivalence number.equivalence) - (^open "&/.") &.functor]] - ($_ seq - (test "The size function should correctly portray the size of the list." - (n/= size (&.size sample))) - - (test "The repeat function should produce as many elements as asked of it." - (n/= size (&.size (&.repeat size [])))) - - (test "Reversing a list does not change it's size." - (n/= (&.size sample) - (&.size (&.reverse sample)))) - - (test "Reversing a list twice results in the original list." - (= sample - (&.reverse (&.reverse sample)))) - - (test "Filtering by a predicate and its complement should result in a number of elements equal to the original list." - (and (n/= (&.size sample) - (n/+ (&.size (&.filter n/even? sample)) - (&.size (&.filter (bit.complement n/even?) sample)))) - (let [[plus minus] (&.partition n/even? sample)] - (n/= (&.size sample) - (n/+ (&.size plus) - (&.size minus)))))) - - (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (&.every? n/even? sample) - (and (not (&.any? (bit.complement n/even?) sample)) - (&.empty? (&.filter (bit.complement n/even?) sample))) - (&.any? (bit.complement n/even?) sample))) - - (test "Any element of the list can be considered its member." - (let [elem (maybe.assume (&.nth idx sample))] - (&.member? number.equivalence sample elem))) - )))) - -(context: "Lists: Part 2" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - sample (r.list size r.nat) - other-size bounded-size - other-sample (r.list other-size r.nat) - separator r.nat - #let [(^open ".") (&.equivalence number.equivalence) - (^open "&/.") &.functor]] - ($_ seq - (test "Appending the head and the tail should yield the original list." - (let [head (maybe.assume (&.head sample)) - tail (maybe.assume (&.tail sample))] - (= sample - (#.Cons head tail)))) - - (test "Appending the inits and the last should yield the original list." - (let [(^open ".") &.monoid - inits (maybe.assume (&.inits sample)) - last (maybe.assume (&.last sample))] - (= sample - (compose inits (list last))))) - - (test "Functor should go over every element of the list." - (let [(^open ".") &.functor - there (map inc sample) - back-again (map dec there)] - (and (not (= sample there)) - (= sample back-again)))) - - (test "Splitting a list into chunks and re-appending them should yield the original list." - (let [(^open ".") &.monoid - [left right] (&.split idx sample) - [left' right'] (&.split-with n/even? sample)] - (and (= sample - (compose left right)) - (= sample - (compose left' right')) - (= sample - (compose (&.take idx sample) - (&.drop idx sample))) - (= sample - (compose (&.take-while n/even? sample) - (&.drop-while n/even? sample))) - ))) - - (test "Segmenting the list in pairs should yield as many elements as N/2." - (n/= (n// 2 size) - (&.size (&.as-pairs sample)))) - - (test "Sorting a list shouldn't change it's size." - (n/= (&.size sample) - (&.size (&.sort n/< sample)))) - - (test "Sorting a list with one order should yield the reverse of sorting it with the opposite order." - (= (&.sort n/< sample) - (&.reverse (&.sort n/> sample)))) - )))) - -(context: "Lists: Part 3" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - sample (r.list size r.nat) - other-size bounded-size - other-sample (r.list other-size r.nat) - separator r.nat - from (|> r.nat (:: @ map (n/% 10))) - to (|> r.nat (:: @ map (n/% 10))) - #let [(^open ".") (&.equivalence number.equivalence) - (^open "&/.") &.functor]] - ($_ seq - (test "If you zip 2 lists, the result's size will be that of the smaller list." - (n/= (&.size (&.zip2 sample other-sample)) - (n/min (&.size sample) (&.size other-sample)))) - - (test "I can pair-up elements of a list in order." - (let [(^open ".") &.functor - zipped (&.zip2 sample other-sample) - num-zipper (&.size zipped)] - (and (|> zipped (map product.left) (= (&.take num-zipper sample))) - (|> zipped (map product.right) (= (&.take num-zipper other-sample)))))) - - (test "You can generate indices for any size, and they will be in ascending order." - (let [(^open ".") &.functor - indices (&.indices size)] - (and (n/= size (&.size indices)) - (= indices - (&.sort n/< indices)) - (&.every? (n/= (dec size)) - (&.zip2-with n/+ - indices - (&.sort n/> indices))) - ))) - - (test "The 'interpose' function places a value between every member of a list." - (let [(^open ".") &.functor - sample+ (&.interpose separator sample)] - (and (n/= (|> size (n/* 2) dec) - (&.size sample+)) - (|> sample+ &.as-pairs (map product.right) (&.every? (n/= separator)))))) - - (test "List append is a monoid." - (let [(^open ".") &.monoid] - (and (= sample (compose identity sample)) - (= sample (compose sample identity)) - (let [[left right] (&.split size (compose sample other-sample))] - (and (= sample left) - (= other-sample right)))))) - - (test "Apply allows you to create singleton lists, and apply lists of functions to lists of values." - (let [(^open ".") &.monad - (^open ".") &.apply] - (and (= (list separator) (wrap separator)) - (= (map inc sample) - (apply (wrap inc) sample))))) - - (test "List concatenation is a monad." - (let [(^open ".") &.monad - (^open ".") &.monoid] - (= (compose sample other-sample) - (join (list sample other-sample))))) - - (test "You can find any value that satisfies some criterium, if such values exist in the list." - (case (&.find n/even? sample) - (#.Some found) - (and (n/even? found) - (&.any? n/even? sample) - (not (&.every? (bit.complement n/even?) sample))) - - #.None - (and (not (&.any? n/even? sample)) - (&.every? (bit.complement n/even?) sample)))) - - (test "You can iteratively construct a list, generating values until you're done." - (= (&.n/range 0 (dec size)) - (&.iterate (function (_ n) (if (n/< size n) (#.Some (inc n)) #.None)) - 0))) - - (test "Can enumerate all elements in a list." - (let [enum-sample (&.enumerate sample)] - (and (= (&.indices (&.size enum-sample)) - (&/map product.left enum-sample)) - (= sample - (&/map product.right enum-sample))))) - - (test "Ranges can be constructed forward and backwards." - (and (let [(^open "list/.") (&.equivalence number.equivalence)] - (list/= (&.n/range from to) - (&.reverse (&.n/range to from)))) - (let [(^open "list/.") (&.equivalence number.equivalence) - from (.int from) - to (.int to)] - (list/= (&.i/range from to) - (&.reverse (&.i/range to from)))))) - )))) - -## TODO: Add again once new-luxc becomes the standard compiler. -(context: "Monad transformer" - (let [lift (&.lift io.monad) - (^open "io/.") io.monad] - (test "Can add list functionality to any monad." - (|> (io.run (do (&.ListT io.monad) - [a (lift (io/wrap +123)) - b (wrap +456)] - (wrap (i/+ a b)))) - (case> (^ (list +579)) #1 - _ #0))))) diff --git a/stdlib/test/test/lux/data/collection/queue.lux b/stdlib/test/test/lux/data/collection/queue.lux deleted file mode 100644 index 4f4f12ef0..000000000 --- a/stdlib/test/test/lux/data/collection/queue.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["." number] - [collection - ["&" queue]]] - [math - ["r" random]]] - lux/test) - -(context: "Queues" - (<| (times 100) - (do @ - [size (:: @ map (n/% 100) r.nat) - sample (r.queue size r.nat) - non-member (|> r.nat - (r.filter (|>> (&.member? number.equivalence sample) not)))] - ($_ seq - (test "I can query the size of a queue (and empty queues have size 0)." - (if (n/= 0 size) - (&.empty? sample) - (n/= size (&.size sample)))) - - (test "Enqueueing and dequeing affects the size of queues." - (and (n/= (inc size) (&.size (&.push non-member sample))) - (or (&.empty? sample) - (n/= (dec size) (&.size (&.pop sample)))) - (n/= size (&.size (&.pop (&.push non-member sample)))))) - - (test "Transforming to/from list can't change the queue." - (let [(^open "&/.") (&.equivalence number.equivalence)] - (|> sample - &.to-list &.from-list - (&/= sample)))) - - (test "I can always peek at a non-empty queue." - (case (&.peek sample) - #.None (&.empty? sample) - (#.Some _) #1)) - - (test "I can query whether an element belongs to a queue." - (and (not (&.member? number.equivalence sample non-member)) - (&.member? number.equivalence (&.push non-member sample) - non-member) - (case (&.peek sample) - #.None - (&.empty? sample) - - (#.Some first) - (and (&.member? number.equivalence sample first) - (not (&.member? number.equivalence (&.pop sample) first)))))) - )))) diff --git a/stdlib/test/test/lux/data/collection/queue/priority.lux b/stdlib/test/test/lux/data/collection/queue/priority.lux deleted file mode 100644 index 3868a01a8..000000000 --- a/stdlib/test/test/lux/data/collection/queue/priority.lux +++ /dev/null @@ -1,57 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do Monad)]] - [data - [number - ["." nat]] - ["." maybe] - [collection - [queue - ["&" priority]]]] - [math - ["r" random]]] - lux/test) - -(def: (gen-queue size) - (-> Nat (r.Random (&.Queue Nat))) - (do r.monad - [inputs (r.list size r.nat)] - (monad.fold @ (function (_ head tail) - (do @ - [priority r.nat] - (wrap (&.push priority head tail)))) - &.empty - inputs))) - -(context: "Queues" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (n/% 100))) - sample (gen-queue size) - non-member-priority r.nat - non-member (|> r.nat (r.filter (|>> (&.member? nat.equivalence sample) not)))] - ($_ seq - (test "I can query the size of a queue (and empty queues have size 0)." - (n/= size (&.size sample))) - - (test "Enqueueing and dequeing affects the size of queues." - (and (n/= (inc size) - (&.size (&.push non-member-priority non-member sample))) - (or (n/= 0 (&.size sample)) - (n/= (dec size) - (&.size (&.pop sample)))))) - - (test "I can query whether an element belongs to a queue." - (and (and (not (&.member? nat.equivalence sample non-member)) - (&.member? nat.equivalence - (&.push non-member-priority non-member sample) - non-member)) - (or (n/= 0 (&.size sample)) - (and (&.member? nat.equivalence - sample - (maybe.assume (&.peek sample))) - (not (&.member? nat.equivalence - (&.pop sample) - (maybe.assume (&.peek sample)))))))) - )))) diff --git a/stdlib/test/test/lux/data/collection/row.lux b/stdlib/test/test/lux/data/collection/row.lux deleted file mode 100644 index 2eb342e6e..000000000 --- a/stdlib/test/test/lux/data/collection/row.lux +++ /dev/null @@ -1,82 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)]] - [data - ["." number] - ["." maybe] - [collection - ["&" row] - [list ("list/." fold)]]] - [math - ["r" random]]] - lux/test) - -(context: "Rows" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) - idx (|> r.nat (:: @ map (n/% size))) - sample (r.row size r.nat) - other-sample (r.row size r.nat) - non-member (|> r.nat (r.filter (|>> (&.member? number.equivalence sample) not))) - #let [(^open "&/.") (&.equivalence number.equivalence) - (^open "&/.") &.apply - (^open "&/.") &.monad - (^open "&/.") &.fold - (^open "&/.") &.monoid]] - ($_ seq - (test "Can query size of row." - (if (&.empty? sample) - (and (n/= 0 size) - (n/= 0 (&.size sample))) - (n/= size (&.size sample)))) - - (test "Can add and remove elements to rows." - (and (n/= (inc size) (&.size (&.add non-member sample))) - (n/= (dec size) (&.size (&.pop sample))))) - - (test "Can put and get elements into rows." - (|> sample - (&.put idx non-member) - (&.nth idx) - maybe.assume - (is? non-member))) - - (test "Can update elements of rows." - (|> sample - (&.put idx non-member) (&.update idx inc) - (&.nth idx) maybe.assume - (n/= (inc non-member)))) - - (test "Can safely transform to/from lists." - (|> sample &.to-list &.from-list (&/= sample))) - - (test "Can identify members of a row." - (and (not (&.member? number.equivalence sample non-member)) - (&.member? number.equivalence (&.add non-member sample) non-member))) - - (test "Can fold over elements of row." - (n/= (list/fold n/+ 0 (&.to-list sample)) - (&/fold n/+ 0 sample))) - - (test "Functor goes over every element." - (let [there (&/map inc sample) - back-again (&/map dec there)] - (and (not (&/= sample there)) - (&/= sample back-again)))) - - (test "Apply allows you to create singleton rows, and apply rows of functions to rows of values." - (and (&/= (&.row non-member) (&/wrap non-member)) - (&/= (&/map inc sample) (&/apply (&/wrap inc) sample)))) - - (test "Row concatenation is a monad." - (&/= (&/compose sample other-sample) - (&/join (&.row sample other-sample)))) - - (test "Can reverse." - (and (not (&/= sample - (&.reverse sample))) - (not (&/= sample - (&.reverse (&.reverse sample)))))) - )))) diff --git a/stdlib/test/test/lux/data/collection/sequence.lux b/stdlib/test/test/lux/data/collection/sequence.lux deleted file mode 100644 index de398e6f6..000000000 --- a/stdlib/test/test/lux/data/collection/sequence.lux +++ /dev/null @@ -1,103 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - comonad] - [data - ["." maybe] - ["." number ("nat/." codec)] - ["." text ("text/." monoid)] - [collection - ["." list] - ["&" sequence]]] - [math - ["r" random]]] - lux/test) - -(context: "Sequences" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2)))) - offset (|> r.nat (:: @ map (n/% 100))) - factor (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2)))) - elem r.nat - cycle-seed (r.list size r.nat) - cycle-sample-idx (|> r.nat (:: @ map (n/% 1000))) - #let [(^open "List/.") (list.equivalence number.equivalence) - sample0 (&.iterate inc 0) - sample1 (&.iterate inc offset)]] - ($_ seq - (test "Can move along a sequence and take slices off it." - (and (and (List/= (list.n/range 0 (dec size)) - (&.take size sample0)) - (List/= (list.n/range offset (dec (n/+ offset size))) - (&.take size (&.drop offset sample0))) - (let [[drops takes] (&.split size sample0)] - (and (List/= (list.n/range 0 (dec size)) - drops) - (List/= (list.n/range size (dec (n/* 2 size))) - (&.take size takes))))) - (and (List/= (list.n/range 0 (dec size)) - (&.take-while (n/< size) sample0)) - (List/= (list.n/range offset (dec (n/+ offset size))) - (&.take-while (n/< (n/+ offset size)) - (&.drop-while (n/< offset) sample0))) - (let [[drops takes] (&.split-while (n/< size) sample0)] - (and (List/= (list.n/range 0 (dec size)) - drops) - (List/= (list.n/range size (dec (n/* 2 size))) - (&.take-while (n/< (n/* 2 size)) takes))))) - )) - - (test "Can repeat any element and infinite number of times." - (n/= elem (&.nth offset (&.repeat elem)))) - - (test "Can obtain the head & tail of a sequence." - (and (n/= offset (&.head sample1)) - (List/= (list.n/range (inc offset) (n/+ offset size)) - (&.take size (&.tail sample1))))) - - (test "Can filter sequences." - (and (n/= (n/* 2 offset) - (&.nth offset - (&.filter n/even? sample0))) - (let [[evens odds] (&.partition n/even? (&.iterate inc 0))] - (and (n/= (n/* 2 offset) - (&.nth offset evens)) - (n/= (inc (n/* 2 offset)) - (&.nth offset odds)))))) - - (test "Functor goes over 'all' elements in a sequence." - (let [(^open "&/.") &.functor - there (&/map (n/* factor) sample0) - back-again (&/map (n// factor) there)] - (and (not (List/= (&.take size sample0) - (&.take size there))) - (List/= (&.take size sample0) - (&.take size back-again))))) - - (test "CoMonad produces a value for every element in a sequence." - (let [(^open "&/.") &.functor] - (List/= (&.take size (&/map (n/* factor) sample1)) - (&.take size - (be &.comonad - [inputs sample1] - (n/* factor (&.head inputs))))))) - - (test "'unfold' generalizes 'iterate'." - (let [(^open "&/.") &.functor - (^open "List/.") (list.equivalence text.equivalence)] - (List/= (&.take size - (&/map nat/encode (&.iterate inc offset))) - (&.take size - (&.unfold (function (_ n) [(inc n) (nat/encode n)]) - offset))))) - - (test "Can cycle over the same elements as an infinite sequence." - (|> (&.cycle cycle-seed) - maybe.assume - (&.nth cycle-sample-idx) - (n/= (|> cycle-seed - (list.nth (n/% size cycle-sample-idx)) - maybe.assume)))) - )))) diff --git a/stdlib/test/test/lux/data/collection/set.lux b/stdlib/test/test/lux/data/collection/set.lux deleted file mode 100644 index bbdc945f7..000000000 --- a/stdlib/test/test/lux/data/collection/set.lux +++ /dev/null @@ -1,67 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["." number] - [collection - ["&" set (#+ Set)] - ["." list]]] - [math - ["r" random]]] - lux/test) - -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n/% 100)))) - -(context: "Sets" - (<| (times 100) - (do @ - [sizeL gen-nat - sizeR gen-nat - setL (r.set number.hash sizeL gen-nat) - setR (r.set number.hash sizeR gen-nat) - non-member (|> gen-nat - (r.filter (|>> (&.member? setL) not))) - #let [(^open "&/.") &.equivalence]] - ($_ seq - (test "I can query the size of a set." - (and (n/= sizeL (&.size setL)) - (n/= sizeR (&.size setR)))) - - (test "Converting sets to/from lists can't change their values." - (|> setL - &.to-list (&.from-list number.hash) - (&/= setL))) - - (test "Every set is a sub-set of the union of itself with another." - (let [setLR (&.union setL setR)] - (and (&.sub? setLR setL) - (&.sub? setLR setR)))) - - (test "Every set is a super-set of the intersection of itself with another." - (let [setLR (&.intersection setL setR)] - (and (&.super? setLR setL) - (&.super? setLR setR)))) - - (test "Union with the empty set leaves a set unchanged." - (&/= setL - (&.union (&.new number.hash) - setL))) - - (test "Intersection with the empty set results in the empty set." - (let [empty-set (&.new number.hash)] - (&/= empty-set - (&.intersection empty-set setL)))) - - (test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (&.difference setR setL)] - (not (list.any? (&.member? sub) (&.to-list setR))))) - - (test "Every member of a set must be identifiable." - (and (not (&.member? setL non-member)) - (&.member? (&.add non-member setL) non-member) - (not (&.member? (&.remove non-member (&.add non-member setL)) non-member)))) - )))) diff --git a/stdlib/test/test/lux/data/collection/set/ordered.lux b/stdlib/test/test/lux/data/collection/set/ordered.lux deleted file mode 100644 index 384a0506b..000000000 --- a/stdlib/test/test/lux/data/collection/set/ordered.lux +++ /dev/null @@ -1,98 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["." number] - [text - format] - [collection - ["." set - ["&" ordered]] - ["." list]]] - [math - ["r" random]]] - lux/test) - -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n/% 100)))) - -(context: "Sets" - (<| (times 100) - (do @ - [sizeL gen-nat - sizeR gen-nat - listL (|> (r.set number.hash sizeL gen-nat) (:: @ map set.to-list)) - listR (|> (r.set number.hash sizeR gen-nat) (:: @ map set.to-list)) - #let [(^open "&/.") &.equivalence - setL (&.from-list number.order listL) - setR (&.from-list number.order listR) - sortedL (list.sort n/< listL) - minL (list.head sortedL) - maxL (list.last sortedL)]] - ($_ seq - (test "I can query the size of a set." - (n/= sizeL (&.size setL))) - - (test "Can query minimum value." - (case [(&.min setL) minL] - [#.None #.None] - #1 - - [(#.Some reference) (#.Some sample)] - (n/= reference sample) - - _ - #0)) - - (test "Can query maximum value." - (case [(&.max setL) maxL] - [#.None #.None] - #1 - - [(#.Some reference) (#.Some sample)] - (n/= reference sample) - - _ - #0)) - - (test "Converting sets to/from lists can't change their values." - (|> setL - &.to-list (&.from-list number.order) - (&/= setL))) - - (test "Order is preserved." - (let [listL (&.to-list setL) - (^open "L/.") (list.equivalence number.equivalence)] - (L/= listL - (list.sort n/< listL)))) - - (test "Every set is a sub-set of the union of itself with another." - (let [setLR (&.union setL setR)] - (and (&.sub? setLR setL) - (&.sub? setLR setR)))) - - (test "Every set is a super-set of the intersection of itself with another." - (let [setLR (&.intersection setL setR)] - (and (&.super? setLR setL) - (&.super? setLR setR)))) - - (test "Union with the empty set leaves a set unchanged." - (&/= setL - (&.union (&.new number.order) - setL))) - - (test "Intersection with the empty set results in the empty set." - (let [empty-set (&.new number.order)] - (&/= empty-set - (&.intersection empty-set setL)))) - - (test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (&.difference setR setL)] - (not (list.any? (&.member? sub) (&.to-list setR))))) - - (test "Every member of a set must be identifiable." - (list.every? (&.member? setL) (&.to-list setL))) - )))) diff --git a/stdlib/test/test/lux/data/collection/stack.lux b/stdlib/test/test/lux/data/collection/stack.lux deleted file mode 100644 index d203b4246..000000000 --- a/stdlib/test/test/lux/data/collection/stack.lux +++ /dev/null @@ -1,46 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - ["." maybe] - [collection - ["&" stack]]] - [math - ["r" random]]] - lux/test) - -(def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n/% 100)))) - -(context: "Stacks" - (<| (times 100) - (do @ - [size gen-nat - sample (r.stack size gen-nat) - new-top gen-nat] - ($_ seq - (test "Can query the size of a stack." - (n/= size (&.size sample))) - - (test "Can peek inside non-empty stacks." - (case (&.peek sample) - #.None (&.empty? sample) - (#.Some _) (not (&.empty? sample)))) - - (test "Popping empty stacks doesn't change anything. - But, if they're non-empty, the top of the stack is removed." - (let [sample' (&.pop sample)] - (or (n/= (&.size sample) (inc (&.size sample'))) - (and (&.empty? sample) (&.empty? sample'))) - )) - - (test "Pushing onto a stack always increases it by 1, adding a new value at the top." - (and (is? sample - (&.pop (&.push new-top sample))) - (n/= (inc (&.size sample)) (&.size (&.push new-top sample))) - (|> (&.push new-top sample) &.peek maybe.assume - (is? new-top)))) - )))) diff --git a/stdlib/test/test/lux/data/collection/tree/rose.lux b/stdlib/test/test/lux/data/collection/tree/rose.lux deleted file mode 100644 index 47dbf94cf..000000000 --- a/stdlib/test/test/lux/data/collection/tree/rose.lux +++ /dev/null @@ -1,51 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["." product] - ["." number] - [text ("text/." equivalence) - format] - [collection - ["." list ("list/." functor fold)] - [tree - ["&" rose]]]] - [math - ["r" random]]] - lux/test) - -(def: gen-tree - (r.Random [Nat (&.Tree Nat)]) - (r.rec - (function (_ gen-tree) - (r.either (:: r.monad map (|>> &.leaf [1]) r.nat) - (do r.monad - [value r.nat - num-children (|> r.nat (:: @ map (n/% 3))) - children' (r.list num-children gen-tree) - #let [size' (list/fold n/+ 0 (list/map product.left children')) - children (list/map product.right children')]] - (wrap [(inc size') - (&.branch value children)])) - )))) - -(context: "Trees" - (<| (times 100) - (do @ - [[size sample] gen-tree - #let [(^open "&/.") (&.equivalence number.equivalence) - (^open "&/.") &.fold - concat (function (_ addition partial) (format partial (%n addition)))]] - ($_ seq - (test "Can compare trees for equivalence." - (&/= sample sample)) - - (test "Can flatten a tree to get all the nodes as a flat tree." - (n/= size - (list.size (&.flatten sample)))) - - (test "Can fold trees." - (text/= (&/fold concat "" sample) - (list/fold concat "" (&.flatten sample)))) - )))) diff --git a/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux deleted file mode 100644 index 3abf1dd26..000000000 --- a/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux +++ /dev/null @@ -1,128 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - ["." number] - ["." maybe] - ["." text - format] - [collection - ["." list] - [tree - ["." rose - ["&" zipper]]]]] - [math - ["r" random]]] - lux/test) - -(def: gen-tree - (r.Random (rose.Tree Nat)) - (r.rec (function (_ gen-tree) - (do r.monad - ## Each branch can have, at most, 1 child. - [size (|> r.nat (:: @ map (n/% 2)))] - (r.and r.nat - (r.list size gen-tree)))))) - -(def: (to-end zipper) - (All [a] (-> (&.Zipper a) (&.Zipper a))) - (loop [zipper zipper] - (if (&.end? zipper) - zipper - (recur (&.next zipper))))) - -(context: "Zippers." - (<| (times 100) - (do @ - [sample gen-tree - new-val r.nat - pre-val r.nat - post-val r.nat - #let [(^open "tree/.") (rose.equivalence number.equivalence) - (^open "list/.") (list.equivalence number.equivalence)]] - ($_ seq - (test "Trees can be converted to/from zippers." - (|> sample - &.zip &.unzip - (tree/= sample))) - - (test "Creating a zipper gives you a root node." - (|> sample &.zip &.root?)) - - (test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (let [child (|> zipper &.down)] - (and (not (tree/= sample (&.unzip child))) - (|> child &.up (is? zipper) not) - (|> child &.root (is? zipper) not))) - (and (&.leaf? zipper) - (|> zipper (&.prepend-child new-val) &.branch?))))) - - (test "Can prepend and append children." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (let [mid-val (|> zipper &.down &.value) - zipper (|> zipper - (&.prepend-child pre-val) - (&.append-child post-val))] - (and (|> zipper &.down &.value (is? pre-val)) - (|> zipper &.down &.right &.value (is? mid-val)) - (|> zipper &.down &.right &.right &.value (is? post-val)) - (|> zipper &.down &.rightmost &.leftmost &.value (is? pre-val)) - (|> zipper &.down &.right &.left &.value (is? pre-val)) - (|> zipper &.down &.rightmost &.value (is? post-val)))) - #1))) - - (test "Can insert children around a node (unless it's root)." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (let [mid-val (|> zipper &.down &.value) - zipper (|> zipper - &.down - (&.insert-left pre-val) - maybe.assume - (&.insert-right post-val) - maybe.assume - &.up)] - (and (|> zipper &.down &.value (is? pre-val)) - (|> zipper &.down &.right &.value (is? mid-val)) - (|> zipper &.down &.right &.right &.value (is? post-val)) - (|> zipper &.down &.rightmost &.leftmost &.value (is? pre-val)) - (|> zipper &.down &.right &.left &.value (is? pre-val)) - (|> zipper &.down &.rightmost &.value (is? post-val)))) - (and (|> zipper (&.insert-left pre-val) (case> (#.Some _) #0 - #.None #1)) - (|> zipper (&.insert-right post-val) (case> (#.Some _) #0 - #.None #1)))))) - - (test "Can set and update the value of a node." - (|> sample &.zip (&.set new-val) &.value (n/= new-val))) - - (test "Zipper traversal follows the outline of the tree depth-first." - (list/= (rose.flatten sample) - (loop [zipper (&.zip sample)] - (if (&.end? zipper) - (list (&.value zipper)) - (#.Cons (&.value zipper) - (recur (&.next zipper))))))) - - (test "Backwards zipper traversal yield reverse tree flatten." - (list/= (list.reverse (rose.flatten sample)) - (loop [zipper (to-end (&.zip sample))] - (if (&.root? zipper) - (list (&.value zipper)) - (#.Cons (&.value zipper) - (recur (&.prev zipper))))))) - - (test "Can remove nodes (except root nodes)." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (and (|> zipper &.down &.root? not) - (|> zipper &.down &.remove (case> #.None #0 - (#.Some node) (&.root? node)))) - (|> zipper &.remove (case> #.None #1 - (#.Some _) #0))))) - )))) diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux deleted file mode 100644 index 503421db2..000000000 --- a/stdlib/test/test/lux/data/color.lux +++ /dev/null @@ -1,99 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - ["@" color] - [number ("frac/." number)]] - ["." math - ["r" random]]] - lux/test) - -(def: color - (r.Random @.Color) - (|> ($_ r.and r.nat r.nat r.nat) - (:: r.monad map @.from-rgb))) - -(def: scale - (-> Nat Frac) - (|>> .int int-to-frac)) - -(def: square (-> Frac Frac) (math.pow +2.0)) - -(def: (distance from to) - (-> @.Color @.Color Frac) - (let [[fr fg fb] (@.to-rgb from) - [tr tg tb] (@.to-rgb to)] - (math.pow +0.5 ($_ f/+ - (|> (scale tr) (f/- (scale fr)) square) - (|> (scale tg) (f/- (scale fg)) square) - (|> (scale tb) (f/- (scale fb)) square))))) - -(def: error-margin Frac +1.8) - -(def: black (@.from-rgb [0 0 0])) -(def: white (@.from-rgb [255 255 255])) - -(do-template [<field>] - [(def: (<field> color) - (-> @.Color Frac) - (let [[hue saturation luminance] (@.to-hsl color)] - <field>))] - - [saturation] - [luminance] - ) - -(context: "Color." - (<| (times 100) - (do @ - [any color - colorful (|> color - (r.filter (function (_ color) (|> (distance color black) (f/>= +100.0)))) - (r.filter (function (_ color) (|> (distance color white) (f/>= +100.0))))) - mediocre (|> color - (r.filter (|>> saturation - ((function (_ saturation) - (and (f/>= +0.25 saturation) - (f/<= +0.75 saturation))))))) - ratio (|> r.frac (r.filter (f/>= +0.5)))] - ($_ seq - (test "Has equivalence." - (:: @.equivalence = any any)) - (test "Can convert to/from HSL." - (|> any @.to-hsl @.from-hsl - (distance any) - (f/<= error-margin))) - (test "Can convert to/from HSB." - (|> any @.to-hsb @.from-hsb - (distance any) - (f/<= error-margin))) - (test "Can convert to/from CMYK." - (|> any @.to-cmyk @.from-cmyk - (distance any) - (f/<= error-margin))) - (test "Can interpolate between 2 colors." - (and (f/<= (distance colorful black) - (distance (@.darker ratio colorful) black)) - (f/<= (distance colorful white) - (distance (@.brighter ratio colorful) white)))) - (test "Can calculate complement." - (let [~any (@.complement any) - (^open "@/.") @.equivalence] - (and (not (@/= any ~any)) - (@/= any (@.complement ~any))))) - (test "Can saturate color." - (f/> (saturation mediocre) - (saturation (@.saturate ratio mediocre)))) - (test "Can de-saturate color." - (f/< (saturation mediocre) - (saturation (@.de-saturate ratio mediocre)))) - (test "Can gray-scale color." - (let [gray'ed (@.gray-scale mediocre)] - (and (f/= +0.0 - (saturation gray'ed)) - (|> (luminance gray'ed) - (f/- (luminance mediocre)) - frac/abs - (f/<= error-margin))))) - )))) diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux deleted file mode 100644 index 7f491dc2c..000000000 --- a/stdlib/test/test/lux/data/error.lux +++ /dev/null @@ -1,61 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - [monad (#+ do Monad)] - pipe] - [data - ["/" error (#+ Error)]]] - lux/test) - -(context: "Errors" - (let [(^open "//.") /.apply - (^open "//.") /.monad] - ($_ seq - (test "Functor correctly handles both cases." - (and (|> (: (Error Int) (#/.Success +10)) - (//map inc) - (case> (#/.Success +11) #1 _ #0)) - - (|> (: (Error Int) (#/.Failure "YOLO")) - (//map inc) - (case> (#/.Failure "YOLO") #1 _ #0)) - )) - - (test "Apply correctly handles both cases." - (and (|> (//wrap +20) - (case> (#/.Success +20) #1 _ #0)) - (|> (//apply (//wrap inc) (//wrap +10)) - (case> (#/.Success +11) #1 _ #0)) - (|> (//apply (//wrap inc) (#/.Failure "YOLO")) - (case> (#/.Failure "YOLO") #1 _ #0)))) - - (test "Monad correctly handles both cases." - (and (|> (do /.monad - [f (wrap i/+) - a (wrap +10) - b (wrap +20)] - (wrap (f a b))) - (case> (#/.Success +30) #1 _ #0)) - (|> (do /.monad - [f (wrap i/+) - a (#/.Failure "YOLO") - b (wrap +20)] - (wrap (f a b))) - (case> (#/.Failure "YOLO") #1 _ #0)) - )) - ))) - -(context: "Monad transformer" - (let [lift (/.lift io.monad) - (^open "io/.") io.monad] - (test "Can add error functionality to any monad." - (|> (io.run (do (/.ErrorT io.monad) - [a (lift (io/wrap +123)) - b (wrap +456)] - (wrap (i/+ a b)))) - (case> (#/.Success +579) - #1 - - _ - #0))))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux deleted file mode 100644 index f54b51c3b..000000000 --- a/stdlib/test/test/lux/data/format/json.lux +++ /dev/null @@ -1,183 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - codec - [equivalence (#+ Equivalence)] - pipe - ["p" parser]] - [data - ["." error] - ["." bit] - ["." maybe] - ["." number] - ["." text - format] - [format - ["@" json]] - [collection - [row (#+ row)] - ["d" dictionary] - ["." list]]] - [macro - [poly (#+ derived:)] - ["." poly/equivalence] - ["." poly/json]] - [type - ["." unit]] - [math - ["r" random]] - [time - ["ti" instant] - ["tda" date] - ## ["tdu" duration] - ] - test] - [test - [lux - [time - ["_." instant] - ## ["_." duration] - ["_." date]]]] - ) - -(def: gen-json - (r.Random @.JSON) - (r.rec (function (_ gen-json) - (do r.monad - [size (:: @ map (n/% 2) r.nat)] - ($_ r.or - (:: @ wrap []) - r.bit - (|> r.frac (:: @ map (f/* +1_000_000.0))) - (r.unicode size) - (r.row size gen-json) - (r.dictionary text.hash size (r.unicode size) gen-json) - ))))) - -(context: "JSON" - (<| (times 100) - (do @ - [sample gen-json - #let [(^open "@/.") @.equivalence - (^open "@/.") @.codec]] - ($_ seq - (test "Every JSON is equal to itself." - (@/= sample sample)) - - (test "Can encode/decode JSON." - (|> sample @/encode @/decode - (case> (#.Right result) - (@/= sample result) - - (#.Left _) - #0))) - )))) - -(type: Variant - (#Case0 Bit) - (#Case1 Text) - (#Case2 Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#bit Bit - #frac Frac - #text Text - #maybe (Maybe Frac) - #list (List Frac) - #dict (d.Dictionary Text Frac) - ## #variant Variant - ## #tuple [Bit Frac Text] - #recursive Recursive - ## #instant ti.Instant - ## #duration tdu.Duration - #date tda.Date - #grams (unit.Qty unit.Gram) - }) - -(def: gen-recursive - (r.Random Recursive) - (r.rec (function (_ gen-recursive) - (r.or r.frac - (r.and r.frac gen-recursive))))) - -(derived: (poly/equivalence.Equivalence<?> Recursive)) - -(def: qty - (All [unit] (r.Random (unit.Qty unit))) - (|> r.int (:: r.monad map unit.in))) - -(def: gen-record - (r.Random Record) - (do r.monad - [size (:: @ map (n/% 2) r.nat)] - ($_ r.and - r.bit - r.frac - (r.unicode size) - (r.maybe r.frac) - (r.list size r.frac) - (r.dictionary text.hash size (r.unicode size) r.frac) - ## ($_ r.or r.bit (r.unicode size) r.frac) - ## ($_ r.and r.bit r.frac (r.unicode size)) - gen-recursive - ## _instant.instant - ## _duration.duration - _date.date - qty - ))) - -(derived: (poly/json.codec Record)) - -(structure: _ (Equivalence Record) - (def: (= recL recR) - (let [variant/= (function (_ left right) - (case [left right] - [(#Case0 left') (#Case0 right')] - (:: bit.equivalence = left' right') - - [(#Case1 left') (#Case1 right')] - (:: text.equivalence = left' right') - - [(#Case2 left') (#Case2 right')] - (f/= left' right') - - _ - #0))] - (and (:: bit.equivalence = (get@ #bit recL) (get@ #bit recR)) - (f/= (get@ #frac recL) (get@ #frac recR)) - (:: text.equivalence = (get@ #text recL) (get@ #text recR)) - (:: (maybe.equivalence number.equivalence) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list.equivalence number.equivalence) = (get@ #list recL) (get@ #list recR)) - (:: (d.equivalence number.equivalence) = (get@ #dict recL) (get@ #dict recR)) - ## (variant/= (get@ #variant recL) (get@ #variant recR)) - ## (let [[tL0 tL1 tL2] (get@ #tuple recL) - ## [tR0 tR1 tR2] (get@ #tuple recR)] - ## (and (:: bit.equivalence = tL0 tR0) - ## (f/= tL1 tR1) - ## (:: text.equivalence = tL2 tR2))) - (:: equivalence = (get@ #recursive recL) (get@ #recursive recR)) - ## (:: ti.equivalence = (get@ #instant recL) (get@ #instant recR)) - ## (:: tdu.equivalence = (get@ #duration recL) (get@ #duration recR)) - (:: tda.equivalence = (get@ #date recL) (get@ #date recR)) - (:: unit.equivalence = (get@ #grams recL) (get@ #grams recR)) - )))) - -(context: "Polytypism" - (<| (seed 14562075782602945288) - ## (times 100) - (do @ - [sample gen-record - #let [(^open "@/.") ..equivalence - (^open "@/.") ..codec]] - (test "Can encode/decode arbitrary types." - (|> sample @/encode @/decode - (case> (#error.Success result) - (@/= sample result) - - (#error.Failure error) - #0)))))) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux deleted file mode 100644 index 0f86eb63d..000000000 --- a/stdlib/test/test/lux/data/format/xml.lux +++ /dev/null @@ -1,121 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)] - ["p" parser] - pipe] - [data - ["." name] - ["E" error] - ["." maybe] - ["." text ("text/." equivalence) - format] - [format - ["&" xml]] - [collection - ["dict" dictionary] - ["." list ("list/." functor)]]] - [math - ["r" random ("r/." monad)]]] - lux/test) - -(def: char-range - Text - (format "_" - "abcdefghijklmnopqrstuvwxyz" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) - -(def: xml-char^ - (r.Random Nat) - (do r.monad - [idx (|> r.nat (:: @ map (n/% (text.size char-range))))] - (wrap (maybe.assume (text.nth idx char-range))))) - -(def: (size^ bottom top) - (-> Nat Nat (r.Random Nat)) - (let [constraint (|>> (n/% top) (n/max bottom))] - (r/map constraint r.nat))) - -(def: (xml-text^ bottom top) - (-> Nat Nat (r.Random Text)) - (do r.monad - [size (size^ bottom top)] - (r.text xml-char^ size))) - -(def: xml-identifier^ - (r.Random Name) - (r.and (xml-text^ 0 10) - (xml-text^ 1 10))) - -(def: gen-xml - (r.Random &.XML) - (r.rec (function (_ gen-xml) - (r.or (xml-text^ 1 10) - (do r.monad - [size (size^ 0 2)] - ($_ r.and - xml-identifier^ - (r.dictionary name.hash size xml-identifier^ (xml-text^ 0 10)) - (r.list size gen-xml))))))) - -(context: "XML." - (<| (times 100) - (do @ - [sample gen-xml - #let [(^open "&/.") &.equivalence - (^open "&/.") &.codec]] - ($_ seq - (test "Every XML is equal to itself." - (&/= sample sample)) - - (test "Can encode/decode XML." - (|> sample &/encode &/decode - (case> (#.Right result) - (&/= sample result) - - (#.Left error) - #0))) - )))) - -(context: "Parsing." - (<| (times 100) - (do @ - [text (xml-text^ 1 10) - num-children (|> r.nat (:: @ map (n/% 5))) - children (r.list num-children (xml-text^ 1 10)) - tag xml-identifier^ - attr xml-identifier^ - value (xml-text^ 1 10) - #let [node (#&.Node tag - (dict.put attr value &.attrs) - (list/map (|>> #&.Text) children))]] - ($_ seq - (test "Can parse text." - (E.default #0 - (do E.monad - [output (&.run (#&.Text text) - &.text)] - (wrap (text/= text output))))) - (test "Can parse attributes." - (E.default #0 - (do E.monad - [output (|> (&.attr attr) - (p.before &.ignore) - (&.run node))] - (wrap (text/= value output))))) - (test "Can parse nodes." - (E.default #0 - (do E.monad - [_ (|> (&.node tag) - (p.before &.ignore) - (&.run node))] - (wrap #1)))) - (test "Can parse children." - (E.default #0 - (do E.monad - [outputs (|> (&.children (p.some &.text)) - (&.run node))] - (wrap (:: (list.equivalence text.equivalence) = - children - outputs))))) - )))) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux deleted file mode 100644 index 31bf105cd..000000000 --- a/stdlib/test/test/lux/data/identity.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)] - comonad] - [data - ["&" identity] - [text ("text/." monoid equivalence)]]] - lux/test) - -(context: "Identity" - (let [(^open "&/.") &.apply - (^open "&/.") &.monad - (^open "&/.") &.comonad] - ($_ seq - (test "Functor does not affect values." - (text/= "yololol" (&/map (text/compose "yolo") "lol"))) - - (test "Apply does not affect values." - (and (text/= "yolo" (&/wrap "yolo")) - (text/= "yololol" (&/apply (&/wrap (text/compose "yolo")) (&/wrap "lol"))))) - - (test "Monad does not affect values." - (text/= "yololol" (do &.monad - [f (wrap text/compose) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b))))) - - (test "CoMonad does not affect values." - (and (text/= "yololol" (&/unwrap "yololol")) - (text/= "yololol" (be &.comonad - [f text/compose - a "yolo" - b "lol"] - (f a b))))) - ))) diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux deleted file mode 100644 index f00b572ab..000000000 --- a/stdlib/test/test/lux/data/lazy.lux +++ /dev/null @@ -1,54 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["&" lazy]] - [math - ["r" random]]] - lux/test) - -(context: "Lazy." - (<| (times 100) - (do @ - [left r.nat - right r.nat - #let [lazy (&.freeze (n/* left right)) - expected (n/* left right)]] - ($_ seq - (test "Lazying does not alter the expected value." - (n/= expected - (&.thaw lazy))) - (test "Lazy values only evaluate once." - (and (not (is? expected - (&.thaw lazy))) - (is? (&.thaw lazy) - (&.thaw lazy)))) - )))) - -(context: "Functor, Apply, Monad." - (<| (times 100) - (do @ - [sample r.nat] - ($_ seq - (test "Functor map." - (|> (&.freeze sample) - (:: &.functor map inc) - &.thaw - (n/= (inc sample)))) - - (test "Monad." - (|> (do &.monad - [f (wrap inc) - a (wrap sample)] - (wrap (f a))) - &.thaw - (n/= (inc sample)))) - - (test "Apply apply." - (let [(^open "&/.") &.monad - (^open "&/.") &.apply] - (|> (&/apply (&/wrap inc) (&/wrap sample)) - &.thaw - (n/= (inc sample))))) - )))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux deleted file mode 100644 index eb09491a1..000000000 --- a/stdlib/test/test/lux/data/maybe.lux +++ /dev/null @@ -1,69 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)] - pipe] - [data - ["&" maybe ("&/." monoid)] - ["." text ("text/." monoid)]] - ["." io ("io/." monad)]] - lux/test) - -(context: "Maybe" - (let [(^open "&/.") &.apply - (^open "&/.") &.monad - (^open "&/.") (&.equivalence text.equivalence)] - ($_ seq - (test "Can compare Maybe values." - (and (&/= #.None #.None) - (&/= (#.Some "yolo") (#.Some "yolo")) - (not (&/= (#.Some "yolo") (#.Some "lol"))) - (not (&/= (#.Some "yolo") #.None)))) - - (test "Monoid respects Maybe." - (and (&/= #.None &/identity) - (&/= (#.Some "yolo") (&/compose (#.Some "yolo") (#.Some "lol"))) - (&/= (#.Some "yolo") (&/compose (#.Some "yolo") #.None)) - (&/= (#.Some "lol") (&/compose #.None (#.Some "lol"))) - (&/= #.None (: (Maybe Text) (&/compose #.None #.None))))) - - (test "Functor respects Maybe." - (and (&/= #.None (&/map (text/compose "yolo") #.None)) - (&/= (#.Some "yololol") (&/map (text/compose "yolo") (#.Some "lol"))))) - - (test "Apply respects Maybe." - (and (&/= (#.Some "yolo") (&/wrap "yolo")) - (&/= (#.Some "yololol") - (&/apply (&/wrap (text/compose "yolo")) (&/wrap "lol"))))) - - (test "Monad respects Maybe." - (&/= (#.Some "yololol") - (do &.monad - [f (wrap text/compose) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b))))) - - (do r.monad - [default r.nat - maybe r.nat] - (_.test "Can have defaults for Maybe values." - (and (is? default (maybe.default default - #.None)) - - (is? maybe (maybe.default default - (#.Some maybe)))))) - ))) - -(context: "Monad transformer" - (let [lift (&.lift io.monad)] - (test "Can add maybe functionality to any monad." - (|> (io.run (do (&.MaybeT io.monad) - [a (lift (io/wrap +123)) - b (wrap +456)] - (wrap (i/+ a b)))) - (case> (#.Some +579) - #1 - - _ - #0))))) diff --git a/stdlib/test/test/lux/data/name.lux b/stdlib/test/test/lux/data/name.lux deleted file mode 100644 index 3855fe221..000000000 --- a/stdlib/test/test/lux/data/name.lux +++ /dev/null @@ -1,73 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - ["&" name] - ["." text ("text/." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(def: (gen-part size) - (-> Nat (r.Random Text)) - (|> (r.unicode size) (r.filter (|>> (text.contains? ".") not)))) - -(context: "Names" - (<| (times 100) - (do @ - [## First Name - sizeM1 (|> r.nat (:: @ map (n/% 100))) - sizeN1 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) - module1 (gen-part sizeM1) - short1 (gen-part sizeN1) - #let [name1 [module1 short1]] - ## Second Name - sizeM2 (|> r.nat (:: @ map (n/% 100))) - sizeN2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) - module2 (gen-part sizeM2) - short2 (gen-part sizeN2) - #let [name2 [module2 short2]] - #let [(^open "&/.") &.equivalence - (^open "&/.") &.codec]] - ($_ seq - (test "Can get the module & short parts of an name." - (and (is? module1 (&.module name1)) - (is? short1 (&.short name1)))) - - (test "Can compare names for equivalence." - (and (&/= name1 name1) - (if (&/= name1 name2) - (and (text/= module1 module2) - (text/= short1 short2)) - (or (not (text/= module1 module2)) - (not (text/= short1 short2)))))) - - (test "Can encode names as text." - (|> name1 - &/encode &/decode - (case> (#.Right dec-name) (&/= name1 dec-name) - _ #0))) - - (test "Encoding an name without a module component results in text equal to the short of the name." - (if (text.empty? module1) - (text/= short1 (&/encode name1)) - #1)) - )))) - -(context: "Name-related macros." - (let [(^open "&/.") &.equivalence] - ($_ seq - (test "Can obtain Name from identifier." - (and (&/= ["lux" "yolo"] (name-of .yolo)) - (&/= ["test/lux/data/name" "yolo"] (name-of ..yolo)) - (&/= ["" "yolo"] (name-of yolo)) - (&/= ["lux/test" "yolo"] (name-of lux/test.yolo)))) - - (test "Can obtain Name from tag." - (and (&/= ["lux" "yolo"] (name-of #.yolo)) - (&/= ["test/lux/data/name" "yolo"] (name-of #..yolo)) - (&/= ["" "yolo"] (name-of #yolo)) - (&/= ["lux/test" "yolo"] (name-of #lux/test.yolo))))))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux deleted file mode 100644 index 9d870ab08..000000000 --- a/stdlib/test/test/lux/data/number.lux +++ /dev/null @@ -1,185 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)] - pipe] - [data - number - [text ("text/." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(do-template [category rand-gen <Equivalence> <Order>] - [(context: (format "[" category "] " "Equivalence & Order") - (<| (times 100) - (do @ - [x rand-gen - y rand-gen] - (test "" (and (:: <Equivalence> = x x) - (or (:: <Equivalence> = x y) - (:: <Order> < y x) - (:: <Order> > y x)))))))] - - ["Nat" r.nat equivalence order] - ["Int" r.int equivalence order] - ["Rev" r.rev equivalence order] - ["Frac" r.frac equivalence order] - ) - -(do-template [category rand-gen <Number> <Order>] - [(context: (format "[" category "] " "Number") - (<| (times 100) - (do @ - [x rand-gen - #let [(^open ".") <Number> - (^open ".") <Order>]] - (test "" (and (>= x (abs x)) - ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0 - (or (text/= "Frac" category) - (not (= x (negate x)))) - (= x (negate (negate x))) - ## There is loss of precision when multiplying - (or (text/= "Rev" category) - (= x (* (signum x) - (abs x)))))))))] - - ["Nat" r.nat number order] - ["Int" r.int number order] - ["Rev" r.rev number order] - ["Frac" r.frac number order] - ) - -(do-template [category rand-gen <Enum> <Number> <Order>] - [(context: (format "[" category "] " "Enum") - (<| (times 100) - (do @ - [x rand-gen] - (test "" (let [(^open ".") <Number> - (^open ".") <Order>] - (and (> x - (:: <Enum> succ x)) - (< x - (:: <Enum> pred x)) - - (= x - (|> x (:: <Enum> pred) (:: <Enum> succ))) - (= x - (|> x (:: <Enum> succ) (:: <Enum> pred))) - ))))))] - - ["Nat" r.nat enum number order] - ["Int" r.int enum number order] - ) - -(do-template [category rand-gen <Number> <Order> <Interval> <test>] - [(context: (format "[" category "] " "Interval") - (<| (times 100) - (do @ - [x (|> rand-gen (r.filter <test>)) - #let [(^open ".") <Number> - (^open ".") <Order>]] - (test "" (and (<= x (:: <Interval> bottom)) - (>= x (:: <Interval> top)))))))] - - ["Nat" r.nat number order interval (function (_ _) #1)] - ["Int" r.int number order interval (function (_ _) #1)] - ## Both min and max values will be positive (thus, greater than zero) - ["Rev" r.rev number order interval (function (_ _) #1)] - ["Frac" r.frac number order interval (f/> +0.0)] - ) - -(do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>] - [(context: (format "[" category "] " "Monoid") - (<| (times 100) - (do @ - [x (|> rand-gen (:: @ map (|>> (:: <Number> abs) <cap>)) (r.filter <test>)) - #let [(^open ".") <Number> - (^open ".") <Order> - (^open ".") <Monoid>]] - (test "Composing with identity doesn't change the value." - (and (= x (compose identity x)) - (= x (compose x identity)) - (= identity (compose identity identity)))))))] - - ["Nat/Add" r.nat number order add@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Mul" r.nat number order mul@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Min" r.nat number order min@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Max" r.nat number order max@monoid (n/% 1000) (function (_ _) #1)] - ["Int/Add" r.int number order add@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Mul" r.int number order mul@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Min" r.int number order min@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Max" r.int number order max@monoid (i/% +1000) (function (_ _) #1)] - ["Rev/Add" r.rev number order add@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Mul" r.rev number order mul@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Min" r.rev number order min@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Max" r.rev number order max@monoid (r/% .125) (function (_ _) #1)] - ["Frac/Add" r.frac number order add@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Mul" r.frac number order mul@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Min" r.frac number order min@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Max" r.frac number order max@monoid (f/% +1000.0) (f/> +0.0)] - ) - -(do-template [<category> <rand-gen> <Equivalence> <Codec>] - [(context: (format "[" <category> "] " "Alternative formats") - (<| (times 100) - (do @ - [x <rand-gen>] - (test "Can encode/decode values." - (|> x - (:: <Codec> encode) - (:: <Codec> decode) - (case> (#.Right x') - (:: <Equivalence> = x x') - - (#.Left _) - #0))))))] - - ["Nat/Binary" r.nat equivalence binary@codec] - ["Nat/Octal" r.nat equivalence octal@codec] - ["Nat/Decimal" r.nat equivalence codec] - ["Nat/Hex" r.nat equivalence hex@codec] - - ["Int/Binary" r.int equivalence binary@codec] - ["Int/Octal" r.int equivalence octal@codec] - ["Int/Decimal" r.int equivalence codec] - ["Int/Hex" r.int equivalence hex@codec] - - ["Rev/Binary" r.rev equivalence binary@codec] - ["Rev/Octal" r.rev equivalence octal@codec] - ["Rev/Decimal" r.rev equivalence codec] - ["Rev/Hex" r.rev equivalence hex@codec] - - ["Frac/Binary" r.frac equivalence binary@codec] - ["Frac/Octal" r.frac equivalence octal@codec] - ["Frac/Decimal" r.frac equivalence codec] - ["Frac/Hex" r.frac equivalence hex@codec] - ) - -(context: "Can convert frac values to/from their bit patterns." - (<| (times 100) - (do @ - [raw r.frac - factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) - #let [sample (|> factor .int int-to-frac (f/* raw))]] - (test "Can convert frac values to/from their bit patterns." - (|> sample frac-to-bits bits-to-frac (f/= sample)))))) - -(context: "Macros for alternative numeric encodings." - ($_ seq - (test "Binary." - (and (n/= (bin "11001001") (bin "11_00_10_01")) - (i/= (bin "+11001001") (bin "+11_00_10_01")) - (r/= (bin ".11001001") (bin ".11_00_10_01")) - (f/= (bin "+1100.1001") (bin "+11_00.10_01")))) - (test "Octal." - (and (n/= (oct "615243") (oct "615_243")) - (i/= (oct "+615243") (oct "+615_243")) - (r/= (oct ".615243") (oct ".615_243")) - (f/= (oct "+6152.43") (oct "+615_2.43")))) - (test "Hexadecimal." - (and (n/= (hex "deadBEEF") (hex "dead_BEEF")) - (i/= (hex "+deadBEEF") (hex "+dead_BEEF")) - (r/= (hex ".deadBEEF") (hex ".dead_BEEF")) - (f/= (hex "+deadBE.EF") (hex "+dead_BE.EF")))))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux deleted file mode 100644 index 850845296..000000000 --- a/stdlib/test/test/lux/data/number/complex.lux +++ /dev/null @@ -1,201 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - ["." number ("frac/." number) - ["&" complex]] - [collection - ["." list ("list/." functor)]]] - ["." math - ["r" random]]] - lux/test) - -(def: margin-of-error Frac +1.0e-9) - -(def: (within? margin standard value) - (-> Frac &.Complex &.Complex Bit) - (let [real-dist (frac/abs (f/- (get@ #&.real standard) - (get@ #&.real value))) - imgn-dist (frac/abs (f/- (get@ #&.imaginary standard) - (get@ #&.imaginary value)))] - (and (f/< margin real-dist) - (f/< margin imgn-dist)))) - -(def: gen-dim - (r.Random Frac) - (do r.monad - [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) - measure (|> r.frac (r.filter (f/> +0.0)))] - (wrap (f/* (|> factor .int int-to-frac) - measure)))) - -(def: gen-complex - (r.Random &.Complex) - (do r.monad - [real gen-dim - imaginary gen-dim] - (wrap (&.complex real imaginary)))) - -(context: "Construction" - (<| (times 100) - (do @ - [real gen-dim - imaginary gen-dim] - ($_ seq - (test "Can build and tear apart complex numbers" - (let [r+i (&.complex real imaginary)] - (and (f/= real (get@ #&.real r+i)) - (f/= imaginary (get@ #&.imaginary r+i))))) - - (test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (&.not-a-number? (&.complex number.not-a-number imaginary)) - (&.not-a-number? (&.complex real number.not-a-number)))) - )))) - -(context: "Absolute value" - (<| (times 100) - (do @ - [real gen-dim - imaginary gen-dim] - ($_ seq - (test "Absolute value of complex >= absolute value of any of the parts." - (let [r+i (&.complex real imaginary) - abs (get@ #&.real (&.abs r+i))] - (and (f/>= (frac/abs real) abs) - (f/>= (frac/abs imaginary) abs)))) - - (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (number.not-a-number? (get@ #&.real (&.abs (&.complex number.not-a-number imaginary)))) - (number.not-a-number? (get@ #&.real (&.abs (&.complex real number.not-a-number)))))) - - (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.positive-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.positive-infinity)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.negative-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.negative-infinity)))))) - )))) - -(context: "Addidion, substraction, multiplication and division" - (<| (times 100) - (do @ - [x gen-complex - y gen-complex - factor gen-dim] - ($_ seq - (test "Adding 2 complex numbers is the same as adding their parts." - (let [z (&.+ y x)] - (and (&.= z - (&.complex (f/+ (get@ #&.real y) - (get@ #&.real x)) - (f/+ (get@ #&.imaginary y) - (get@ #&.imaginary x))))))) - - (test "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&.- y x)] - (and (&.= z - (&.complex (f/- (get@ #&.real y) - (get@ #&.real x)) - (f/- (get@ #&.imaginary y) - (get@ #&.imaginary x))))))) - - (test "Subtraction is the inverse of addition." - (and (|> x (&.+ y) (&.- y) (within? margin-of-error x)) - (|> x (&.- y) (&.+ y) (within? margin-of-error x)))) - - (test "Division is the inverse of multiplication." - (|> x (&.* y) (&./ y) (within? margin-of-error x))) - - (test "Scalar division is the inverse of scalar multiplication." - (|> x (&.*' factor) (&./' factor) (within? margin-of-error x))) - - (test "If you subtract the remainder, all divisions must be exact." - (let [rem (&.% y x) - quotient (|> x (&.- rem) (&./ y)) - floored (|> quotient - (update@ #&.real math.floor) - (update@ #&.imaginary math.floor))] - (within? +0.000000000001 - x - (|> quotient (&.* y) (&.+ rem))))) - )))) - -(context: "Conjugate, reciprocal, signum, negation" - (<| (times 100) - (do @ - [x gen-complex] - ($_ seq - (test "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (&.conjugate x)] - (and (f/= (get@ #&.real x) - (get@ #&.real cx)) - (f/= (frac/negate (get@ #&.imaginary x)) - (get@ #&.imaginary cx))))) - - (test "The reciprocal functions is its own inverse." - (|> x &.reciprocal &.reciprocal (within? margin-of-error x))) - - (test "x*(x^-1) = 1" - (|> x (&.* (&.reciprocal x)) (within? margin-of-error &.one))) - - (test "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &.signum &.abs (get@ #&.real))] - (or (f/= +0.0 signum-abs) - (f/= +1.0 signum-abs) - (f/= (math.pow +0.5 +2.0) signum-abs)))) - - (test "Negation is its own inverse." - (let [there (&.negate x) - back-again (&.negate there)] - (and (not (&.= there x)) - (&.= back-again x)))) - - (test "Negation doesn't change the absolute value." - (f/= (get@ #&.real (&.abs x)) - (get@ #&.real (&.abs (&.negate x))))) - )))) - -(def: (trigonometric-symmetry forward backward angle) - (-> (-> &.Complex &.Complex) (-> &.Complex &.Complex) &.Complex Bit) - (let [normal (|> angle forward backward)] - (|> normal forward backward (within? margin-of-error normal)))) - -(context: "Trigonometry" - (<| (seed 17274883666004960943) - ## (times 100) - (do @ - [angle (|> gen-complex (:: @ map (|>> (update@ #&.real (f/% +1.0)) - (update@ #&.imaginary (f/% +1.0)))))] - ($_ seq - (test "Arc-sine is the inverse of sine." - (trigonometric-symmetry &.sin &.asin angle)) - - (test "Arc-cosine is the inverse of cosine." - (trigonometric-symmetry &.cos &.acos angle)) - - (test "Arc-tangent is the inverse of tangent." - (trigonometric-symmetry &.tan &.atan angle)))))) - -(context: "Power 2 and exponential/logarithm" - (<| (times 100) - (do @ - [x gen-complex] - ($_ seq - (test "Root 2 is inverse of power 2." - (|> x (&.pow' +2.0) (&.pow' +0.5) (within? margin-of-error x))) - - (test "Logarithm is inverse of exponentiation." - (|> x &.log &.exp (within? margin-of-error x))) - )))) - -(context: "Complex roots" - (<| (times 100) - (do @ - [sample gen-complex - degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))] - (test "Can calculate the N roots for any complex number." - (|> sample - (&.roots degree) - (list/map (&.pow' (|> degree .int int-to-frac))) - (list.every? (within? margin-of-error sample))))))) diff --git a/stdlib/test/test/lux/data/number/i64.lux b/stdlib/test/test/lux/data/number/i64.lux deleted file mode 100644 index 62de5e56e..000000000 --- a/stdlib/test/test/lux/data/number/i64.lux +++ /dev/null @@ -1,75 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ do Monad)]] - [data - [number #* - ["&" i64]]] - [math - ["r" random]]] - lux/test) - -(context: "Bitwise operations." - (<| (times 100) - (do @ - [pattern r.nat - idx (:: @ map (n/% &.width) r.nat)] - ($_ seq - (test "Clearing and settings bits should alter the count." - (and (n/= (dec (&.count (&.set idx pattern))) - (&.count (&.clear idx pattern))) - (|> (&.count pattern) - (n/- (&.count (&.clear idx pattern))) - (n/<= 1)) - (|> (&.count (&.set idx pattern)) - (n/- (&.count pattern)) - (n/<= 1)))) - (test "Can query whether a bit is set." - (and (or (and (&.set? idx pattern) - (not (&.set? idx (&.clear idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.set idx pattern)))) - - (or (and (&.set? idx pattern) - (not (&.set? idx (&.flip idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.flip idx pattern)))))) - (test "The negation of a bit pattern should have a complementary bit-count." - (n/= &.width - (n/+ (&.count pattern) - (&.count (&.not pattern))))) - (test "Can do simple binary logic." - (and (n/= 0 - (&.and pattern - (&.not pattern))) - (n/= (&.not 0) - (&.or pattern - (&.not pattern))) - (n/= (&.not 0) - (&.xor pattern - (&.not pattern))) - (n/= 0 - (&.xor pattern - pattern)))) - (test "rotate-left and rotate-right are inverses of one another." - (and (|> pattern - (&.rotate-left idx) - (&.rotate-right idx) - (n/= pattern)) - (|> pattern - (&.rotate-right idx) - (&.rotate-left idx) - (n/= pattern)))) - (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." - (and (|> pattern - (&.rotate-left &.width) - (n/= pattern)) - (|> pattern - (&.rotate-right &.width) - (n/= pattern)))) - (test "Shift right respect the sign of ints." - (let [value (.int pattern)] - (if (i/< +0 value) - (i/< +0 (&.arithmetic-right-shift idx value)) - (i/>= +0 (&.arithmetic-right-shift idx value))))) - )))) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux deleted file mode 100644 index 63d1e5fc8..000000000 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ /dev/null @@ -1,116 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - [number - ["&" ratio ("&/." number)]]] - [math - ["r" random]]] - lux/test) - -(def: gen-part - (r.Random Nat) - (|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1))))) - -(def: gen-ratio - (r.Random &.Ratio) - (do r.monad - [numerator gen-part - denominator (|> gen-part - (r.filter (|>> (n/= 0) not)) - (r.filter (|>> (n/= numerator) not)))] - (wrap (&.ratio numerator denominator)))) - -(context: "Normalization" - (<| (times 100) - (do @ - [denom1 gen-part - denom2 gen-part - sample gen-ratio] - ($_ seq - (test "All zeroes are the same." - (&.= (&.ratio 0 denom1) - (&.ratio 0 denom2))) - - (test "All ratios are built normalized." - (|> sample - &.normalize - ("lux in-module" "lux/data/number/ratio") - (&.= sample))) - )))) - -(context: "Arithmetic" - (<| (times 100) - (do @ - [x gen-ratio - y gen-ratio - #let [min (&.min x y) - max (&.max x y)]] - ($_ seq - (test "Addition and subtraction are opposites." - (and (|> max (&.- min) (&.+ min) (&.= max)) - (|> max (&.+ min) (&.- min) (&.= max)))) - - (test "Multiplication and division are opposites." - (and (|> max (&./ min) (&.* min) (&.= max)) - (|> max (&.* min) (&./ min) (&.= max)))) - - (test "Modulus by a larger ratio doesn't change the value." - (|> min (&.% max) (&.= min))) - - (test "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&.% min) (&.< min))) - - (test "Can get the remainder of a division." - (let [remainder (&.% min max) - multiple (&.- remainder max) - factor (&./ min multiple)] - (and (|> factor (get@ #&.denominator) (n/= 1)) - (|> factor (&.* min) (&.+ remainder) (&.= max))))) - )))) - -(context: "Negation, absolute value and signum" - (<| (times 100) - (do @ - [sample gen-ratio] - ($_ seq - (test "Negation is it's own inverse." - (let [there (&/negate sample) - back-again (&/negate there)] - (and (not (&.= there sample)) - (&.= back-again sample)))) - - (test "All ratios are already at their absolute value." - (|> sample &/abs (&.= sample))) - - (test "Signum is the identity." - (|> sample (&.* (&/signum sample)) (&.= sample))) - )))) - -(context: "Order" - (<| (times 100) - (do @ - [x gen-ratio - y gen-ratio] - ($_ seq - (test "Can compare ratios." - (and (or (&.<= y x) - (&.> y x)) - (or (&.>= y x) - (&.< y x)))) - )))) - -(context: "Codec" - (<| (times 100) - (do @ - [sample gen-ratio - #let [(^open "&/.") &.codec]] - (test "Can encode/decode ratios." - (|> sample &/encode &/decode - (case> (#.Right output) - (&.= sample output) - - _ - #0)))))) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux deleted file mode 100644 index 86db80d0e..000000000 --- a/stdlib/test/test/lux/data/product.lux +++ /dev/null @@ -1,17 +0,0 @@ -(.module: - [lux #* - [data - ["@" product]]] - lux/test) - -(context: "Products" - ($_ seq - (test "Can access the sides of a pair." - (and (i/= +1 (@.left [+1 +2])) - (i/= +2 (@.right [+1 +2])))) - - (test "Can swap the sides of a pair." - (let [[_left _right] (@.swap [+1 +2])] - (and (i/= +2 _left) - (i/= +1 _right)))) - )) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux deleted file mode 100644 index d47922304..000000000 --- a/stdlib/test/test/lux/data/sum.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - [lux #* - [control - pipe] - [data - sum - ["." text] - [collection - ["." list]]]] - lux/test) - -(context: "Sum operations" - (let [(^open "List/.") (list.equivalence text.equivalence)] - ($_ seq - (test "Can inject values into Either." - (and (|> (left "Hello") (case> (0 "Hello") #1 _ #0)) - (|> (right "World") (case> (1 "World") #1 _ #0)))) - - (test "Can discriminate eithers based on their cases." - (let [[_lefts _rights] (partition (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2"))))] - (and (List/= _lefts - (lefts (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2"))))) - - (List/= _rights - (rights (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2")))))))) - - (test "Can apply a function to an Either value depending on the case." - (and (i/= +10 (either (function (_ _) +10) - (function (_ _) +20) - (: (| Text Text) (0 "")))) - (i/= +20 (either (function (_ _) +10) - (function (_ _) +20) - (: (| Text Text) (1 "")))))) - ))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux deleted file mode 100644 index 01cd2220d..000000000 --- a/stdlib/test/test/lux/data/text.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe] - [data - ["&" text - format] - [collection - ["." list]]] - [math - ["r" random]]] - lux/test) - -(context: "Size" - (<| (times 100) - (do @ - [size (:: @ map (n/% 100) r.nat) - sample (r.unicode size)] - (test "" (or (and (n/= 0 size) - (&.empty? sample)) - (n/= size (&.size sample))))))) - -(def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n/% 20) (n/+ 1))))) - -(context: "Locations" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - sample (r.unicode size)] - (test "" (|> sample - (&.nth idx) - (case> (^multi (#.Some char) - [(&.from-code char) char] - [[(&.index-of char sample) - (&.last-index-of char sample) - (&.index-of' char idx sample) - (&.last-index-of' char idx sample)] - [(#.Some io) (#.Some lio) - (#.Some io') (#.Some lio')]]) - (and (n/<= idx io) - (n/>= idx lio) - - (n/= idx io') - (n/>= idx lio') - - (&.contains? char sample)) - - _ - #0 - )) - )))) - -(context: "Text functions" - (<| (times 100) - (do @ - [sizeL bounded-size - sizeR bounded-size - sampleL (r.unicode sizeL) - sampleR (r.unicode sizeR) - #let [sample (&.concat (list sampleL sampleR)) - fake-sample (&.join-with " " (list sampleL sampleR)) - dup-sample (&.join-with "" (list sampleL sampleR)) - enclosed-sample (&.enclose [sampleR sampleR] sampleL) - (^open ".") &.equivalence]] - (test "" (and (not (= sample fake-sample)) - (= sample dup-sample) - (&.starts-with? sampleL sample) - (&.ends-with? sampleR sample) - (= enclosed-sample - (&.enclose' sampleR sampleL)) - - (|> (&.split sizeL sample) - (case> (#.Right [_l _r]) - (and (= sampleL _l) - (= sampleR _r) - (= sample (&.concat (list _l _r)))) - - _ - #0)) - - (|> [(&.clip 0 sizeL sample) - (&.clip sizeL (&.size sample) sample) - (&.clip' sizeL sample) - (&.clip' 0 sample)] - (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (= sampleL _l) - (= sampleR _r) - (= _r _r') - (= sample _f)) - - _ - #0)) - ) - )))) - -(context: "More text functions" - (<| (times 100) - (do @ - [sizeP bounded-size - sizeL bounded-size - #let [## The wider unicode charset includes control characters that - ## can make text replacement work improperly. - ## Because of that, I restrict the charset. - normal-char-gen (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))] - sep1 (r.text normal-char-gen 1) - sep2 (r.text normal-char-gen 1) - #let [part-gen (|> (r.text normal-char-gen sizeP) - (r.filter (|>> (&.contains? sep1) not)))] - parts (r.list sizeL part-gen) - #let [sample1 (&.concat (list.interpose sep1 parts)) - sample2 (&.concat (list.interpose sep2 parts)) - (^open "&/.") &.equivalence]] - ($_ seq - (test "Can split text through a separator." - (n/= (list.size parts) - (list.size (&.split-all-with sep1 sample1)))) - - (test "Can replace occurrences of a piece of text inside a larger text." - (&/= sample2 - (&.replace-all sep1 sep2 sample1))) - )))) - -(context: "Structures" - (let [(^open "&/.") &.order] - ($_ seq - (test "" (&/< "bcd" "abc")) - (test "" (not (&/< "abc" "abc"))) - (test "" (not (&/< "abc" "bcd"))) - (test "" (&/<= "bcd" "abc")) - (test "" (&/<= "abc" "abc")) - (test "" (not (&/<= "abc" "bcd"))) - (test "" (&/> "abc" "bcd")) - (test "" (not (&/> "abc" "abc"))) - (test "" (not (&/> "bcd" "abc"))) - (test "" (&/>= "abc" "bcd")) - (test "" (&/>= "abc" "abc")) - (test "" (not (&/>= "bcd" "abc"))) - ))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux deleted file mode 100644 index d3bbafe7e..000000000 --- a/stdlib/test/test/lux/data/text/format.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)]] - [data - ["." text - format]]] - lux/test) - -(context: "Formatters" - (let [(^open "&/.") text.equivalence] - ($_ seq - (test "Can format common values simply." - (and (&/= "#1" (%b #1)) - (&/= "123" (%n 123)) - (&/= "+123" (%i +123)) - (&/= "+123.456" (%f +123.456)) - (&/= ".5" (%r .5)) - (&/= (format text.double-quote "YOLO" text.double-quote) (%t "YOLO")) - (&/= "User-id: +123 -- Active: #1" (format "User-id: " (%i +123) " -- Active: " (%b #1))))) - ))) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux deleted file mode 100644 index a1e52b64c..000000000 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ /dev/null @@ -1,205 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe - ["p" parser]] - [data - ["." error (#+ Error)] - ["." text ("text/." equivalence) - format - ["&" lexer]] - [collection - ["." list]]] - [math - ["r" random]]] - lux/test) - -## [Utils] -(def: (should-fail input) - (All [a] (-> (Error a) Bit)) - (case input - (#.Left _) #1 - _ #0)) - -(def: (should-passT test input) - (-> Text (Error Text) Bit) - (case input - (#.Right output) - (text/= test output) - - _ - #0)) - -(def: (should-passL test input) - (-> (List Text) (Error (List Text)) Bit) - (let [(^open "list/.") (list.equivalence text.equivalence)] - (case input - (#.Right output) - (list/= test output) - - _ - #0))) - -(def: (should-passE test input) - (-> (Either Text Text) (Error (Either Text Text)) Bit) - (case input - (#.Right output) - (case [test output] - [(#.Left test) (#.Left output)] - (text/= test output) - - [(#.Right test) (#.Right output)] - (text/= test output) - - _ - #0) - - _ - #0)) - -## [Tests] -(context: "End" - ($_ seq - (test "Can detect the end of the input." - (|> (&.run "" - &.end) - (case> (#.Right _) #1 _ #0))) - - (test "Won't mistake non-empty text for no more input." - (|> (&.run "YOLO" - &.end) - (case> (#.Left _) #1 _ #0))) - )) - -(context: "Literals" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - sample (r.unicode size) - non-sample (|> (r.unicode size) - (r.filter (|>> (text/= sample) not)))] - ($_ seq - (test "Can find literal text fragments." - (and (|> (&.run sample - (&.this sample)) - (case> (#.Right []) #1 _ #0)) - (|> (&.run non-sample - (&.this sample)) - (case> (#.Left _) #1 _ #0)))) - )))) - -(context: "Custom lexers" - ($_ seq - (test "Can lex anything" - (and (should-passT "A" (&.run "A" - &.any)) - (should-fail (&.run "" - &.any)))) - - (test "Can lex characters ranges." - (and (should-passT "Y" (&.run "Y" - (&.range (char "X") (char "Z")))) - (should-fail (&.run "M" - (&.range (char "X") (char "Z")))))) - - (test "Can lex upper-case and lower-case letters." - (and (should-passT "Y" (&.run "Y" - &.upper)) - (should-fail (&.run "m" - &.upper)) - - (should-passT "y" (&.run "y" - &.lower)) - (should-fail (&.run "M" - &.lower)))) - - (test "Can lex numbers." - (and (should-passT "1" (&.run "1" - &.decimal)) - (should-fail (&.run " " - &.decimal)) - - (should-passT "7" (&.run "7" - &.octal)) - (should-fail (&.run "8" - &.octal)) - - (should-passT "1" (&.run "1" - &.hexadecimal)) - (should-passT "a" (&.run "a" - &.hexadecimal)) - (should-passT "A" (&.run "A" - &.hexadecimal)) - (should-fail (&.run " " - &.hexadecimal)) - )) - - (test "Can lex alphabetic characters." - (and (should-passT "A" (&.run "A" - &.alpha)) - (should-passT "a" (&.run "a" - &.alpha)) - (should-fail (&.run "1" - &.alpha)))) - - (test "Can lex alphanumeric characters." - (and (should-passT "A" (&.run "A" - &.alpha-num)) - (should-passT "a" (&.run "a" - &.alpha-num)) - (should-passT "1" (&.run "1" - &.alpha-num)) - (should-fail (&.run " " - &.alpha-num)))) - - (test "Can lex white-space." - (and (should-passT " " (&.run " " - &.space)) - (should-fail (&.run "8" - &.space)))) - )) - -(context: "Combinators" - ($_ seq - (test "Can combine lexers sequentially." - (and (|> (&.run "YO" - (p.and &.any &.any)) - (case> (#.Right ["Y" "O"]) #1 - _ #0)) - (should-fail (&.run "Y" - (p.and &.any &.any))))) - - (test "Can create the opposite of a lexer." - (and (should-passT "a" (&.run "a" - (&.not (p.or &.decimal &.upper)))) - (should-fail (&.run "A" - (&.not (p.or &.decimal &.upper)))))) - - (test "Can select from among a set of characters." - (and (should-passT "C" (&.run "C" - (&.one-of "ABC"))) - (should-fail (&.run "D" - (&.one-of "ABC"))))) - - (test "Can avoid a set of characters." - (and (should-passT "D" (&.run "D" - (&.none-of "ABC"))) - (should-fail (&.run "C" - (&.none-of "ABC"))))) - - (test "Can lex using arbitrary predicates." - (and (should-passT "D" (&.run "D" - (&.satisfies (function (_ c) #1)))) - (should-fail (&.run "C" - (&.satisfies (function (_ c) #0)))))) - - (test "Can apply a lexer multiple times." - (and (should-passT "0123456789ABCDEF" (&.run "0123456789ABCDEF" - (&.many &.hexadecimal))) - (should-fail (&.run "yolo" - (&.many &.hexadecimal))) - - (should-passT "" (&.run "" - (&.some &.hexadecimal))))) - )) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux deleted file mode 100644 index f6bc7d098..000000000 --- a/stdlib/test/test/lux/data/text/regex.lux +++ /dev/null @@ -1,286 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - pipe - ["p" parser]] - [data - [number (#+ hex)] - ["." text ("text/." equivalence) - format - ["." lexer (#+ Lexer)] - ["&" regex]]] - [math - ["r" random]] - [macro - ["s" syntax (#+ syntax:)]]] - lux/test) - -## [Utils] -(def: (should-pass regex input) - (-> (Lexer Text) Text Bit) - (|> (lexer.run input regex) - (case> (#.Right parsed) - (text/= parsed input) - - _ - #0))) - -(def: (should-passT test regex input) - (-> Text (Lexer Text) Text Bit) - (|> (lexer.run input regex) - (case> (#.Right parsed) - (text/= test parsed) - - _ - #0))) - -(def: (should-fail regex input) - (All [a] (-> (Lexer a) Text Bit)) - (|> (lexer.run input regex) - (case> (#.Left _) #1 _ #0))) - -(syntax: (should-check pattern regex input) - (wrap (list (` (|> (lexer.run (~ input) (~ regex)) - (case> (^ (#.Right (~ pattern))) - #1 - - (~' _) - #0)))))) - -## [Tests] -(context: "Regular Expressions [Basics]" - (test "Can parse character literals." - (and (should-pass (&.regex "a") "a") - (should-fail (&.regex "a") ".") - (should-pass (&.regex "\.") ".") - (should-fail (&.regex "\.") "a")))) - -(context: "Regular Expressions [System character classes]" - ($_ seq - (test "Can parse anything." - (should-pass (&.regex ".") "a")) - - (test "Can parse digits." - (and (should-pass (&.regex "\d") "0") - (should-fail (&.regex "\d") "m"))) - - (test "Can parse non digits." - (and (should-pass (&.regex "\D") "m") - (should-fail (&.regex "\D") "0"))) - - (test "Can parse white-space." - (and (should-pass (&.regex "\s") " ") - (should-fail (&.regex "\s") "m"))) - - (test "Can parse non white-space." - (and (should-pass (&.regex "\S") "m") - (should-fail (&.regex "\S") " "))) - - (test "Can parse word characters." - (and (should-pass (&.regex "\w") "_") - (should-fail (&.regex "\w") "^"))) - - (test "Can parse non word characters." - (and (should-pass (&.regex "\W") ".") - (should-fail (&.regex "\W") "a"))) - )) - -(context: "Regular Expressions [Special system character classes : Part 1]" - ($_ seq - (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\p{Lower}") "m") - (should-fail (&.regex "\p{Lower}") "M")) - - (and (should-pass (&.regex "\p{Upper}") "M") - (should-fail (&.regex "\p{Upper}") "m")) - - (and (should-pass (&.regex "\p{Alpha}") "M") - (should-fail (&.regex "\p{Alpha}") "0")) - - (and (should-pass (&.regex "\p{Digit}") "1") - (should-fail (&.regex "\p{Digit}") "n")) - - (and (should-pass (&.regex "\p{Alnum}") "1") - (should-fail (&.regex "\p{Alnum}") ".")) - - (and (should-pass (&.regex "\p{Space}") " ") - (should-fail (&.regex "\p{Space}") ".")) - )) - )) - -(context: "Regular Expressions [Special system character classes : Part 2]" - ($_ seq - (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\p{HexDigit}") "a") - (should-fail (&.regex "\p{HexDigit}") ".")) - - (and (should-pass (&.regex "\p{OctDigit}") "6") - (should-fail (&.regex "\p{OctDigit}") ".")) - - (and (should-pass (&.regex "\p{Blank}") text.tab) - (should-fail (&.regex "\p{Blank}") ".")) - - (and (should-pass (&.regex "\p{ASCII}") text.tab) - (should-fail (&.regex "\p{ASCII}") (text.from-code (hex "1234")))) - - (and (should-pass (&.regex "\p{Contrl}") (text.from-code (hex "12"))) - (should-fail (&.regex "\p{Contrl}") "a")) - - (and (should-pass (&.regex "\p{Punct}") "@") - (should-fail (&.regex "\p{Punct}") "a")) - - (and (should-pass (&.regex "\p{Graph}") "@") - (should-fail (&.regex "\p{Graph}") " ")) - - (and (should-pass (&.regex "\p{Print}") (text.from-code (hex "20"))) - (should-fail (&.regex "\p{Print}") (text.from-code (hex "1234")))) - )) - )) - -(context: "Regular Expressions [Custom character classes : Part 1]" - ($_ seq - (test "Can parse using custom character classes." - (and (should-pass (&.regex "[abc]") "a") - (should-fail (&.regex "[abc]") "m"))) - - (test "Can parse using character ranges." - (and (should-pass (&.regex "[a-z]") "a") - (should-pass (&.regex "[a-z]") "m") - (should-pass (&.regex "[a-z]") "z"))) - - (test "Can combine character ranges." - (and (should-pass (&.regex "[a-zA-Z]") "a") - (should-pass (&.regex "[a-zA-Z]") "m") - (should-pass (&.regex "[a-zA-Z]") "z") - (should-pass (&.regex "[a-zA-Z]") "A") - (should-pass (&.regex "[a-zA-Z]") "M") - (should-pass (&.regex "[a-zA-Z]") "Z"))) - )) - -(context: "Regular Expressions [Custom character classes : Part 2]" - ($_ seq - (test "Can negate custom character classes." - (and (should-fail (&.regex "[^abc]") "a") - (should-pass (&.regex "[^abc]") "m"))) - - (test "Can negate character ranges.." - (and (should-fail (&.regex "[^a-z]") "a") - (should-pass (&.regex "[^a-z]") "0"))) - - (test "Can parse negate combinations of character ranges." - (and (should-fail (&.regex "[^a-zA-Z]") "a") - (should-pass (&.regex "[^a-zA-Z]") "0"))) - )) - -(context: "Regular Expressions [Custom character classes : Part 3]" - ($_ seq - (test "Can make custom character classes more specific." - (and (let [RE (&.regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) - - (let [RE (&.regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) - - (let [RE (&.regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) - )) - -(context: "Regular Expressions [Reference]" - (let [number (&.regex "\d+")] - (test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) - -(context: "Regular Expressions [Fuzzy Quantifiers]" - ($_ seq - (test "Can sequentially combine patterns." - (should-passT "aa" (&.regex "aa") "aa")) - - (test "Can match patterns optionally." - (and (should-passT "a" (&.regex "a?") "a") - (should-passT "" (&.regex "a?") ""))) - - (test "Can match a pattern 0 or more times." - (and (should-passT "aaa" (&.regex "a*") "aaa") - (should-passT "" (&.regex "a*") ""))) - - (test "Can match a pattern 1 or more times." - (and (should-passT "aaa" (&.regex "a+") "aaa") - (should-passT "a" (&.regex "a+") "a") - (should-fail (&.regex "a+") ""))) - )) - -(context: "Regular Expressions [Crisp Quantifiers]" - ($_ seq - (test "Can match a pattern N times." - (and (should-passT "aa" (&.regex "a{2}") "aa") - (should-passT "a" (&.regex "a{1}") "a") - (should-fail (&.regex "a{3}") "aa"))) - - (test "Can match a pattern at-least N times." - (and (should-passT "aa" (&.regex "a{1,}") "aa") - (should-passT "aa" (&.regex "a{2,}") "aa") - (should-fail (&.regex "a{3,}") "aa"))) - - (test "Can match a pattern at-most N times." - (and (should-passT "aa" (&.regex "a{,2}") "aa") - (should-passT "aa" (&.regex "a{,3}") "aa"))) - - (test "Can match a pattern between N and M times." - (and (should-passT "a" (&.regex "a{1,2}") "a") - (should-passT "aa" (&.regex "a{1,2}") "aa"))) - )) - -(context: "Regular Expressions [Groups]" - ($_ seq - (test "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (&.regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (&.regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(\d{3})-\0-(\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) - - (test "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) - )) - -(context: "Regular Expressions [Alternation]" - ($_ seq - (test "Can specify alternative patterns." - (and (should-check ["a" (0 [])] (&.regex "a|b") "a") - (should-check ["b" (1 [])] (&.regex "a|b") "b") - (should-fail (&.regex "a|b") "c"))) - - (test "Can have groups within alternations." - (and (should-check ["abc" (0 ["b" "c"])] (&.regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (1 ["c" "d"])] (&.regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (&.regex "a(.)(.)|b(.)(.)") "cde") - - (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])] - (&.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") - "809-345-6789"))) - )) - -(context: "Pattern-matching" - (<| (times 100) - (do @ - [sample1 (r.unicode 3) - sample2 (r.unicode 3) - sample3 (r.unicode 4)] - (case (format sample1 "-" sample2 "-" sample3) - (&.^regex "(.{3})-(.{3})-(.{4})" - [_ match1 match2 match3]) - (test "Can pattern-match using regular-expressions." - (and (text/= sample1 match1) - (text/= sample2 match2) - (text/= sample3 match3))) - - _ - (test "Cannot pattern-match using regular-expressions." - #0))))) diff --git a/stdlib/test/test/lux/host.js.lux b/stdlib/test/test/lux/host.js.lux deleted file mode 100644 index faf9f6b5f..000000000 --- a/stdlib/test/test/lux/host.js.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux #* - ["&" host] - [math ["r" random]]] - lux/test) - -(context: "JavaScript operations" - ($_ seq - (test "Null equals itself." - (is? (&.null) (&.null))) - - (test "Undefined equals itself." - (is? (&.undef) (&.undef))) - - (test "Can reference JavaScript objects." - (is? (&.ref "Math") (&.ref "Math"))) - - (test "Can create objects and access their fields." - (|> (&.object "foo" "BAR") - (&.get "foo" Text) - (is? "BAR"))) - - (test "Can call JavaScript functions" - (and (is? +124.0 - (&.call! (&.ref "Math.ceil" &.Function) [+123.45] Frac)) - (is? +124.0 - (&.call! (&.ref "Math") "ceil" [+123.45] Frac)))) - )) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux deleted file mode 100644 index 3de5e28d7..000000000 --- a/stdlib/test/test/lux/host.jvm.lux +++ /dev/null @@ -1,134 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)] - pipe] - [data - [text ("text/." equivalence)]] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ import: class: interface: object)]}) - -(import: (java/util/concurrent/Callable a)) - -(import: java/lang/Exception - (new [String])) - -(import: java/lang/Object) - -(import: (java/lang/Class a) - (getName [] String)) - -(import: java/lang/System - (#static out java/io/PrintStream) - (#static currentTimeMillis [] #io long) - (#static getenv [String] #io #? String)) - -(class: #final (TestClass A) [Runnable] - ## Fields - (#private foo boolean) - (#private bar A) - (#private baz java/lang/Object) - ## Methods - (#public [] (new {value A}) [] - (exec (:= ::foo #1) - (:= ::bar value) - (:= ::baz "") - [])) - (#public (virtual) java/lang/Object - "") - (#public #static (static) java/lang/Object - "") - (Runnable [] (run) void - [])) - -(def: test-runnable - (object [] [Runnable] - [] - (Runnable [] (run) void - []))) - -(def: test-callable - (object [a] [(Callable a)] - [] - (Callable [] (call) a - (undefined)))) - -(interface: TestInterface - ([] foo [boolean String] void #throws [Exception])) - -(def: conversions - Test - (do r.monad - [sample r.int] - (`` ($_ _.and - (~~ (do-template [<to> <from> <message>] - [(_.test <message> - (or (|> sample <to> <from> (i/= sample)) - (let [capped-sample (|> sample <to> <from>)] - (|> capped-sample <to> <from> (i/= capped-sample)))))] - - [/.long-to-byte /.byte-to-long "Can succesfully convert to/from byte."] - [/.long-to-short /.short-to-long "Can succesfully convert to/from short."] - [/.long-to-int /.int-to-long "Can succesfully convert to/from int."] - [/.long-to-float /.float-to-long "Can succesfully convert to/from float."] - [/.long-to-double /.double-to-long "Can succesfully convert to/from double."] - [(<| /.int-to-char /.long-to-int) (<| /.int-to-long /.char-to-int) "Can succesfully convert to/from char."] - )) - )))) - -(def: miscellaneous - Test - (do r.monad - [sample (r.ascii 1)] - ($_ _.and - (_.test "Can check if an object is of a certain class." - (and (case (/.check String sample) (#.Some _) true #.None false) - (case (/.check Long sample) (#.Some _) false #.None true) - (case (/.check Object sample) (#.Some _) true #.None false) - (case (/.check Object (/.null)) (#.Some _) false #.None true))) - - (_.test "Can run code in a 'synchronized' block." - (/.synchronized sample #1)) - - (_.test "Can access Class instances." - (text/= "java.lang.Class" (Class::getName (/.class-for java/lang/Class)))) - - (_.test "Can check if a value is null." - (and (/.null? (/.null)) - (not (/.null? sample)))) - - (_.test "Can safely convert nullable references into Maybe values." - (and (|> (: (Maybe Object) (/.??? (/.null))) - (case> #.None #1 - _ #0)) - (|> (: (Maybe Object) (/.??? sample)) - (case> (#.Some _) #1 - _ #0)))) - ))) - -(def: arrays - Test - (do r.monad - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) - idx (|> r.nat (:: @ map (n/% size))) - value r.int] - ($_ _.and - (_.test "Can create arrays of some length." - (n/= size (/.array-length (/.array Long size)))) - - (_.test "Can set and get array values." - (let [arr (/.array Long size)] - (exec (/.array-write idx value arr) - (i/= value (/.array-read idx arr)))))))) - -(def: #export test - ($_ _.and - (<| (_.context "Conversions.") - ..conversions) - (<| (_.context "Miscellaneous.") - ..miscellaneous) - (<| (_.context "Arrays.") - ..arrays))) diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux deleted file mode 100644 index d8224d214..000000000 --- a/stdlib/test/test/lux/host/jvm.jvm.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - [concurrency - ["." atom]] - [security - ["!" capability]]] - [data - ["." error (#+ Error)] - ["." text - format] - [format - ["." binary]] - [collection - ["." dictionary] - ["." row]]] - ["." io (#+ IO)] - [world - ["." file (#+ File)] - [binary (#+ Binary)]] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - [/ - ["/." loader (#+ Library)] - ["/." version] - ["/." name] - ["/." descriptor] - ["/." field] - ["/." class] - [modifier - ["/.M" inner]]]}) - -(def: (write-class! name bytecode) - (-> Text Binary (IO Text)) - (let [file-path (format name ".class")] - (do io.monad - [outcome (do (error.with-error @) - [file (: (IO (Error (File IO))) - (file.get-file io.monad file.system file-path))] - (!.use (:: file over-write) bytecode))] - (wrap (case outcome - (#error.Success definition) - (format "Wrote: " (%t file-path)) - - (#error.Failure error) - error))))) - -(def: class - Test - (do r.monad - [_ (wrap []) - #let [package "my.package" - name "MyClass" - full-name (format package "." name) - input (/class.class /version.v6_0 /class.public - (/name.internal "java.lang.Object") - (/name.internal full-name) - (list (/name.internal "java.io.Serializable") - (/name.internal "java.lang.Runnable")) - (list (/field.field /field.public "foo" /descriptor.long (row.row)) - (/field.field /field.public "bar" /descriptor.double (row.row))) - (row.row) - (row.row)) - bytecode (binary.write /class.format input) - loader (/loader.memory (/loader.new-library []))]] - ($_ _.and - (_.test "Can read a generated class." - (case (binary.read /class.format bytecode) - (#error.Success output) - (:: /class.equivalence = input output) - - (#error.Failure error) - false)) - (_.test "Can generate a class." - (case (/loader.define full-name bytecode loader) - (#error.Success definition) - true - - (#error.Failure error) - false)) - ))) - -(def: #export test - Test - (<| (_.context "Class") - ..class)) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux deleted file mode 100644 index a14a240cb..000000000 --- a/stdlib/test/test/lux/io.lux +++ /dev/null @@ -1,39 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - {[0 #test] - [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] - ["." function] - [math - ["r" random]] - ["_" test (#+ Test)]] - {1 - ["." / (#+ IO)]}) - -(def: injection - (Injection IO) - (|>> /.io)) - -(def: comparison - (Comparison IO) - (function (_ == left right) - (== (/.run left) (/.run right)))) - -(def: #export test - Test - (do r.monad - [sample r.nat - exit-code r.int] - ($_ _.and - (_.test "Can execute computations designated as I/O computations." - (n/= sample (/.run (/.io sample)))) - (_.test "I/O operations won't execute unless they are explicitly run." - (exec (/.exit exit-code) - true)) - (functorT.laws /.functor ..injection ..comparison) - (applyT.laws /.apply ..injection ..comparison) - (monadT.laws /.monad ..injection ..comparison)))) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux deleted file mode 100644 index 02baf04a5..000000000 --- a/stdlib/test/test/lux/macro/code.lux +++ /dev/null @@ -1,36 +0,0 @@ -(.module: - [lux #* - [io] - [control - [monad (#+ do Monad)]] - [data - [number] - ["." text ("text/." equivalence) - format]] - [math - ["r" random]] - [macro - ["&" code]]] - lux/test) - -(context: "Code" - (with-expansions - [<tests> (do-template [<expr> <text>] - [(test (format "Can produce Code node: " <text>) - (and (text/= <text> (&.to-text <expr>)) - (:: &.equivalence = <expr> <expr>)))] - - [(&.bit #1) "#1"] - [(&.bit #0) "#0"] - [(&.int +123) "+123"] - [(&.frac +123.0) "+123.0"] - [(&.text "1234") (format text.double-quote "1234" text.double-quote)] - [(&.tag ["yolo" "lol"]) "#yolo.lol"] - [(&.identifier ["yolo" "lol"]) "yolo.lol"] - [(&.form (list (&.bit #1) (&.int +123))) "(#1 +123)"] - [(&.tuple (list (&.bit #1) (&.int +123))) "[#1 +123]"] - [(&.record (list [(&.bit #1) (&.int +123)])) "{#1 +123}"] - [(&.local-tag "lol") "#lol"] - [(&.local-identifier "lol") "lol"] - )] - ($_ seq <tests>))) diff --git a/stdlib/test/test/lux/macro/poly/equivalence.lux b/stdlib/test/test/lux/macro/poly/equivalence.lux deleted file mode 100644 index 3d943f6e6..000000000 --- a/stdlib/test/test/lux/macro/poly/equivalence.lux +++ /dev/null @@ -1,71 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - [equivalence (#+ Equivalence)]] - [data - ["." bit] - ["." maybe] - [number ("int/." int-number)] - ["." text - format] - [collection - ["." list]]] - [math - ["r" random]] - ["." macro - [poly (#+ derived:) - ["&" equivalence]]]] - lux/test) - -(type: Variant - (#Case0 Bit) - (#Case1 Int) - (#Case2 Frac)) - -(type: #rec Recursive - (#Number Frac) - (#Addition Frac Recursive)) - -(type: Record - {#bit Bit - #int Int - #frac Frac - #text Text - #maybe (Maybe Int) - #list (List Int) - #variant Variant - #tuple [Int Frac Text] - #recursive Recursive}) - -(def: gen-recursive - (r.Random Recursive) - (r.rec (function (_ gen-recursive) - (r.or r.frac - (r.and r.frac gen-recursive))))) - -(def: gen-record - (r.Random Record) - (do r.monad - [size (:: @ map (n/% 2) r.nat) - #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% +1_000_000))))]] - ($_ r.and - r.bit - gen-int - r.frac - (r.unicode size) - (r.maybe gen-int) - (r.list size gen-int) - ($_ r.or r.bit gen-int r.frac) - ($_ r.and gen-int r.frac (r.unicode size)) - gen-recursive))) - -(derived: (&.Equivalence<?> Record)) - -(context: "Equivalence polytypism" - (<| (times 100) - (do @ - [sample gen-record - #let [(^open "&/.") ..equivalence]] - (test "Every instance equals itself." - (&/= sample sample))))) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux deleted file mode 100644 index 873259496..000000000 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ /dev/null @@ -1,24 +0,0 @@ -(.module: - [lux #* - [control - ["." state]] - [data - ["." identity]] - [macro - [poly (#+ derived:) - ["&" functor]]]] - lux/test) - -## [Utils] -(derived: (&.Functor<?> .Maybe)) - -(derived: (&.Functor<?> .List)) - -(derived: (&.Functor<?> state.State)) - -(derived: (&.Functor<?> identity.Identity)) - -## [Tests] -(context: "Functor polytypism." - (test "Can derive functors automatically." - #1)) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux deleted file mode 100644 index ff8c1c433..000000000 --- a/stdlib/test/test/lux/macro/syntax.lux +++ /dev/null @@ -1,155 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)] - [equivalence (#+ Equivalence)] - ["p" parser]] - [data - ["." bit] - ["." name] - ["." error (#+ Error)] - ["." number] - ["." text - format]] - [math - ["r" random]] - ["." macro - ["." code] - ["s" syntax (#+ syntax: Syntax)]]] - lux/test) - -## [Utils] -(def: (enforced? parser input) - (-> (Syntax []) (List Code) Bit) - (case (p.run input parser) - (#.Right [_ []]) - #1 - - _ - #0)) - -(def: (found? parser input) - (-> (Syntax Bit) (List Code) Bit) - (case (p.run input parser) - (#.Right [_ #1]) - #1 - - _ - #0)) - -(def: (equals? Equivalence<a> reference parser input) - (All [a] (-> (Equivalence a) a (Syntax a) (List Code) Bit)) - (case (p.run input parser) - (#.Right [_ output]) - (:: Equivalence<a> = reference output) - - _ - #0)) - -(def: (fails? input) - (All [a] (-> (Error a) Bit)) - (case input - (#.Left _) - #1 - - _ - #0)) - -(syntax: (match pattern input) - (wrap (list (` (case (~ input) - (^ (#.Right [(~' _) (~ pattern)])) - #1 - - (~' _) - #0))))) - -## [Tests] -(context: "Simple value syntax." - (with-expansions - [<simple-tests> (do-template [<assertion> <value> <ctor> <Equivalence> <get>] - [(test <assertion> - (and (equals? <Equivalence> <value> <get> (list (<ctor> <value>))) - (found? (s.this? (<ctor> <value>)) (list (<ctor> <value>))) - (enforced? (s.this (<ctor> <value>)) (list (<ctor> <value>)))))] - - ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit] - ["Can parse Nat syntax." 123 code.nat number.equivalence s.nat] - ["Can parse Int syntax." +123 code.int number.equivalence s.int] - ["Can parse Rev syntax." .123 code.rev number.equivalence s.rev] - ["Can parse Frac syntax." +123.0 code.frac number.equivalence s.frac] - ["Can parse Text syntax." text.new-line code.text text.equivalence s.text] - ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier] - ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag] - )] - ($_ seq - <simple-tests> - - (test "Can parse identifiers belonging to the current namespace." - (and (match "yolo" - (p.run (list (code.local-identifier "yolo")) - s.local-identifier)) - (fails? (p.run (list (code.identifier ["yolo" "lol"])) - s.local-identifier)))) - - (test "Can parse tags belonging to the current namespace." - (and (match "yolo" - (p.run (list (code.local-tag "yolo")) - s.local-tag)) - (fails? (p.run (list (code.tag ["yolo" "lol"])) - s.local-tag)))) - ))) - -(context: "Complex value syntax." - (with-expansions - [<group-tests> (do-template [<type> <parser> <ctor>] - [(test (format "Can parse " <type> " syntax.") - (and (match [#1 +123] - (p.run (list (<ctor> (list (code.bit #1) (code.int +123)))) - (<parser> (p.and s.bit s.int)))) - (match #1 - (p.run (list (<ctor> (list (code.bit #1)))) - (<parser> s.bit))) - (fails? (p.run (list (<ctor> (list (code.bit #1) (code.int +123)))) - (<parser> s.bit))) - (match (#.Left #1) - (p.run (list (<ctor> (list (code.bit #1)))) - (<parser> (p.or s.bit s.int)))) - (match (#.Right +123) - (p.run (list (<ctor> (list (code.int +123)))) - (<parser> (p.or s.bit s.int)))) - (fails? (p.run (list (<ctor> (list (code.frac +123.0)))) - (<parser> (p.or s.bit s.int))))))] - - ["form" s.form code.form] - ["tuple" s.tuple code.tuple])] - ($_ seq - <group-tests> - - (test "Can parse record syntax." - (match [#1 +123] - (p.run (list (code.record (list [(code.bit #1) (code.int +123)]))) - (s.record (p.and s.bit s.int))))) - ))) - -(context: "Combinators" - ($_ seq - (test "Can parse any Code." - (match [_ (#.Bit #1)] - (p.run (list (code.bit #1) (code.int +123)) - s.any))) - - (test "Can check whether the end has been reached." - (and (match #1 - (p.run (list) - s.end?)) - (match #0 - (p.run (list (code.bit #1)) - s.end?)))) - - (test "Can ensure the end has been reached." - (and (match [] - (p.run (list) - s.end!)) - (fails? (p.run (list (code.bit #1)) - s.end!)))) - )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux deleted file mode 100644 index 002cdaa41..000000000 --- a/stdlib/test/test/lux/math.lux +++ /dev/null @@ -1,125 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)]] - [data - [bit ("bit/." equivalence)] - [number ("frac/." number)]] - ["&" math - infix - ["r" random]]] - lux/test) - -(def: (within? margin-of-error standard value) - (-> Frac Frac Frac Bit) - (f/< margin-of-error - (frac/abs (f/- standard value)))) - -(def: margin Frac +0.0000001) - -(def: (trigonometric-symmetry forward backward angle) - (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) - (let [normal (|> angle forward backward)] - (|> normal forward backward (within? margin normal)))) - -(context: "Trigonometry" - (<| (times 100) - (do @ - [angle (|> r.frac (:: @ map (f/* &.tau)))] - ($_ seq - (test "Sine and arc-sine are inverse functions." - (trigonometric-symmetry &.sin &.asin angle)) - - (test "Cosine and arc-cosine are inverse functions." - (trigonometric-symmetry &.cos &.acos angle)) - - (test "Tangent and arc-tangent are inverse functions." - (trigonometric-symmetry &.tan &.atan angle)) - )))) - -(context: "Rounding" - (<| (times 100) - (do @ - [sample (|> r.frac (:: @ map (f/* +1000.0)))] - ($_ seq - (test "The ceiling will be an integer value, and will be >= the original." - (let [ceil'd (&.ceil sample)] - (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd)) - (f/>= sample ceil'd) - (f/<= +1.0 (f/- sample ceil'd))))) - - (test "The floor will be an integer value, and will be <= the original." - (let [floor'd (&.floor sample)] - (and (|> floor'd frac-to-int int-to-frac (f/= floor'd)) - (f/<= sample floor'd) - (f/<= +1.0 (f/- floor'd sample))))) - - (test "The round will be an integer value, and will be < or > or = the original." - (let [round'd (&.round sample)] - (and (|> round'd frac-to-int int-to-frac (f/= round'd)) - (f/<= +1.0 (frac/abs (f/- sample round'd)))))) - )))) - -(context: "Exponentials and logarithms" - (<| (times 100) - (do @ - [sample (|> r.frac (:: @ map (f/* +10.0)))] - (test "Logarithm is the inverse of exponential." - (|> sample &.exp &.log (within? +1.0e-15 sample)))))) - -(context: "Greatest-Common-Divisor and Least-Common-Multiple" - (<| (times 100) - (do @ - [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))] - x gen-nat - y gen-nat] - ($_ seq - (test "GCD" - (let [gcd (&.n/gcd x y)] - (and (n/= 0 (n/% gcd x)) - (n/= 0 (n/% gcd y)) - (n/>= 1 gcd)))) - - (test "LCM" - (let [lcm (&.n/lcm x y)] - (and (n/= 0 (n/% x lcm)) - (n/= 0 (n/% y lcm)) - (n/<= (n/* x y) lcm)))) - )))) - -(context: "Infix syntax" - (<| (times 100) - (do @ - [x r.nat - y r.nat - z r.nat - theta r.frac - #let [top (|> x (n/max y) (n/max z)) - bottom (|> x (n/min y) (n/min z))]] - ($_ seq - (test "Constant values don't change." - (n/= x - (infix x))) - - (test "Can call binary functions." - (n/= (&.n/gcd y x) - (infix [x &.n/gcd y]))) - - (test "Can call unary functions." - (f/= (&.sin theta) - (infix [&.sin theta]))) - - (test "Can use regular syntax in the middle of infix code." - (n/= (&.n/gcd 450 (n/* 3 9)) - (infix [(n/* 3 9) &.n/gcd 450]))) - - (test "Can use non-numerical functions/macros as operators." - (bit/= (and (n/< y x) (n/< z y)) - (infix [[x n/< y] and [y n/< z]]))) - - (test "Can combine bit operations in special ways via special keywords." - (and (bit/= (and (n/< y x) (n/< z y)) - (infix [#and x n/< y n/< z])) - (bit/= (and (n/< y x) (n/> z y)) - (infix [#and x n/< y n/> z])))) - )))) diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux deleted file mode 100644 index b9db253f6..000000000 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ /dev/null @@ -1,35 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [math - ["r" random] - [logic - ["&" continuous]]]] - lux/test) - -(context: "Operations" - (<| (times 100) - (do @ - [left r.rev - right r.rev] - ($_ seq - (test "AND is the minimum." - (let [result (&.and left right)] - (and (r/<= left result) - (r/<= right result)))) - - (test "OR is the maximum." - (let [result (&.or left right)] - (and (r/>= left result) - (r/>= right result)))) - - (test "Double negation results in the original value." - (r/= left (&.not (&.not left)))) - - (test "Every value is equivalent to itself." - (and (r/>= left - (&.= left left)) - (r/>= right - (&.= right right)))) - )))) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux deleted file mode 100644 index 60223e8a3..000000000 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ /dev/null @@ -1,183 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - [bit ("bit/." equivalence)] - ["." number] - [text - format] - [collection - ["." list] - ["." set]]] - [math - ["r" random] - [logic - ["&" fuzzy] - ["_" continuous]]]] - lux/test) - -(do-template [<desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>] - [(context: (format "[" <desc> "] " "Triangles") - (<| (times 100) - (do @ - [values (r.set <hash> 3 <gen>) - #let [[x y z] (case (set.to-list values) - (^ (list x y z)) - [x y z] - - _ - (undefined))] - sample <gen> - #let [[bottom middle top] (case (list.sort <lt> (list x y z)) - (^ (list bottom middle top)) - [bottom middle top] - - _ - (undefined)) - triangle (<triangle> x y z)]] - ($_ seq - (test "The middle value will always have maximum membership." - (r/= _.true (&.membership middle triangle))) - - (test "Boundary values will always have 0 membership." - (and (r/= _.false (&.membership bottom triangle)) - (r/= _.false (&.membership top triangle)))) - - (test "Values within range, will have membership > 0." - (bit/= (r/> _.false (&.membership sample triangle)) - (and (<gt> bottom sample) - (<lt> top sample)))) - - (test "Values outside of range, will have membership = 0." - (bit/= (r/= _.false (&.membership sample triangle)) - (or (<lte> bottom sample) - (<gte> top sample)))) - ))))] - - ["Rev" number.hash r.rev &.triangle r/< r/<= r/> r/>=] - ) - -(do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] - [(context: (format "[" <desc> "] " "Trapezoids") - (<| (times 100) - (do @ - [values (r.set <hash> 4 <gen>) - #let [[w x y z] (case (set.to-list values) - (^ (list w x y z)) - [w x y z] - - _ - (undefined))] - sample <gen> - #let [[bottom middle-bottom middle-top top] (case (list.sort <lt> (list w x y z)) - (^ (list bottom middle-bottom middle-top top)) - [bottom middle-bottom middle-top top] - - _ - (undefined)) - trapezoid (<trapezoid> w x y z)]] - ($_ seq - (test "The middle values will always have maximum membership." - (and (r/= _.true (&.membership middle-bottom trapezoid)) - (r/= _.true (&.membership middle-top trapezoid)))) - - (test "Boundary values will always have 0 membership." - (and (r/= _.false (&.membership bottom trapezoid)) - (r/= _.false (&.membership top trapezoid)))) - - (test "Values within inner range will have membership = 1" - (bit/= (r/= _.true (&.membership sample trapezoid)) - (and (<gte> middle-bottom sample) - (<lte> middle-top sample)))) - - (test "Values within range, will have membership > 0." - (bit/= (r/> _.false (&.membership sample trapezoid)) - (and (<gt> bottom sample) - (<lt> top sample)))) - - (test "Values outside of range, will have membership = 0." - (bit/= (r/= _.false (&.membership sample trapezoid)) - (or (<lte> bottom sample) - (<gte> top sample)))) - ))))] - - ["Rev" number.hash r.rev &.trapezoid r/< r/<= r/> r/>=] - ) - -(def: gen-triangle - (r.Random (&.Fuzzy Rev)) - (do r.monad - [x r.rev - y r.rev - z r.rev] - (wrap (&.triangle x y z)))) - -(context: "Combinators" - (<| (times 100) - (do @ - [left gen-triangle - right gen-triangle - sample r.rev] - ($_ seq - (test "Union membership as as high as membership in any of its members." - (let [combined (&.union left right) - combined-membership (&.membership sample combined)] - (and (r/>= (&.membership sample left) - combined-membership) - (r/>= (&.membership sample right) - combined-membership)))) - - (test "Intersection membership as as low as membership in any of its members." - (let [combined (&.intersection left right) - combined-membership (&.membership sample combined)] - (and (r/<= (&.membership sample left) - combined-membership) - (r/<= (&.membership sample right) - combined-membership)))) - - (test "Complement membership is the opposite of normal membership." - (r/= (&.membership sample left) - (_.not (&.membership sample (&.complement left))))) - - (test "Membership in the difference will never be higher than in the set being subtracted." - (bit/= (r/> (&.membership sample right) - (&.membership sample left)) - (r/< (&.membership sample left) - (&.membership sample (&.difference left right))))) - )))) - -(context: "From predicates and sets" - (<| (times 100) - (do @ - [#let [set-10 (set.from-list number.hash (list.n/range 0 10))] - sample (|> r.nat (:: @ map (n/% 20)))] - ($_ seq - (test (format "Values that satisfy a predicate have membership = 1." - "Values that don't have membership = 0.") - (bit/= (r/= _.true (&.membership sample (&.from-predicate n/even?))) - (n/even? sample))) - - (test (format "Values that belong to a set have membership = 1." - "Values that don't have membership = 0.") - (bit/= (r/= _.true (&.membership sample (&.from-set set-10))) - (set.member? set-10 sample))) - )))) - -(context: "Thresholds" - (<| (times 100) - (do @ - [fuzzy gen-triangle - sample r.rev - threshold r.rev - #let [vip-fuzzy (&.cut threshold fuzzy) - member? (&.to-predicate threshold fuzzy)]] - ($_ seq - (test "Can increase the threshold of membership of a fuzzy set." - (bit/= (r/> _.false (&.membership sample vip-fuzzy)) - (r/> threshold (&.membership sample fuzzy)))) - - (test "Can turn fuzzy sets into predicates through a threshold." - (bit/= (member? sample) - (r/> threshold (&.membership sample fuzzy)))) - )))) diff --git a/stdlib/test/test/lux/math/modular.lux b/stdlib/test/test/lux/math/modular.lux deleted file mode 100644 index b5ff0e40b..000000000 --- a/stdlib/test/test/lux/math/modular.lux +++ /dev/null @@ -1,150 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - ["." product] - [bit ("bit/." equivalence)] - ["." error] - [text - format]] - [math - ["r" random] - ["/" modular]] - [type ("type/." equivalence)]] - lux/test) - -(def: %3 (/.modulus +3)) -(`` (type: Mod3 (~~ (:of %3)))) - -(def: modulusR - (r.Random Int) - (|> r.int - (:: r.monad map (i/% +1000)) - (r.filter (|>> (i/= +0) not)))) - -(def: valueR - (r.Random Int) - (|> r.int (:: r.monad map (i/% +1000)))) - -(def: (modR modulus) - (All [m] (-> (/.Modulus m) (r.Random [Int (/.Mod m)]))) - (do r.monad - [raw valueR] - (wrap [raw (/.mod modulus raw)]))) - -(def: value - (All [m] (-> (/.Mod m) Int)) - (|>> /.un-mod product.left)) - -(def: (comparison m/? i/?) - (All [m] - (-> (-> (/.Mod m) (/.Mod m) Bit) - (-> Int Int Bit) - (-> (/.Mod m) (/.Mod m) Bit))) - (function (_ param subject) - (bit/= (m/? param subject) - (i/? (value param) - (value subject))))) - -(def: (arithmetic modulus m/! i/!) - (All [m] - (-> (/.Modulus m) - (-> (/.Mod m) (/.Mod m) (/.Mod m)) - (-> Int Int Int) - (-> (/.Mod m) (/.Mod m) Bit))) - (function (_ param subject) - (|> (i/! (value param) - (value subject)) - (/.mod modulus) - (/.m/= (m/! param subject))))) - -(context: "Modular arithmetic." - (<| (times 100) - (do @ - [_normalM modulusR - _alternativeM (|> modulusR (r.filter (|>> (i/= _normalM) not))) - #let [normalM (|> _normalM /.from-int error.assume) - alternativeM (|> _alternativeM /.from-int error.assume)] - [_param param] (modR normalM) - [_subject subject] (modR normalM) - #let [copyM (|> normalM /.to-int /.from-int error.assume)]] - ($_ seq - (test "Every modulus has a unique type, even if the numeric value is the same as another." - (and (type/= (:of normalM) - (:of normalM)) - (not (type/= (:of normalM) - (:of alternativeM))) - (not (type/= (:of normalM) - (:of copyM))))) - - (test "Can extract the original integer from the modulus." - (i/= _normalM - (/.to-int normalM))) - - (test "Can compare mod'ed values." - (and (/.m/= subject subject) - ((comparison /.m/= i/=) param subject) - ((comparison /.m/< i/<) param subject) - ((comparison /.m/<= i/<=) param subject) - ((comparison /.m/> i/>) param subject) - ((comparison /.m/>= i/>=) param subject))) - - (test "Mod'ed values are ordered." - (and (bit/= (/.m/< param subject) - (not (/.m/>= param subject))) - (bit/= (/.m/> param subject) - (not (/.m/<= param subject))) - (bit/= (/.m/= param subject) - (not (or (/.m/< param subject) - (/.m/> param subject)))))) - - (test "Can do arithmetic." - (and ((arithmetic normalM /.m/+ i/+) param subject) - ((arithmetic normalM /.m/- i/-) param subject) - ((arithmetic normalM /.m/* i/*) param subject))) - - (test "Can sometimes find multiplicative inverse." - (case (/.inverse subject) - (#.Some subject^-1) - (|> subject - (/.m/* subject^-1) - (/.m/= (/.mod normalM +1))) - - #.None - #1)) - - (test "Can encode/decode to text." - (let [(^open "mod/.") (/.codec normalM)] - (case (|> subject mod/encode mod/decode) - (#error.Success output) - (/.m/= subject output) - - (#error.Failure error) - #0))) - - (test "Can equalize 2 moduli if they are equal." - (case (/.equalize (/.mod normalM _subject) - (/.mod copyM _param)) - (#error.Success paramC) - (/.m/= param paramC) - - (#error.Failure error) - #0)) - - (test "Cannot equalize 2 moduli if they are the different." - (case (/.equalize (/.mod normalM _subject) - (/.mod alternativeM _param)) - (#error.Success paramA) - #0 - - (#error.Failure error) - #1)) - - (test "All numbers are congruent to themselves." - (/.congruent? normalM _subject _subject)) - - (test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus." - (bit/= (/.congruent? normalM _param _subject) - (/.m/= param subject))) - )))) diff --git a/stdlib/test/test/lux/math/random.lux b/stdlib/test/test/lux/math/random.lux deleted file mode 100644 index acc161cc4..000000000 --- a/stdlib/test/test/lux/math/random.lux +++ /dev/null @@ -1,49 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do Monad)]] - [data - ["." number] - [collection - ["." list] - ["." row] - ["." array] - ["." queue] - ["." stack] - ["." set] - ["dict" dictionary]]] - [math - ["r" random]]] - lux/test) - -(context: "Random." - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - _list (r.list size r.nat) - _row (r.row size r.nat) - _array (r.array size r.nat) - _queue (r.queue size r.nat) - _stack (r.stack size r.nat) - _set (r.set number.hash size r.nat) - _dict (r.dictionary number.hash size r.nat r.nat) - top r.nat - filtered (|> r.nat (r.filter (n/<= top)))] - ($_ seq - (test "Can produce lists." - (n/= size (list.size _list))) - (test "Can produce rows." - (n/= size (row.size _row))) - (test "Can produce arrays." - (n/= size (array.size _array))) - (test "Can produce queues." - (n/= size (queue.size _queue))) - (test "Can produce stacks." - (n/= size (stack.size _stack))) - (test "Can produce sets." - (n/= size (set.size _set))) - (test "Can produce dicts." - (n/= size (dict.size _dict))) - (test "Can filter values." - (n/<= top filtered)) - )))) diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux deleted file mode 100644 index d89ccccc8..000000000 --- a/stdlib/test/test/lux/time/date.lux +++ /dev/null @@ -1,147 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)] - pipe] - [data - ["." error]] - [math - ["r" random ("random/." monad)]] - [time - ["@." instant] - ["@" date]]] - lux/test - [// - ["_." instant]]) - -(def: month - (r.Random @.Month) - (r.either (r.either (r.either (random/wrap #@.January) - (r.either (random/wrap #@.February) - (random/wrap #@.March))) - (r.either (random/wrap #@.April) - (r.either (random/wrap #@.May) - (random/wrap #@.June)))) - (r.either (r.either (random/wrap #@.July) - (r.either (random/wrap #@.August) - (random/wrap #@.September))) - (r.either (random/wrap #@.October) - (r.either (random/wrap #@.November) - (random/wrap #@.December)))))) - -(context: "(Month) Equivalence." - (<| (times 100) - (do @ - [sample month - #let [(^open "@/.") @.equivalence]] - (test "Every value equals itself." - (@/= sample sample))))) - -(context: "(Month) Order." - (<| (times 100) - (do @ - [reference month - sample month - #let [(^open "@/.") @.order]] - (test "Valid Order." - (and (or (@/< reference sample) - (@/>= reference sample)) - (or (@/> reference sample) - (@/<= reference sample))))))) - -(context: "(Month) Enum." - (<| (times 100) - (do @ - [sample month - #let [(^open "@/.") @.enum]] - (test "Valid Enum." - (and (not (@/= (@/succ sample) - sample)) - (not (@/= (@/pred sample) - sample)) - (|> sample @/succ @/pred (@/= sample)) - (|> sample @/pred @/succ (@/= sample))))))) - -(def: day - (r.Random @.Day) - (r.either (r.either (r.either (random/wrap #@.Sunday) - (random/wrap #@.Monday)) - (r.either (random/wrap #@.Tuesday) - (random/wrap #@.Wednesday))) - (r.either (r.either (random/wrap #@.Thursday) - (random/wrap #@.Friday)) - (random/wrap #@.Saturday)))) - -(context: "(Day) Equivalence." - (<| (times 100) - (do @ - [sample day - #let [(^open "@/.") @.equivalence]] - (test "Every value equals itself." - (@/= sample sample))))) - -(context: "(Day) Order." - (<| (times 100) - (do @ - [reference day - sample day - #let [(^open "@/.") @.order]] - (test "Valid Order." - (and (or (@/< reference sample) - (@/>= reference sample)) - (or (@/> reference sample) - (@/<= reference sample))))))) - -(context: "(Day) Enum." - (<| (times 100) - (do @ - [sample day - #let [(^open "@/.") @.enum]] - (test "Valid Enum." - (and (not (@/= (@/succ sample) - sample)) - (not (@/= (@/pred sample) - sample)) - (|> sample @/succ @/pred (@/= sample)) - (|> sample @/pred @/succ (@/= sample))))))) - -(def: #export date - (r.Random @.Date) - (|> _instant.instant (:: r.monad map @instant.date))) - -(context: "(Date) Equivalence." - (<| (times 100) - (do @ - [sample date - #let [(^open "@/.") @.equivalence]] - (test "Every value equals itself." - (@/= sample sample))))) - -(context: "(Date) Order." - (<| (times 100) - (do @ - [reference date - sample date - #let [(^open "@/.") @.order]] - (test "Valid Order." - (and (or (@/< reference sample) - (@/>= reference sample)) - (or (@/> reference sample) - (@/<= reference sample))))))) - -(context: "(Date) Codec" - (<| (seed 6623983470548808292) - ## (times 100) - (do @ - [sample date - #let [(^open "@/.") @.equivalence - (^open "@/.") @.codec]] - (test "Can encode/decode dates." - (|> sample - @/encode - @/decode - (case> (#error.Success decoded) - (@/= sample decoded) - - (#error.Failure error) - #0)))))) diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux deleted file mode 100644 index 3aba23203..000000000 --- a/stdlib/test/test/lux/time/duration.lux +++ /dev/null @@ -1,60 +0,0 @@ -(.module: - [lux #* - [io] - [control - [monad (#+ do Monad)]] - [data - ["E" error]] - [math - ["r" random]] - [time - ["@" duration]]] - lux/test) - -(def: #export duration - (r.Random @.Duration) - (|> r.int (:: r.monad map @.from-millis))) - -(context: "Conversion." - (<| (times 100) - (do @ - [millis r.int] - (test "Can convert from/to milliseconds." - (|> millis @.from-millis @.to-millis (i/= millis)))))) - -(context: "Equivalence." - (<| (times 100) - (do @ - [sample duration - #let [(^open "@/.") @.equivalence]] - (test "Every duration equals itself." - (@/= sample sample))))) - -(context: "Order." - (<| (times 100) - (do @ - [reference duration - sample duration - #let [(^open "@/.") @.order]] - (test "Can compare times." - (and (or (@/< reference sample) - (@/>= reference sample)) - (or (@/> reference sample) - (@/<= reference sample))))))) - -(context: "Arithmetic." - (<| (times 100) - (do @ - [sample (|> duration (:: @ map (@.frame @.day))) - frame duration - factor (|> r.int (:: @ map (|>> (i/% +10) (i/max +1)))) - #let [(^open "@/.") @.order]] - ($_ seq - (test "Can scale a duration." - (|> sample (@.scale-up factor) (@.query sample) (i/= factor))) - (test "Scaling a duration by one does not change it." - (|> sample (@.scale-up +1) (@/= sample))) - (test "Merging with the empty duration changes nothing." - (|> sample (@.merge @.empty) (@/= sample))) - (test "Merging a duration with it's opposite yields an empty duration." - (|> sample (@.merge (@.scale-up -1 sample)) (@/= @.empty))))))) diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux deleted file mode 100644 index c9d7aad55..000000000 --- a/stdlib/test/test/lux/time/instant.lux +++ /dev/null @@ -1,99 +0,0 @@ -(.module: - [lux #* - [io] - [control - [monad (#+ do Monad)] - pipe] - [data - ["." text - format] - [error]] - [math - ["r" random]] - [time - ["@" instant] - ["@d" duration] - ["@date" date]]] - lux/test - [// - ["_." duration]]) - -(def: boundary Int +99_999_999_999_999) - -(def: #export instant - (r.Random @.Instant) - (|> r.int (:: r.monad map (|>> (i/% boundary) @.from-millis)))) - -(context: "Conversion." - (<| (times 100) - (do @ - [millis r.int] - (test "Can convert from/to milliseconds." - (|> millis @.from-millis @.to-millis (i/= millis)))))) - -(context: "Equivalence." - (<| (times 100) - (do @ - [sample instant - #let [(^open "@/.") @.equivalence]] - (test "Every instant equals itself." - (@/= sample sample))))) - -(context: "Order" - (<| (times 100) - (do @ - [reference instant - sample instant - #let [(^open "@/.") @.order]] - (test "Can compare instants." - (and (or (@/< reference sample) - (@/>= reference sample)) - (or (@/> reference sample) - (@/<= reference sample))))))) - -(context: "Enum" - (<| (times 100) - (do @ - [sample instant - #let [(^open "@/.") @.enum]] - (test "Valid Enum." - (and (not (@/= (@/succ sample) - sample)) - (not (@/= (@/pred sample) - sample)) - (|> sample @/succ @/pred (@/= sample)) - (|> sample @/pred @/succ (@/= sample))))))) - -(context: "Arithmetic" - (<| (times 100) - (do @ - [sample instant - span _duration.duration - #let [(^open "@/.") @.equivalence - (^open "@d/.") @d.equivalence]] - ($_ seq - (test "The span of a instant and itself has an empty duration." - (|> sample (@.span sample) (@d/= @d.empty))) - (test "Can shift a instant by a duration." - (|> sample (@.shift span) (@.span sample) (@d/= span))) - (test "Can obtain the time-span between the epoch and an instant." - (|> sample @.relative @.absolute (@/= sample))) - (test "All instants are relative to the epoch." - (|> @.epoch (@.shift (@.relative sample)) (@/= sample))))))) - -## (context: "Codec" -## (<| (seed 9863552679229274604) -## ## (times 100) -## (do @ -## [sample instant -## #let [(^open "@/.") @.equivalence -## (^open "@/.") @.codec]] -## (test "Can encode/decode instants." -## (|> sample -## @/encode -## @/decode -## (case> (#error.Success decoded) -## (@/= sample decoded) - -## (#error.Failure error) -## #0)))))) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux deleted file mode 100644 index b4796911a..000000000 --- a/stdlib/test/test/lux/type.lux +++ /dev/null @@ -1,168 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ do Monad)] - pipe] - [data - ["." maybe] - [text - format] - [collection - ["." list]]] - [math - ["r" random]] - ["&" type]] - lux/test) - -## [Utils] -(def: #export gen-short - (r.Random Text) - (do r.monad - [size (|> r.nat (:: @ map (n/% 10)))] - (r.unicode size))) - -(def: #export gen-name - (r.Random Name) - (r.and gen-short gen-short)) - -(def: #export gen-type - (r.Random Type) - (let [(^open "R/.") r.monad] - (r.rec (function (_ gen-type) - (let [pairG (r.and gen-type gen-type) - idG r.nat - quantifiedG (r.and (R/wrap (list)) gen-type)] - ($_ r.or - (r.and gen-short (R/wrap (list))) - pairG - pairG - pairG - idG - idG - idG - quantifiedG - quantifiedG - pairG - (r.and gen-name gen-type) - )))))) - -## [Tests] -(context: "Types" - (<| (times 100) - (do @ - [sample gen-type] - (test "Every type is equal to itself." - (:: &.equivalence = sample sample))))) - -(context: "Type application" - (test "Can apply quantified types (universal and existential quantification)." - (and (maybe.default #0 - (do maybe.monad - [partial (&.apply (list Bit) Ann) - full (&.apply (list Int) partial)] - (wrap (:: &.equivalence = full (#.Product Bit Int))))) - (|> (&.apply (list Bit) Text) - (case> #.None #1 _ #0))))) - -(context: "Naming" - (let [base (#.Named ["" "a"] (#.Product Bit Int)) - aliased (#.Named ["" "c"] - (#.Named ["" "b"] - base))] - ($_ seq - (test "Can remove aliases from an already-named type." - (:: &.equivalence = - base - (&.un-alias aliased))) - - (test "Can remove all names from a type." - (and (not (:: &.equivalence = - base - (&.un-name aliased))) - (:: &.equivalence = - (&.un-name base) - (&.un-name aliased))))))) - -(context: "Type construction [structs]" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (n/% 3))) - members (|> gen-type - (r.filter (function (_ type) - (case type - (^or (#.Sum _) (#.Product _)) - #0 - - _ - #1))) - (list.repeat size) - (M.seq @)) - #let [(^open "&/.") &.equivalence - (^open "L/.") (list.equivalence &.equivalence)]] - (with-expansions - [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>] - [(test (format "Can build and tear-down " <desc> " types.") - (let [flat (|> members <ctor> <dtor>)] - (or (L/= members flat) - (and (L/= (list) members) - (L/= (list <unit>) flat)))))] - - ["variant" &.variant &.flatten-variant Nothing] - ["tuple" &.tuple &.flatten-tuple Any] - )] - ($_ seq - <struct-tests> - ))))) - -(context: "Type construction [parameterized]" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (n/% 3))) - members (M.seq @ (list.repeat size gen-type)) - extra (|> gen-type - (r.filter (function (_ type) - (case type - (^or (#.Function _) (#.Apply _)) - #0 - - _ - #1)))) - #let [(^open "&/.") &.equivalence - (^open "L/.") (list.equivalence &.equivalence)]] - ($_ seq - (test "Can build and tear-down function types." - (let [[inputs output] (|> (&.function members extra) &.flatten-function)] - (and (L/= members inputs) - (&/= extra output)))) - - (test "Can build and tear-down application types." - (let [[tfunc tparams] (|> extra (&.application members) &.flatten-application)] - (n/= (list.size members) (list.size tparams)))) - )))) - -(context: "Type construction [higher order]" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (n/% 3))) - extra (|> gen-type - (r.filter (function (_ type) - (case type - (^or (#.UnivQ _) (#.ExQ _)) - #0 - - _ - #1)))) - #let [(^open "&/.") &.equivalence]] - (with-expansions - [<quant-tests> (do-template [<desc> <ctor> <dtor>] - [(test (format "Can build and tear-down " <desc> " types.") - (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)] - (and (n/= size flat-size) - (&/= extra flat-body))))] - - ["universally-quantified" &.univ-q &.flatten-univ-q] - ["existentially-quantified" &.ex-q &.flatten-ex-q] - )] - ($_ seq - <quant-tests> - ))))) diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux deleted file mode 100644 index 426127fb6..000000000 --- a/stdlib/test/test/lux/type/check.lux +++ /dev/null @@ -1,237 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do Monad)] - [pipe (#+ case>)]] - [data - ["." product] - ["." maybe] - ["." number] - [text ("text/." equivalence)] - [collection - ["." list ("list/." functor)] - ["." set]]] - [math - ["r" random]] - ["." type ("type/." equivalence) - ["@" check]]] - lux/test - ["." //]) - -## [Utils] -(def: (valid-type? type) - (-> Type Bit) - (case type - (#.Primitive name params) - (list.every? valid-type? params) - - (#.Ex id) - #1 - - (^template [<tag>] - (<tag> left right) - (and (valid-type? left) (valid-type? right))) - ([#.Sum] [#.Product] [#.Function]) - - (#.Named name type') - (valid-type? type') - - _ - #0)) - -(def: (type-checks? input) - (-> (@.Check []) Bit) - (case (@.run @.fresh-context input) - (#.Right []) - #1 - - (#.Left error) - #0)) - -## [Tests] -(context: "Any and Nothing." - (<| (times 100) - (do @ - [sample (|> //.gen-type (r.filter valid-type?))] - ($_ seq - (test "Any is the super-type of everything." - (@.checks? Any sample)) - - (test "Nothing is the sub-type of everything." - (@.checks? sample Nothing)) - )))) - -(context: "Simple type-checking." - ($_ seq - (test "Any and Nothing match themselves." - (and (@.checks? Nothing Nothing) - (@.checks? Any Any))) - - (test "Existential types only match with themselves." - (and (type-checks? (do @.monad - [[_ exT] @.existential] - (@.check exT exT))) - (not (type-checks? (do @.monad - [[_ exTL] @.existential - [_ exTR] @.existential] - (@.check exTL exTR)))))) - - (test "Names do not affect type-checking." - (and (type-checks? (do @.monad - [[_ exT] @.existential] - (@.check (#.Named ["module" "name"] exT) - exT))) - (type-checks? (do @.monad - [[_ exT] @.existential] - (@.check exT - (#.Named ["module" "name"] exT)))) - (type-checks? (do @.monad - [[_ exT] @.existential] - (@.check (#.Named ["module" "name"] exT) - (#.Named ["module" "name"] exT)))))) - - (test "Functions are covariant on inputs and contravariant on outputs." - (and (@.checks? (#.Function Nothing Any) - (#.Function Any Nothing)) - (not (@.checks? (#.Function Any Nothing) - (#.Function Nothing Any))))) - )) - -(context: "Type application." - (<| (times 100) - (do @ - [meta //.gen-type - data //.gen-type] - (test "Can type-check type application." - (and (@.checks? (|> Ann (#.Apply meta) (#.Apply data)) - (type.tuple (list meta data))) - (@.checks? (type.tuple (list meta data)) - (|> Ann (#.Apply meta) (#.Apply data)))))))) - -(context: "Primitive types." - (<| (times 100) - (do @ - [nameL //.gen-short - nameR (|> //.gen-short (r.filter (|>> (text/= nameL) not))) - paramL //.gen-type - paramR (|> //.gen-type (r.filter (|>> (@.checks? paramL) not)))] - ($_ seq - (test "Primitive types match when they have the same name and the same parameters." - (@.checks? (#.Primitive nameL (list paramL)) - (#.Primitive nameL (list paramL)))) - - (test "Names matter to primitive types." - (not (@.checks? (#.Primitive nameL (list paramL)) - (#.Primitive nameR (list paramL))))) - - (test "Parameters matter to primitive types." - (not (@.checks? (#.Primitive nameL (list paramL)) - (#.Primitive nameL (list paramR))))) - )))) - -(context: "Type variables." - ($_ seq - (test "Type-vars check against themselves." - (type-checks? (do @.monad - [[id var] @.var] - (@.check var var)))) - - (test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (do @.monad - [[id var] @.var] - (@.check var .Any))) - (type-checks? (do @.monad - [[id var] @.var] - (@.check .Any var))))) - - (test "Cannot rebind already bound type-vars." - (not (type-checks? (do @.monad - [[id var] @.var - _ (@.check var .Bit)] - (@.check var .Nat))))) - - (test "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (do @.monad - [[id var] @.var - _ (@.check var Any)] - (@.check var .Bit)))) - - (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (do @.monad - [[id var] @.var - _ (@.check var Nothing)] - (@.check .Bit var)))) - )) - -(def: (build-ring num-connections) - (-> Nat (@.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do @.monad - [[head-id head-type] @.var - ids+types (monad.seq @ (list.repeat num-connections @.var)) - [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type]) - (do @ - [_ (@.check head-type tail-type)] - (wrap [tail-id tail-type]))) - [head-id head-type] - ids+types)] - (wrap [[head-id head-type] ids+types [tail-id tail-type]]))) - -(context: "Rings of type variables." - (<| (times 100) - (do @ - [num-connections (|> r.nat (:: @ map (n/% 100))) - boundT (|> //.gen-type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) - pick-pcg (r.and r.nat r.nat)] - ($_ seq - (test "Can create rings of variables." - (type-checks? (do @.monad - [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) - #let [ids (list/map product.left ids+types)] - headR (@.ring head-id) - tailR (@.ring tail-id)] - (@.assert "" - (let [same-rings? (:: set.equivalence = headR tailR) - expected-size? (n/= (inc num-connections) (set.size headR)) - same-vars? (|> (set.to-list headR) - (list.sort n/<) - (:: (list.equivalence number.equivalence) = (list.sort n/< (#.Cons head-id ids))))] - (and same-rings? - expected-size? - same-vars?)))))) - (test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do @.monad - [[[head-id headT] ids+types tailT] (build-ring num-connections) - #let [ids (list/map product.left ids+types)] - _ (@.check headT boundT) - head-bound (@.read head-id) - tail-bound (monad.map @ @.read ids) - headR (@.ring head-id) - tailR+ (monad.map @ @.ring ids)] - (let [rings-were-erased? (and (set.empty? headR) - (list.every? set.empty? tailR+)) - same-types? (list.every? (type/= boundT) (list& (maybe.default headT head-bound) - (list/map (function (_ [tail-id ?tailT]) - (maybe.default (#.Var tail-id) ?tailT)) - (list.zip2 ids tail-bound))))] - (@.assert "" - (and rings-were-erased? - same-types?)))))) - (test "Can merge multiple rings of variables." - (type-checks? (do @.monad - [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections) - [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections) - headRL-pre (@.ring head-idL) - headRR-pre (@.ring head-idR) - _ (@.check headTL headTR) - headRL-post (@.ring head-idL) - headRR-post (@.ring head-idR)] - (@.assert "" - (let [same-rings? (:: set.equivalence = headRL-post headRR-post) - expected-size? (n/= (n/* 2 (inc num-connections)) - (set.size headRL-post)) - union? (:: set.equivalence = headRL-post (set.union headRL-pre headRR-pre))] - (and same-rings? - expected-size? - union?)))))) - )) - )) diff --git a/stdlib/test/test/lux/type/dynamic.lux b/stdlib/test/test/lux/type/dynamic.lux deleted file mode 100644 index 70e26f743..000000000 --- a/stdlib/test/test/lux/type/dynamic.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)]] - [data - ["." error]] - [math - ["r" random]] - [type - ["/" dynamic (#+ Dynamic :dynamic :check)]]] - lux/test) - -(context: "Dynamic typing." - (do @ - [expected r.nat - #let [value (:dynamic expected)]] - ($_ seq - (test "Can check dynamic values." - (case (:check Nat value) - (#error.Success actual) - (n/= expected actual) - - (#error.Failure error) - false)) - (test "Cannot confuse types." - (case (:check Text value) - (#error.Success actual) - false - - (#error.Failure error) - true))))) diff --git a/stdlib/test/test/lux/type/implicit.lux b/stdlib/test/test/lux/type/implicit.lux deleted file mode 100644 index 98b647bf1..000000000 --- a/stdlib/test/test/lux/type/implicit.lux +++ /dev/null @@ -1,40 +0,0 @@ -(.module: - [lux #* - [io] - [control - [equivalence] - [functor] - [monad (#+ Monad do)]] - [data - [bit ("bit/." equivalence)] - [number] - [collection [list]]] - [math - ["r" random]] - [type implicit]] - lux/test) - -(context: "Automatic structure selection" - (<| (times 100) - (do @ - [x r.nat - y r.nat] - ($_ seq - (test "Can automatically select first-order structures." - (let [(^open "list/.") (list.equivalence number.equivalence)] - (and (bit/= (:: number.equivalence = x y) - (::: = x y)) - (list/= (list.n/range 1 10) - (::: map inc (list.n/range 0 9))) - ))) - - (test "Can automatically select second-order structures." - (::: = - (list.n/range 1 10) - (list.n/range 1 10))) - - (test "Can automatically select third-order structures." - (let [lln (::: map (list.n/range 1) - (list.n/range 1 10))] - (::: = lln lln))) - )))) diff --git a/stdlib/test/test/lux/type/resource.lux b/stdlib/test/test/lux/type/resource.lux deleted file mode 100644 index b04321cc2..000000000 --- a/stdlib/test/test/lux/type/resource.lux +++ /dev/null @@ -1,48 +0,0 @@ -(.module: - [lux #* - [control - [monad - [indexed (#+ do)]]] - [type - ["." resource (#+ Res)]] - ["." io]] - lux/test) - -(context: "Sub-structural typing." - ($_ seq - (test "Can produce and consume keys in an ordered manner." - (<| (n/= (n/+ 123 456)) - io.run - resource.run-sync - (do resource.sync - [res|left (resource.ordered-sync 123) - res|right (resource.ordered-sync 456) - right (resource.read-sync res|right) - left (resource.read-sync res|left)] - (wrap (n/+ left right))))) - - (test "Can exchange commutative keys." - (<| (n/= (n/+ 123 456)) - io.run - resource.run-sync - (do resource.sync - [res|left (resource.commutative-sync 123) - res|right (resource.commutative-sync 456) - _ (resource.exchange-sync [1 0]) - left (resource.read-sync res|left) - right (resource.read-sync res|right)] - (wrap (n/+ left right))))) - - (test "Can group and un-group keys." - (<| (n/= (n/+ 123 456)) - io.run - resource.run-sync - (do resource.sync - [res|left (resource.commutative-sync 123) - res|right (resource.commutative-sync 456) - _ (resource.group-sync 2) - _ (resource.un-group-sync 2) - right (resource.read-sync res|right) - left (resource.read-sync res|left)] - (wrap (n/+ left right))))) - )) diff --git a/stdlib/test/test/lux/world/binary.lux b/stdlib/test/test/lux/world/binary.lux deleted file mode 100644 index ec4da0d11..000000000 --- a/stdlib/test/test/lux/world/binary.lux +++ /dev/null @@ -1,88 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)]] - [data - ["." error (#+ Error)] - ["." number - ["." i64]] - [collection - ["." list]]] - [world - ["/" binary]] - [math - ["r" random]]] - lux/test - [test - [lux - [control - ["_eq" equivalence]]]]) - -(def: (succeed result) - (-> (Error Bit) Bit) - (case result - (#error.Failure _) - #0 - - (#error.Success output) - output)) - -(def: #export (binary size) - (-> Nat (r.Random /.Binary)) - (let [output (/.create size)] - (loop [idx 0] - (if (n/< size idx) - (do r.monad - [byte r.nat] - (exec (error.assume (/.write/8 idx byte output)) - (recur (inc idx)))) - (:: r.monad wrap output))))) - -(def: (bits-io bytes read write value) - (-> Nat (-> Nat /.Binary (Error Nat)) (-> Nat Nat /.Binary (Error Any)) Nat Bit) - (let [binary (/.create 8) - bits (n/* 8 bytes) - capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))] - (succeed - (do error.monad - [_ (write 0 value binary) - output (read 0 binary)] - (wrap (n/= capped-value output)))))) - -(context: "Binary." - (<| (times 100) - (do @ - [#let [gen-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 8))))] - binary-size gen-size - random-binary (binary binary-size) - value r.nat - #let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))] - [from to] (r.and gen-idx gen-idx) - #let [[from to] [(n/min from to) (n/max from to)]]] - ($_ seq - ## TODO: De-comment... - ## (_eq.spec /.equivalence (:: @ map binary gen-size)) - (test "Can get size of binary." - (|> random-binary /.size (n/= binary-size))) - (test "Can read/write 8-bit values." - (bits-io 1 /.read/8 /.write/8 value)) - (test "Can read/write 16-bit values." - (bits-io 2 /.read/16 /.write/16 value)) - (test "Can read/write 32-bit values." - (bits-io 4 /.read/32 /.write/32 value)) - (test "Can read/write 64-bit values." - (bits-io 8 /.read/64 /.write/64 value)) - (test "Can slice binaries." - (let [slice-size (|> to (n/- from) inc) - random-slice (error.assume (/.slice from to random-binary)) - idxs (list.n/range 0 (dec slice-size)) - reader (function (_ binary idx) (/.read/8 idx binary))] - (and (n/= slice-size (/.size random-slice)) - (case [(monad.map error.monad (reader random-slice) idxs) - (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] - [(#error.Success slice-vals) (#error.Success binary-vals)] - (:: (list.equivalence number.nat-equivalence) = slice-vals binary-vals) - - _ - #0)))) - )))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux deleted file mode 100644 index b3693f207..000000000 --- a/stdlib/test/test/lux/world/file.lux +++ /dev/null @@ -1,195 +0,0 @@ -(.module: - [lux #* - ["." io (#+ IO)] - [control - [monad (#+ do)] - [security - ["." integrity (#+ Dirty)]]] - [concurrency - ["." promise]] - [data - ["." error (#+ Error)] - ["." number] - ["." text - format] - [collection - ["." list]]] - [time - ["." instant] - ["." duration]] - [world - ["@" file (#+ Path File)] - ["." binary (#+ Binary)]] - [math - ["r" random ("r/." monad)]]] - lux/test - [// - ["_." binary]]) - -(def: truncate-millis - (|>> (i// +1_000) (i/* +1_000))) - -(def: (creation-and-deletion number) - (-> Nat Test) - (r/wrap (do promise.monad - [#let [path (format "temp_file_" (%n number))] - result (promise.future - (do (error.ErrorT io.monad) - [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.monad @.system path)))] - pre! check-existence! - file (:: @.system create-file path) - post! check-existence! - _ (:: file delete []) - remains? check-existence!] - (wrap (and (not pre!) - post! - (not remains?)))))] - (assert "Can create/delete files." - (error.default #0 result))))) - -(def: (read-and-write number data) - (-> Nat Binary Test) - (r/wrap (do promise.monad - [#let [path (format "temp_file_" (%n number))] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write data) - content (:: file content []) - _ (:: file delete [])] - (wrap (:: binary.equivalence = data (integrity.trust content)))))] - (assert "Can write/read files." - (error.default #0 result))))) - -(context: "File system." - (do @ - [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - dataL (_binary.binary file-size) - dataR (_binary.binary file-size) - new-modified (|> r.int (:: @ map (|>> (:: number.number abs) - truncate-millis - duration.from-millis - instant.absolute)))] - ($_ seq - (creation-and-deletion 0) - (read-and-write 1 dataL) - (wrap (do promise.monad - [#let [path "temp_file_2"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - read-size (:: file size []) - _ (:: file delete [])] - (wrap (n/= file-size read-size))))] - (assert "Can read file size." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_file_3"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - _ (:: file append dataR) - content (:: file content []) - read-size (:: file size []) - _ (:: file delete [])] - (wrap (and (n/= (n/* 2 file-size) read-size) - (:: binary.equivalence = - dataL - (error.assume (binary.slice 0 (dec file-size) - (integrity.trust content)))) - (:: binary.equivalence = - dataR - (error.assume (binary.slice file-size (dec read-size) - (integrity.trust content))))))))] - (assert "Can append to files." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_dir_4"] - result (promise.future - (do (error.ErrorT io.monad) - [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.monad @.system path)))] - pre! check-existence! - dir (:: @.system create-directory path) - post! check-existence! - _ (:: dir discard []) - remains? check-existence!] - (wrap (and (not pre!) - post! - (not remains?)))))] - (assert "Can create/delete directories." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [file-path "temp_file_5" - dir-path "temp_dir_5"] - result (promise.future - (do (error.ErrorT io.monad) - [dir (:: @.system create-directory dir-path) - file (:: @.system create-file (format dir-path "/" file-path)) - _ (:: file over-write dataL) - read-size (:: file size []) - _ (:: file delete []) - _ (:: dir discard [])] - (wrap (n/= file-size read-size))))] - (assert "Can create files inside of directories." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [file-path "temp_file_6" - dir-path "temp_dir_6" - inner-dir-path "inner_temp_dir_6"] - result (promise.future - (do (error.ErrorT io.monad) - [dir (:: @.system create-directory dir-path) - pre-files (:: dir files []) - pre-directories (:: dir directories []) - - file (:: @.system create-file (format dir-path "/" file-path)) - inner-dir (:: @.system create-directory (format dir-path "/" inner-dir-path)) - post-files (:: dir files []) - post-directories (:: dir directories []) - - _ (:: file delete []) - _ (:: inner-dir discard []) - _ (:: dir discard [])] - (wrap (and (and (n/= 0 (list.size pre-files)) - (n/= 0 (list.size pre-directories))) - (and (n/= 1 (list.size post-files)) - (n/= 1 (list.size post-directories)))))))] - (assert "Can list files/directories inside a directory." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path "temp_file_7"] - result (promise.future - (do (error.ErrorT io.monad) - [file (:: @.system create-file path) - _ (:: file over-write dataL) - _ (:: file modify new-modified) - old-modified (:: file last-modified []) - _ (:: file delete [])] - (wrap (:: instant.equivalence = new-modified old-modified))))] - (assert "Can change the time of last modification." - (error.default #0 result)))) - (wrap (do promise.monad - [#let [path0 (format "temp_file_8+0") - path1 (format "temp_file_8+1")] - result (promise.future - (do (error.ErrorT io.monad) - [#let [check-existence! (: (-> Path (IO (Error Bit))) - (|>> (@.exists? io.monad @.system) io.from-io))] - file0 (:: @.system create-file path0) - _ (:: file0 over-write dataL) - pre! (check-existence! path0) - file1 (: (IO (Error (File IO))) ## TODO: Remove : - (:: file0 move path1)) - post! (check-existence! path0) - confirmed? (check-existence! path1) - _ (:: file1 delete [])] - (wrap (and pre! - (not post!) - confirmed?))))] - (assert "Can move a file from one path to another." - (error.default #0 result)))) - ))) diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux deleted file mode 100644 index fae5ac05d..000000000 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ /dev/null @@ -1,71 +0,0 @@ -(.module: - [lux #* - ["." io] - [control - [monad (#+ do)] - ["ex" exception (#+ exception:)] - [security - ["." taint]]] - [concurrency - ["." promise (#+ Promise promise)] - [frp ("frp/." functor)]] - [data - ["." error] - ["." text - format]] - [world - ["." binary] - ["." net - ["@" tcp]]] - [math - ["r" random]]] - lux/test - [/// - ["_." binary]]) - -(def: localhost net.Address "127.0.0.1") - -(def: port - (r.Random net.Port) - (|> r.nat - (:: r.monad map - (|>> (n/% 1000) - (n/+ 8000))))) - -(context: "TCP networking." - (do @ - [port ..port - size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - from (_binary.binary size) - to (_binary.binary size)] - ($_ seq - (wrap (do promise.monad - [#let [from-worked? (: (Promise Bit) - (promise #.Nil))] - result (promise.future - (do io.monad - [[server-close server] (@.server port) - #let [_ (frp/map (function (_ client) - (promise.future - (do @ - [[trasmission-size transmission] (:: client read size) - #let [_ (io.run (promise.resolve (and (n/= size trasmission-size) - (:: binary.equivalence = from (taint.trust transmission))) - from-worked?))]] - (:: client write to)))) - server)] - client (@.client localhost port) - _ (:: client write from) - #################### - [trasmission-size transmission] (:: client read size) - #let [to-worked? (and (n/= size trasmission-size) - (:: binary.equivalence = to (taint.trust transmission)))] - #################### - _ (:: client close []) - _ (io.from-io (promise.resolve [] server-close))] - (wrap to-worked?))) - from-worked? from-worked?] - (assert "Can communicate between client and server." - (and from-worked? - (error.default #0 result))))) - ))) diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux deleted file mode 100644 index 2b85958fa..000000000 --- a/stdlib/test/test/lux/world/net/udp.lux +++ /dev/null @@ -1,64 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - [security - ["." integrity]]] - [concurrency - ["." promise]] - [data - ["." error] - ["." text - format]] - ["." io] - [world - ["." binary] - ["." net - ["@" udp]]] - [math - ["r" random]]] - lux/test - [/// - ["_." binary]]) - -(def: localhost net.Address "127.0.0.1") -(def: port - (r.Random net.Port) - (|> r.nat - (:: r.monad map - (|>> (n/% 1000) - (n/+ 8000))))) - -(context: "UDP networking." - (do @ - [port ..port - size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - from (_binary.binary size) - to (_binary.binary size)] - ($_ seq - (wrap (do promise.monad - [result (promise.future - (do io.monad - [server (@.server port) - client @.client - #################### - _ (:: client write [[localhost port] from]) - [bytes-from [from-address from-port] temp] (:: server read size) - #let [from-worked? (and (n/= size bytes-from) - (:: binary.equivalence = from (integrity.trust temp)))] - #################### - _ (:: server write [[from-address from-port] to]) - [bytes-to [to-address to-port] temp] (:: client read size) - #let [to-worked? (and (n/= size bytes-to) - (:: binary.equivalence = to (integrity.trust temp)) - (n/= port to-port))] - #################### - _ (:: client close []) - _ (:: server close [])] - ## (wrap false) - (wrap (and from-worked? - to-worked?)) - ))] - (assert "Can communicate between client and server." - (error.default #0 result)))) - ))) |