Skip to content

Commit

Permalink
Merge #686
Browse files Browse the repository at this point in the history
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
3 people committed May 4, 2019
2 parents ca8528c + 8d3d53c commit 84f6cf8
Show file tree
Hide file tree
Showing 5 changed files with 230 additions and 0 deletions.
44 changes: 44 additions & 0 deletions std/lazyt.glu
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
}
93 changes: 93 additions & 0 deletions std/statet.glu
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
}
14 changes: 14 additions & 0 deletions std/transformer.glu
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 }
34 changes: 34 additions & 0 deletions tests/pass/lazyt.glu
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),
]
45 changes: 45 additions & 0 deletions tests/pass/statet.glu
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)),
],
]

0 comments on commit 84f6cf8

Please sign in to comment.