-
Notifications
You must be signed in to change notification settings - Fork 146
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
686: [WIP] feat(std): add monad transformer interface, StateT, and LazyT r=Marwes a=Etherian ## Description Adds a monad-transformer interface `Transformer`, a State monad transformer `StateT`, and a Lazy monad transformer `LazyT` to the standard library. ## Related PRs Lays groundwork for Streamlike and the new parser #687. ## Status **In Development** ### Outstanding design questions - [x] ~~Can and should `StateT` be replaced by the effects system?~~ ([not for the time being, at least](#686 (comment))) - [ ] Should `Transformer` require `monad` field? - [ ] Should StateT and LazyT (and other monad transformers) be merged with their non-transformer counterparts? ### To Do - [x] ~~Fix StateT's implicit parameter bugs~~ (#688 & #689) - [ ] add tests - [ ] add inline docs ## Prior Art - StateT - [Haskell](https://hackage.haskell.org/package/transformers-0.5.6.2/docs/src/Control.Monad.Trans.State.Lazy.html#StateT) - [Idris](https://github.com/idris-lang/Idris-dev/blob/master/libs/base/Control/Monad/State.idr) - [Implementing Applicative (<*>) for StateT](https://stackoverflow.com/questions/27903650/implementing-applicative-for-statet) - MonadTrans - [Haskell](https://hackage.haskell.org/package/transformers/docs/src/Control.Monad.Trans.Class.html#MonadTrans) - [Idris](https://github.com/idris-lang/Idris-dev/blob/master/libs/base/Control/Monad/Trans.idr) Co-authored-by: Etherian <etherain@gmail.com> Co-authored-by: Markus Westerlind <marwes91@gmail.com>
- Loading branch information
Showing
5 changed files
with
230 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,44 @@ | ||
//@NO-IMPLICIT-PRELUDE | ||
|
||
let { Applicative, apply, wrap } = import! std.applicative | ||
let { (<<) } = import! std.function | ||
let { Functor, map } = import! std.functor | ||
let { Lazy, lazy, force } = import! std.lazy | ||
let { Monad, flat_map } = import! std.monad | ||
let { Transformer } = import! std.transformer | ||
|
||
type LazyT m a = Lazy (m a) | ||
|
||
let functor : [Functor m] -> Functor (LazyT m) = | ||
let ltmap f ma = lazy (\_ -> map f (force ma)) | ||
|
||
{ map = ltmap } | ||
|
||
let applicative : [Applicative m] -> Applicative (LazyT m) = | ||
let ltwrap a = lazy (\_ -> wrap a) | ||
let ltapply mf ma = lazy (\_ -> apply (force mf) (force ma)) | ||
|
||
{ functor, apply = ltapply, wrap = ltwrap } | ||
|
||
let monad : [Monad m] -> Monad (LazyT m) = | ||
let ltflat_map f ma = lazy (\_ -> flat_map (force << f) (force ma)) | ||
|
||
{ applicative, flat_map = ltflat_map } | ||
|
||
let transformer : Transformer LazyT = | ||
let wrap_monad ma : [Monad m] -> m a -> LazyT m a = lazy (\_ -> ma) | ||
|
||
{ /* monad, */ wrap_monad } | ||
|
||
let force_t : LazyT m a -> m a = force | ||
|
||
{ | ||
LazyT, | ||
|
||
force_t, | ||
|
||
functor, | ||
applicative, | ||
monad, | ||
transformer | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,93 @@ | ||
//! The state monad transformer. | ||
|
||
let { Alternative, or, empty } = import! std.alternative | ||
let { Applicative, wrap, (<*>) } = import! std.applicative | ||
let { (>>), (<<), ? } = import! std.function | ||
let { Functor, map } = import! std.functor | ||
let { Monad, (>>=) } = import! std.monad | ||
let { Transformer } = import! std.transformer | ||
|
||
type StateOut s a = { value : a, state : s } | ||
type WrStateOut s m a = m { value : a, state : s } | ||
|
||
type StateT s m a = s -> m { value : a, state : s } | ||
|
||
let map_sout f st : (a -> b) -> StateOut s a -> StateOut s b = | ||
{value = f st.value, state = st.state} | ||
|
||
let functor : [Functor m] -> Functor (StateT s m) = | ||
let stmap f sr : (a -> b) -> StateT s m a -> StateT s m b = | ||
map (map_sout f) << sr | ||
|
||
{ map = stmap } | ||
|
||
// the typechecker can't find map and Functor m without help | ||
let applicative ?mo : [Monad m] -> Applicative (StateT s m) = | ||
let apply srf sr : StateT s m (a -> b) -> StateT s m a -> StateT s m b = \state -> | ||
srf state >>= \fout -> | ||
let {value = f, state = state'} = fout | ||
mo.applicative.functor.map (map_sout f) (sr state') | ||
|
||
let stwrap value : a -> StateT s m a = \state -> | ||
wrap { value, state } | ||
|
||
{ functor = functor ?mo.applicative.functor, apply, wrap = stwrap } | ||
|
||
let monad : [Monad m] -> Monad (StateT s m) = | ||
let flat_map f sr : (a -> StateT s m b) -> StateT s m a -> StateT s m b = \state -> | ||
sr state >>= \sout -> | ||
let {value, state = state'} = sout | ||
f value state' | ||
|
||
{ applicative, flat_map } | ||
|
||
let transformer : Transformer (StateT s) = | ||
let wrap_monad ma : [Monad m] -> m a -> StateT s m a = \state -> | ||
ma >>= \value -> wrap {value, state} | ||
|
||
{ /* monad, */ wrap_monad } | ||
|
||
let alternative : [Monad m] -> [Alternative m] -> Alternative (StateT s m) = | ||
let stor sra srb = or << sra <*> srb | ||
let stempty = transformer.wrap_monad empty | ||
|
||
{ applicative, or = stor, empty = stempty } | ||
|
||
let put value : [Monad m] -> s -> StateT s m () = \state -> | ||
wrap { value = (), state = value } | ||
|
||
let get : [Monad m] -> StateT s m s = \state -> | ||
wrap { value = state, state } | ||
|
||
let gets f : [Monad m] -> (s -> a) -> StateT s m a = | ||
get >>= (wrap << f) | ||
|
||
let modify f : [Monad m] -> (s -> s) -> StateT s m () = | ||
get >>= (put << f) | ||
|
||
let run_state_t f state : StateT s m a -> s -> m { value : a, state : s } = | ||
f state | ||
|
||
let eval_state_t f state : [Functor m] -> StateT s m a -> s -> m a = | ||
map (\x -> x.value) (run_state_t f state) | ||
|
||
let exec_state_t f state : [Functor m] -> StateT s m a -> s -> m s = | ||
map (\x -> x.state) (run_state_t f state) | ||
|
||
{ | ||
StateT, | ||
|
||
applicative, | ||
functor, | ||
monad, | ||
transformer, | ||
alternative, | ||
|
||
put, | ||
get, | ||
gets, | ||
modify, | ||
run_state_t, | ||
eval_state_t, | ||
exec_state_t | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,14 @@ | ||
//@NO-IMPLICIT-PRELUDE | ||
|
||
let { Monad } = import! std.prelude | ||
|
||
#[implicit] | ||
type Transformer t = { | ||
/* monad : forall m . [Monad m] -> Monad (t m), */ | ||
wrap_monad : forall a m . [Monad m] -> m a -> t m a | ||
} | ||
|
||
let wrap_monad ?_ ?tr ma : [Monad m] -> [Transformer t] -> m a -> t m a = | ||
tr.wrap_monad ma | ||
|
||
{ Transformer, wrap_monad } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,34 @@ | ||
let { (<|) } = import! std.function | ||
let { Test, run, assert, assert_eq, test, group, ? } = import! std.test | ||
let { LazyT, force_t, ? } = import! std.lazyt | ||
let { Functor, map } = import! std.functor | ||
let { Applicative, wrap, (*>) } = import! std.applicative | ||
let { Monad, (>>=) } = import! std.monad | ||
let { Transformer, wrap_monad } = import! std.transformer | ||
let { Option, unwrap, ? } = import! std.option | ||
let { (++), ? } = import! std.string | ||
let list @ { List, ? } = import! std.list | ||
|
||
|
||
let left_identity x f : [Eq a] -> [Show a] -> a -> (a -> LazyT Option a) -> _ = \_ -> | ||
let mx : LazyT Option _ = wrap x | ||
assert_eq (force_t (mx >>= f)) (force_t (f x)) | ||
|
||
let right_identity x : [Eq a] -> [Show a] -> a -> _ = \_ -> | ||
let mx : LazyT Option _ = wrap x | ||
assert_eq (force_t (mx >>= wrap)) (force_t mx) | ||
|
||
let associativity mx f g : [Monad m] -> [Show (m a)] -> [Eq (m a)] -> m a -> _ -> _ -> _ = \_ -> | ||
let mx : LazyT m _ = wrap_monad mx | ||
assert_eq (force_t ((mx >>= f) >>= g)) (force_t (mx >>= (\x -> f x >>= g))) | ||
|
||
group "lazyt" [ | ||
group "LazyT m is monadic" [ | ||
test "left identity" <| left_identity 324 (\x -> wrap <| x + 89), | ||
test "right identity" <| right_identity "hello", | ||
test "associativity" <| associativity (Some 5) (\x -> wrap (x+5)) (\x -> wrap (x*2)), | ||
], | ||
let x = list.of [8,6,7,5,3,0,9] | ||
let f = (*) 42 | ||
test "LazyT m is lazy" <| \_ -> assert_eq (map f x) (force_t <| map f <| wrap_monad x), | ||
] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,45 @@ | ||
let { (<|) } = import! std.function | ||
let { Test, run, assert, assert_eq, test, group, ? } = import! std.test | ||
let { StateT, put, get, gets, modify, run_state_t, eval_state_t, exec_state_t, ? } = import! std.statet | ||
let { wrap, (*>) } = import! std.applicative | ||
let { Monad, (>>=) } = import! std.monad | ||
let { Option, unwrap, ? } = import! std.option | ||
let { (++), ? } = import! std.string | ||
let list @ { List, ? } = import! std.list | ||
let { Transformer, wrap_monad } = import! std.transformer | ||
|
||
#[infix(right,7)] | ||
let (::) x xs = Cons x xs | ||
|
||
let left_identity x f : [Eq a] -> [Show a] -> a -> (a -> StateT _ Option a) -> _ = \_ -> | ||
let mx : StateT _ Option _ = wrap x | ||
let s = () | ||
assert_eq (eval_state_t (mx >>= f) s) (eval_state_t (f x) s) | ||
|
||
let right_identity x : [Eq a] -> [Show a] -> a -> _ = \_ -> | ||
let mx : StateT _ Option _ = wrap x | ||
let s = () | ||
assert_eq (eval_state_t (mx >>= wrap) s) (eval_state_t mx s) | ||
|
||
let associativity ?mo mx f g : [Monad m] -> [Show (m a)] -> [Eq (m a)] -> m a -> _ -> _ -> _ = \_ -> | ||
let mx : StateT _ m _ = wrap_monad mx | ||
let s = () | ||
assert_eq (eval_state_t ((mx >>= f) >>= g) s) (eval_state_t (mx >>= (\x -> f x >>= g)) s) | ||
|
||
group "statet" [ | ||
// should this be moved to std.monad? | ||
group "StateT s m is monadic" [ | ||
test "left identity" <| left_identity 324 (\x -> wrap <| x + 89), | ||
test "right identity" <| right_identity "hello", | ||
test "associativity" <| associativity (Some 5) (\x -> wrap (x+5)) (\x -> wrap (x*2)), | ||
], | ||
group "StateT s m has state effects" [ | ||
test "modify exec_state_t" <| \_ -> (assert_eq (exec_state_t (modify (\x -> x + 2) *> modify (\x -> x * 4)) 0) <| Some 8), | ||
test "modify eval_state_t" <| \_ -> (assert_eq (eval_state_t (modify (\x -> x + 2) *> get) 0) <| Some 2), | ||
test "put get eval_state_t" <| \_ -> (assert_eq (eval_state_t (put "hello" *> get) "") <| Some "hello"), | ||
#[derive(Eq, Show)] | ||
type StateOut s a = { value : a, state : s } | ||
test "put get run_state_t" <| \_ -> (assert_eq (run_state_t (put "hello" *> get) "") <| Some {value = "hello", state = "hello"}), | ||
test "gets eval_state_t" <| \_ -> (assert_eq (eval_state_t (gets <| (::) 1) (2 :: 3 :: Nil)) <| Some (1 :: 2 :: 3 :: Nil)), | ||
], | ||
] |