From 367c56f33d72621120bcf00953f5fafffb028e97 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 3 Apr 2017 19:19:09 -0400 Subject: - Renamed lux/codata/* to lux/function/* and moved the lux/codata/coll/stream to lux/data/coll/stream. --- stdlib/test/test/lux/cli.lux | 1 - stdlib/test/test/lux/codata/coll/stream.lux | 101 ------------------------- stdlib/test/test/lux/codata/cont.lux | 40 ---------- stdlib/test/test/lux/codata/reader.lux | 38 ---------- stdlib/test/test/lux/codata/state.lux | 50 ------------ stdlib/test/test/lux/codata/thunk.lux | 24 ------ stdlib/test/test/lux/concurrency/actor.lux | 3 +- stdlib/test/test/lux/concurrency/frp.lux | 3 +- stdlib/test/test/lux/concurrency/promise.lux | 1 - stdlib/test/test/lux/concurrency/stm.lux | 1 - stdlib/test/test/lux/data/coll/dict.lux | 1 - stdlib/test/test/lux/data/coll/stream.lux | 100 ++++++++++++++++++++++++ stdlib/test/test/lux/data/coll/tree/zipper.lux | 1 - stdlib/test/test/lux/data/coll/vector.lux | 1 - stdlib/test/test/lux/data/error/exception.lux | 1 - stdlib/test/test/lux/data/log.lux | 1 - stdlib/test/test/lux/data/number/complex.lux | 1 - stdlib/test/test/lux/data/number/ratio.lux | 1 - stdlib/test/test/lux/data/product.lux | 3 +- stdlib/test/test/lux/data/sum.lux | 1 - stdlib/test/test/lux/data/text.lux | 1 - stdlib/test/test/lux/data/text/format.lux | 3 +- stdlib/test/test/lux/function/cont.lux | 39 ++++++++++ stdlib/test/test/lux/function/reader.lux | 37 +++++++++ stdlib/test/test/lux/function/state.lux | 49 ++++++++++++ stdlib/test/test/lux/function/thunk.lux | 24 ++++++ stdlib/test/test/lux/host.jvm.lux | 1 - stdlib/test/test/lux/io.lux | 3 +- stdlib/test/test/lux/macro/ast.lux | 1 - stdlib/test/test/lux/macro/syntax.lux | 1 - stdlib/test/test/lux/math.lux | 1 - stdlib/test/test/lux/math/logic/continuous.lux | 1 - stdlib/test/test/lux/math/logic/fuzzy.lux | 4 +- stdlib/test/test/lux/math/simple.lux | 1 - stdlib/test/test/lux/pipe.lux | 1 - stdlib/test/tests.lux | 12 +-- 36 files changed, 263 insertions(+), 289 deletions(-) delete mode 100644 stdlib/test/test/lux/codata/coll/stream.lux delete mode 100644 stdlib/test/test/lux/codata/cont.lux delete mode 100644 stdlib/test/test/lux/codata/reader.lux delete mode 100644 stdlib/test/test/lux/codata/state.lux delete mode 100644 stdlib/test/test/lux/codata/thunk.lux create mode 100644 stdlib/test/test/lux/data/coll/stream.lux create mode 100644 stdlib/test/test/lux/function/cont.lux create mode 100644 stdlib/test/test/lux/function/reader.lux create mode 100644 stdlib/test/test/lux/function/state.lux create mode 100644 stdlib/test/test/lux/function/thunk.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index e8dbf1f82..8393d459b 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -8,7 +8,6 @@ [product] [sum] (coll [list])) - (codata function) ["&" cli] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/codata/coll/stream.lux b/stdlib/test/test/lux/codata/coll/stream.lux deleted file mode 100644 index 4c69f9f7b..000000000 --- a/stdlib/test/test/lux/codata/coll/stream.lux +++ /dev/null @@ -1,101 +0,0 @@ -(;module: - lux - (lux [io] - (control monad - comonad) - (data [text "Text/" Monoid] - text/format - (coll [list]) - [number "Nat/" Codec]) - (codata function - [cont] - (coll ["&" stream])) - ["R" math/random] - pipe) - lux/test) - -(test: "Streams" - [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;Eq number;Eq) - sample0 (&;iterate n.inc +0) - sample1 (&;iterate n.inc offset)]] - ($_ seq - (assert "Can move along a stream and take slices off it." - (and (and (List/= (list;n.range +0 (n.dec size)) - (&;take size sample0)) - (List/= (list;n.range offset (n.dec (n.+ offset size))) - (&;take size (&;drop offset sample0))) - (let [[drops takes...] (&;split size sample0)] - (and (List/= (list;n.range +0 (n.dec size)) - drops) - (List/= (list;n.range size (n.dec (n.* +2 size))) - (&;take size takes...))))) - (and (List/= (list;n.range +0 (n.dec size)) - (&;take-while (n.< size) sample0)) - (List/= (list;n.range offset (n.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 (n.dec size)) - drops) - (List/= (list;n.range size (n.dec (n.* +2 size))) - (&;take-while (n.< (n.* +2 size)) takes...))))) - )) - - (assert "Can repeat any element and infinite number of times." - (n.= elem (&;nth offset (&;repeat elem)))) - - (assert "Can obtain the head & tail of a stream." - (and (n.= offset (&;head sample1)) - (List/= (list;n.range (n.inc offset) (n.+ offset size)) - (&;take size (&;tail sample1))))) - - (assert "Can filter streams." - (and (n.= (n.* +2 offset) - (&;nth offset - (&;filter n.even? sample0))) - (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))] - (and (n.= (n.* +2 offset) - (&;nth offset evens)) - (n.= (n.inc (n.* +2 offset)) - (&;nth offset odds)))))) - - (assert "Functor goes over 'all' elements in a stream." - (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))))) - - (assert "CoMonad produces a value for every element in a stream." - (let [(^open "&/") &;Functor] - (List/= (&;take size (&/map (n.* factor) sample1)) - (&;take size - (be &;CoMonad - [inputs sample1] - (n.* factor (&;head inputs))))))) - - (assert "'unfold' generalizes 'iterate'." - (let [(^open "&/") &;Functor - (^open "List/") (list;Eq text;Eq)] - (List/= (&;take size - (&/map Nat/encode (&;iterate n.inc offset))) - (&;take size - (&;unfold (lambda [n] [(n.inc n) (Nat/encode n)]) - offset))))) - - (assert "Can cycle over the same elements as an infinite stream." - (|> (&;cycle cycle-seed) - (default (undefined)) - (&;nth cycle-sample-idx) - (n.= (default (undefined) - (list;nth (n.% size cycle-sample-idx) - cycle-seed))))) - )) diff --git a/stdlib/test/test/lux/codata/cont.lux b/stdlib/test/test/lux/codata/cont.lux deleted file mode 100644 index cef7661b0..000000000 --- a/stdlib/test/test/lux/codata/cont.lux +++ /dev/null @@ -1,40 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number] - [product]) - (codata function - ["&" cont]) - ["R" math/random] - pipe) - lux/test) - -(test: "Continuations" - [sample R;nat - #let [(^open "&/") &;Monad]] - ($_ seq - (assert "Can run continuations to compute their values." - (n.= sample (&;run (&;@lazy sample)))) - - (assert "Can use functor." - (n.= (n.inc sample) (&;run (&/map n.inc (&;@lazy sample))))) - - (assert "Can use applicative." - (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) - - (assert "Can use monad." - (n.= (n.inc sample) (&;run (do &;Monad - [func (wrap n.inc) - arg (wrap sample)] - (wrap (func arg)))))) - - ## (assert "Can access current continuation." - ## (n.= (n.dec sample) (&;run (do &;Monad - ## [func (wrap n.inc) - ## _ (&;call/cc (lambda [k] (k (n.dec sample)))) - ## arg (wrap sample)] - ## (wrap (func arg)))))) - )) diff --git a/stdlib/test/test/lux/codata/reader.lux b/stdlib/test/test/lux/codata/reader.lux deleted file mode 100644 index 021ee1ab9..000000000 --- a/stdlib/test/test/lux/codata/reader.lux +++ /dev/null @@ -1,38 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number]) - (codata function - ["&" reader]) - pipe) - lux/test) - -(test: "Readers" - ($_ seq - (assert "" (i.= 123 (&;run 123 &;ask))) - (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) - (assert "" (i.= 134 (&;run 123 (:: &;Functor map i.inc (i.+ 10))))) - (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) - (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "" (i.= 30 (&;run 123 (do &;Monad - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) - -(test: "Monad transformer" - (let [(^open "io/") io;Monad] - (assert "Can add reader functionality to any monad." - (|> (do (&;ReaderT io;Monad) - [a (&;lift-reader (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b))) - (&;run "") - io;run - (case> 579 true - _ false))) - )) diff --git a/stdlib/test/test/lux/codata/state.lux b/stdlib/test/test/lux/codata/state.lux deleted file mode 100644 index c6a6c7ee6..000000000 --- a/stdlib/test/test/lux/codata/state.lux +++ /dev/null @@ -1,50 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number] - [product]) - (codata function - ["&" state]) - pipe) - lux/test) - -(test: "State" - ($_ seq - (assert "" (i.= 123 (product;right (&;run 123 &;get)))) - (assert "" (i.= 321 (product;right (&;run 123 (do &;Monad - [_ (&;put 321)] - &;get))))) - (assert "" (i.= 369 (product;right (&;run 123 (do &;Monad - [_ (&;update (i.* 3))] - &;get))))) - (assert "" (i.= 124 (product;right (&;run 123 (&;use i.inc))))) - (assert "" (i.= 246 (product;right (&;run 123 (&;local (i.* 2) &;get))))) - (assert "" (i.= 124 (product;right (&;run 123 (:: &;Functor map i.inc &;get))))) - (assert "" (i.= 10 (product;right (&;run 123 (:: &;Applicative wrap 10))))) - (assert "" (i.= 30 (product;right (&;run 123 (let [(^open "&/") &;Applicative] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))) - (assert "" (i.= 30 (product;right (&;run 123 (: (&;State Int Int) - (do &;Monad - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) - )) - -(test: "Monad transformer" - (let [lift (&;lift-state io;Monad) - (^open "io/") io;Monad] - (assert "Can add state functionality to any monad." - (|> (: (&;State' io;IO Text Int) - (do (&;StateT io;Monad) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (&;run' "") - io;run - (case> ["" 579] true - _ false))) - )) diff --git a/stdlib/test/test/lux/codata/thunk.lux b/stdlib/test/test/lux/codata/thunk.lux deleted file mode 100644 index eb6a24701..000000000 --- a/stdlib/test/test/lux/codata/thunk.lux +++ /dev/null @@ -1,24 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (codata ["&" thunk]) - pipe - ["R" math/random]) - lux/test) - -(test: "Thunks" - [left R;nat - right R;nat - #let [thunk (&;freeze (n.* left right)) - expected (n.* left right)]] - ($_ seq - (assert "Thunking does not alter the expected value." - (n.= expected - (&;thaw thunk))) - (assert "Thunks only evaluate once." - (and (not (is expected - (&;thaw thunk))) - (is (&;thaw thunk) - (&;thaw thunk)))) - )) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index e13a1ccc5..49100ef01 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -6,8 +6,7 @@ text/format [error #- fail]) (concurrency [promise #+ Promise Monad "Promise/" Monad] - ["&" actor #+ actor:]) - (codata function)) + ["&" actor #+ actor:])) lux/test) (actor: Adder diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index 80f15ad3d..6c2e9af99 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -6,8 +6,7 @@ text/format [error #- fail]) (concurrency [promise #+ Promise Monad "Promise/" Monad] - ["&" frp]) - (codata function)) + ["&" frp])) lux/test) (def: (List->Chan values) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index d75d6d676..a054e5a96 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -6,7 +6,6 @@ text/format [error #- fail]) (concurrency ["&" promise]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index f9e46b91d..d48d20a9d 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -7,7 +7,6 @@ text/format) (concurrency ["&" stm] [promise]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index ff36cc362..3df06abcf 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -9,7 +9,6 @@ [char] (coll ["&" dict] [list "List/" Fold Functor])) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux new file mode 100644 index 000000000..2be6aa054 --- /dev/null +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -0,0 +1,100 @@ +(;module: + lux + (lux [io] + (control monad + comonad) + (data [text "Text/" Monoid] + text/format + (coll [list] + ["&" stream]) + [number "Nat/" Codec]) + (function [cont]) + ["R" math/random] + pipe) + lux/test) + +(test: "Streams" + [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;Eq number;Eq) + sample0 (&;iterate n.inc +0) + sample1 (&;iterate n.inc offset)]] + ($_ seq + (assert "Can move along a stream and take slices off it." + (and (and (List/= (list;n.range +0 (n.dec size)) + (&;take size sample0)) + (List/= (list;n.range offset (n.dec (n.+ offset size))) + (&;take size (&;drop offset sample0))) + (let [[drops takes...] (&;split size sample0)] + (and (List/= (list;n.range +0 (n.dec size)) + drops) + (List/= (list;n.range size (n.dec (n.* +2 size))) + (&;take size takes...))))) + (and (List/= (list;n.range +0 (n.dec size)) + (&;take-while (n.< size) sample0)) + (List/= (list;n.range offset (n.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 (n.dec size)) + drops) + (List/= (list;n.range size (n.dec (n.* +2 size))) + (&;take-while (n.< (n.* +2 size)) takes...))))) + )) + + (assert "Can repeat any element and infinite number of times." + (n.= elem (&;nth offset (&;repeat elem)))) + + (assert "Can obtain the head & tail of a stream." + (and (n.= offset (&;head sample1)) + (List/= (list;n.range (n.inc offset) (n.+ offset size)) + (&;take size (&;tail sample1))))) + + (assert "Can filter streams." + (and (n.= (n.* +2 offset) + (&;nth offset + (&;filter n.even? sample0))) + (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))] + (and (n.= (n.* +2 offset) + (&;nth offset evens)) + (n.= (n.inc (n.* +2 offset)) + (&;nth offset odds)))))) + + (assert "Functor goes over 'all' elements in a stream." + (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))))) + + (assert "CoMonad produces a value for every element in a stream." + (let [(^open "&/") &;Functor] + (List/= (&;take size (&/map (n.* factor) sample1)) + (&;take size + (be &;CoMonad + [inputs sample1] + (n.* factor (&;head inputs))))))) + + (assert "'unfold' generalizes 'iterate'." + (let [(^open "&/") &;Functor + (^open "List/") (list;Eq text;Eq)] + (List/= (&;take size + (&/map Nat/encode (&;iterate n.inc offset))) + (&;take size + (&;unfold (lambda [n] [(n.inc n) (Nat/encode n)]) + offset))))) + + (assert "Can cycle over the same elements as an infinite stream." + (|> (&;cycle cycle-seed) + (default (undefined)) + (&;nth cycle-sample-idx) + (n.= (default (undefined) + (list;nth (n.% size cycle-sample-idx) + cycle-seed))))) + )) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index 888701bbe..ed0318cfe 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -8,7 +8,6 @@ [text "Text/" Monoid] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index c82493df0..735374c5c 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -7,7 +7,6 @@ [text "Text/" Monoid] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux index 96108e448..41d01077e 100644 --- a/stdlib/test/test/lux/data/error/exception.lux +++ b/stdlib/test/test/lux/data/error/exception.lux @@ -7,7 +7,6 @@ [text] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux index 8854ec191..40a124490 100644 --- a/stdlib/test/test/lux/data/log.lux +++ b/stdlib/test/test/lux/data/log.lux @@ -6,7 +6,6 @@ [text "Text/" Monoid Eq] [number] [product]) - (codata function) pipe) lux/test) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index f5c89d5ee..8ed27680c 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -9,7 +9,6 @@ ["&" number/complex] (coll [list "List/" Fold Functor]) [product]) - (codata function) [math] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index a082050f8..c1f7e104f 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -9,7 +9,6 @@ ["&" number/ratio "&/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux index 3021f8b6d..00337ebfb 100644 --- a/stdlib/test/test/lux/data/product.lux +++ b/stdlib/test/test/lux/data/product.lux @@ -4,8 +4,7 @@ (control monad) (data product [text "Text/" Monoid] - [number]) - (codata function)) + [number])) lux/test) (test: "Products" diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index 907eacac0..8ab124c1b 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -6,7 +6,6 @@ [text "Text/" Monoid] [number] (coll [list])) - (codata function) pipe) lux/test) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index ce72cd520..4563d9b12 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -7,7 +7,6 @@ text/format [number] (coll [list])) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index ed05a013d..97b955e20 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -4,8 +4,7 @@ (control monad) (data text/format [text] - [number]) - (codata function)) + [number])) lux/test) (test: "Formatters" diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux new file mode 100644 index 000000000..ba1224bb8 --- /dev/null +++ b/stdlib/test/test/lux/function/cont.lux @@ -0,0 +1,39 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number] + [product]) + (function ["&" cont]) + ["R" math/random] + pipe) + lux/test) + +(test: "Continuations" + [sample R;nat + #let [(^open "&/") &;Monad]] + ($_ seq + (assert "Can run continuations to compute their values." + (n.= sample (&;run (&;@lazy sample)))) + + (assert "Can use functor." + (n.= (n.inc sample) (&;run (&/map n.inc (&;@lazy sample))))) + + (assert "Can use applicative." + (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) + + (assert "Can use monad." + (n.= (n.inc sample) (&;run (do &;Monad + [func (wrap n.inc) + arg (wrap sample)] + (wrap (func arg)))))) + + ## (assert "Can access current continuation." + ## (n.= (n.dec sample) (&;run (do &;Monad + ## [func (wrap n.inc) + ## _ (&;call/cc (lambda [k] (k (n.dec sample)))) + ## arg (wrap sample)] + ## (wrap (func arg)))))) + )) diff --git a/stdlib/test/test/lux/function/reader.lux b/stdlib/test/test/lux/function/reader.lux new file mode 100644 index 000000000..14b95af94 --- /dev/null +++ b/stdlib/test/test/lux/function/reader.lux @@ -0,0 +1,37 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number]) + (function ["&" reader]) + pipe) + lux/test) + +(test: "Readers" + ($_ seq + (assert "" (i.= 123 (&;run 123 &;ask))) + (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) + (assert "" (i.= 134 (&;run 123 (:: &;Functor map i.inc (i.+ 10))))) + (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) + (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (assert "" (i.= 30 (&;run 123 (do &;Monad + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) + +(test: "Monad transformer" + (let [(^open "io/") io;Monad] + (assert "Can add reader functionality to any monad." + (|> (do (&;ReaderT io;Monad) + [a (&;lift-reader (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b))) + (&;run "") + io;run + (case> 579 true + _ false))) + )) diff --git a/stdlib/test/test/lux/function/state.lux b/stdlib/test/test/lux/function/state.lux new file mode 100644 index 000000000..186b786e0 --- /dev/null +++ b/stdlib/test/test/lux/function/state.lux @@ -0,0 +1,49 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number] + [product]) + (function ["&" state]) + pipe) + lux/test) + +(test: "State" + ($_ seq + (assert "" (i.= 123 (product;right (&;run 123 &;get)))) + (assert "" (i.= 321 (product;right (&;run 123 (do &;Monad + [_ (&;put 321)] + &;get))))) + (assert "" (i.= 369 (product;right (&;run 123 (do &;Monad + [_ (&;update (i.* 3))] + &;get))))) + (assert "" (i.= 124 (product;right (&;run 123 (&;use i.inc))))) + (assert "" (i.= 246 (product;right (&;run 123 (&;local (i.* 2) &;get))))) + (assert "" (i.= 124 (product;right (&;run 123 (:: &;Functor map i.inc &;get))))) + (assert "" (i.= 10 (product;right (&;run 123 (:: &;Applicative wrap 10))))) + (assert "" (i.= 30 (product;right (&;run 123 (let [(^open "&/") &;Applicative] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))) + (assert "" (i.= 30 (product;right (&;run 123 (: (&;State Int Int) + (do &;Monad + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) + )) + +(test: "Monad transformer" + (let [lift (&;lift-state io;Monad) + (^open "io/") io;Monad] + (assert "Can add state functionality to any monad." + (|> (: (&;State' io;IO Text Int) + (do (&;StateT io;Monad) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (&;run' "") + io;run + (case> ["" 579] true + _ false))) + )) diff --git a/stdlib/test/test/lux/function/thunk.lux b/stdlib/test/test/lux/function/thunk.lux new file mode 100644 index 000000000..e3e9aca1b --- /dev/null +++ b/stdlib/test/test/lux/function/thunk.lux @@ -0,0 +1,24 @@ +(;module: + lux + (lux [io] + (control monad) + (function ["&" thunk]) + pipe + ["R" math/random]) + lux/test) + +(test: "Thunks" + [left R;nat + right R;nat + #let [thunk (&;freeze (n.* left right)) + expected (n.* left right)]] + ($_ seq + (assert "Thunking does not alter the expected value." + (n.= expected + (&;thaw thunk))) + (assert "Thunks only evaluate once." + (and (not (is expected + (&;thaw thunk))) + (is (&;thaw thunk) + (&;thaw thunk)))) + )) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index ff875ec2a..f58b706d5 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -6,7 +6,6 @@ [number] [product] [text "Text/" Eq]) - (codata function) ["&" host #+ jvm-import class: interface: object] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index e7238aef1..839996e81 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -4,8 +4,7 @@ (control monad) (data [text "Text/" Monoid Eq] text/format - [number]) - (codata function)) + [number])) lux/test) (test: "I/O" diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux index 58efc1b83..768dafbf8 100644 --- a/stdlib/test/test/lux/macro/ast.lux +++ b/stdlib/test/test/lux/macro/ast.lux @@ -1,7 +1,6 @@ (;module: lux (lux [io] - (codata function) (control monad) (data [text "T/" Eq] text/format diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 329e16a0f..b9dd304e1 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -10,7 +10,6 @@ [char] [ident] [error #- fail]) - (codata function) ["R" math/random] pipe [compiler] diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index b1c9b100e..4d8b8d12a 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -8,7 +8,6 @@ [number "r/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe ["&" math]) diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux index ab907d6bd..fa08ec864 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -2,7 +2,6 @@ lux (lux [io] (control monad) - (codata function) ["R" math/random] pipe ["&" math/logic/continuous]) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 45c54bb44..afcd8b731 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -2,7 +2,6 @@ lux (lux [io] (control monad) - (codata function) (data (coll [list] [set]) [bool "B/" Eq] @@ -16,6 +15,7 @@ (do-template [ ] [(test: (format "[" "] " "Triangles") + #seed +1981055421923629192 [x y z @@ -52,6 +52,7 @@ (do-template [ ] [(test: (format "[" "] " "Trapezoids") + #seed +8418494856347027801 [w x y @@ -94,6 +95,7 @@ ) (test: "Gaussian" + #seed +1000679812414 [deviation R;real center R;real #let [gaussian (&;gaussian deviation center)]] diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux index 7a70ec1a6..32f5fb20c 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -8,7 +8,6 @@ [number "r/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe ["&" math/simple]) diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux index 383043ebb..08866a3f4 100644 --- a/stdlib/test/test/lux/pipe.lux +++ b/stdlib/test/test/lux/pipe.lux @@ -7,7 +7,6 @@ [product] identity [text "T/" Eq]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 53a003756..ca0079092 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -12,11 +12,10 @@ ["_;" pipe] ["_;" lexer] (lexer ["_;" regex]) - (codata ["_;" cont] - ["_;" reader] - ["_;" state] - ["_;" thunk] - (coll ["_;" stream])) + (function ["_;" cont] + ["_;" reader] + ["_;" state] + ["_;" thunk]) (concurrency ["_;" actor] ["_;" atom] ["_;" frp] @@ -51,7 +50,8 @@ (tree [rose] [zipper]) ["_;" seq] - ["_;" priority-queue]) + ["_;" priority-queue] + ["_;" stream]) (text [format]) ) ["_;" math] -- cgit v1.2.3