aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test
diff options
context:
space:
mode:
authorEduardo Julian2019-02-05 19:09:31 -0400
committerEduardo Julian2019-02-05 19:09:31 -0400
commit47b97c128bde837fa803a605f3e011a3e9ddd71c (patch)
tree5e8a84d1b1812ec4a157d4049c778ec2e4e434c4 /stdlib/test
parentbe5710d104e6ee085dcb9d871be0b80305e48f8b (diff)
Integrated tests into normal source code.
Diffstat (limited to 'stdlib/test')
-rw-r--r--stdlib/test/test.lux195
-rw-r--r--stdlib/test/test/lux.lux248
-rw-r--r--stdlib/test/test/lux/cli.lux75
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/case.lux198
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/function.lux118
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux100
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux187
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux107
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux297
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux88
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux174
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux97
-rw-r--r--stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux67
-rw-r--r--stdlib/test/test/lux/compiler/default/syntax.lux147
-rw-r--r--stdlib/test/test/lux/control.lux11
-rw-r--r--stdlib/test/test/lux/control/apply.lux69
-rw-r--r--stdlib/test/test/lux/control/concurrency/actor.lux75
-rw-r--r--stdlib/test/test/lux/control/concurrency/atom.lux34
-rw-r--r--stdlib/test/test/lux/control/concurrency/frp.lux53
-rw-r--r--stdlib/test/test/lux/control/concurrency/promise.lux68
-rw-r--r--stdlib/test/test/lux/control/concurrency/semaphore.lux143
-rw-r--r--stdlib/test/test/lux/control/concurrency/stm.lux77
-rw-r--r--stdlib/test/test/lux/control/continuation.lux77
-rw-r--r--stdlib/test/test/lux/control/equivalence.lux21
-rw-r--r--stdlib/test/test/lux/control/exception.lux35
-rw-r--r--stdlib/test/test/lux/control/functor.lux56
-rw-r--r--stdlib/test/test/lux/control/interval.lux235
-rw-r--r--stdlib/test/test/lux/control/monad.lux54
-rw-r--r--stdlib/test/test/lux/control/parser.lux177
-rw-r--r--stdlib/test/test/lux/control/pipe.lux72
-rw-r--r--stdlib/test/test/lux/control/reader.lux37
-rw-r--r--stdlib/test/test/lux/control/region.lux106
-rw-r--r--stdlib/test/test/lux/control/security/integrity.lux54
-rw-r--r--stdlib/test/test/lux/control/security/privacy.lux85
-rw-r--r--stdlib/test/test/lux/control/state.lux117
-rw-r--r--stdlib/test/test/lux/control/thread.lux21
-rw-r--r--stdlib/test/test/lux/control/writer.lux45
-rw-r--r--stdlib/test/test/lux/data/bit.lux37
-rw-r--r--stdlib/test/test/lux/data/collection/array.lux143
-rw-r--r--stdlib/test/test/lux/data/collection/bits.lux87
-rw-r--r--stdlib/test/test/lux/data/collection/dictionary.lux129
-rw-r--r--stdlib/test/test/lux/data/collection/dictionary/ordered.lux91
-rw-r--r--stdlib/test/test/lux/data/collection/list.lux239
-rw-r--r--stdlib/test/test/lux/data/collection/queue.lux54
-rw-r--r--stdlib/test/test/lux/data/collection/queue/priority.lux57
-rw-r--r--stdlib/test/test/lux/data/collection/row.lux82
-rw-r--r--stdlib/test/test/lux/data/collection/sequence.lux103
-rw-r--r--stdlib/test/test/lux/data/collection/set.lux67
-rw-r--r--stdlib/test/test/lux/data/collection/set/ordered.lux98
-rw-r--r--stdlib/test/test/lux/data/collection/stack.lux46
-rw-r--r--stdlib/test/test/lux/data/collection/tree/rose.lux51
-rw-r--r--stdlib/test/test/lux/data/collection/tree/rose/zipper.lux128
-rw-r--r--stdlib/test/test/lux/data/color.lux99
-rw-r--r--stdlib/test/test/lux/data/error.lux61
-rw-r--r--stdlib/test/test/lux/data/format/json.lux183
-rw-r--r--stdlib/test/test/lux/data/format/xml.lux121
-rw-r--r--stdlib/test/test/lux/data/identity.lux37
-rw-r--r--stdlib/test/test/lux/data/lazy.lux54
-rw-r--r--stdlib/test/test/lux/data/maybe.lux69
-rw-r--r--stdlib/test/test/lux/data/name.lux73
-rw-r--r--stdlib/test/test/lux/data/number.lux185
-rw-r--r--stdlib/test/test/lux/data/number/complex.lux201
-rw-r--r--stdlib/test/test/lux/data/number/i64.lux75
-rw-r--r--stdlib/test/test/lux/data/number/ratio.lux116
-rw-r--r--stdlib/test/test/lux/data/product.lux17
-rw-r--r--stdlib/test/test/lux/data/sum.lux37
-rw-r--r--stdlib/test/test/lux/data/text.lux143
-rw-r--r--stdlib/test/test/lux/data/text/format.lux21
-rw-r--r--stdlib/test/test/lux/data/text/lexer.lux205
-rw-r--r--stdlib/test/test/lux/data/text/regex.lux286
-rw-r--r--stdlib/test/test/lux/host.js.lux28
-rw-r--r--stdlib/test/test/lux/host.jvm.lux134
-rw-r--r--stdlib/test/test/lux/host/jvm.jvm.lux89
-rw-r--r--stdlib/test/test/lux/io.lux39
-rw-r--r--stdlib/test/test/lux/macro/code.lux36
-rw-r--r--stdlib/test/test/lux/macro/poly/equivalence.lux71
-rw-r--r--stdlib/test/test/lux/macro/poly/functor.lux24
-rw-r--r--stdlib/test/test/lux/macro/syntax.lux155
-rw-r--r--stdlib/test/test/lux/math.lux125
-rw-r--r--stdlib/test/test/lux/math/logic/continuous.lux35
-rw-r--r--stdlib/test/test/lux/math/logic/fuzzy.lux183
-rw-r--r--stdlib/test/test/lux/math/modular.lux150
-rw-r--r--stdlib/test/test/lux/math/random.lux49
-rw-r--r--stdlib/test/test/lux/time/date.lux147
-rw-r--r--stdlib/test/test/lux/time/duration.lux60
-rw-r--r--stdlib/test/test/lux/time/instant.lux99
-rw-r--r--stdlib/test/test/lux/type.lux168
-rw-r--r--stdlib/test/test/lux/type/check.lux237
-rw-r--r--stdlib/test/test/lux/type/dynamic.lux31
-rw-r--r--stdlib/test/test/lux/type/implicit.lux40
-rw-r--r--stdlib/test/test/lux/type/resource.lux48
-rw-r--r--stdlib/test/test/lux/world/binary.lux88
-rw-r--r--stdlib/test/test/lux/world/file.lux195
-rw-r--r--stdlib/test/test/lux/world/net/tcp.lux71
-rw-r--r--stdlib/test/test/lux/world/net/udp.lux64
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))))
- )))