[WIP] feat(std): add monad transformer interface, StateT, and LazyT

std/lazyt.glu

@@ -0,0 +1,36 @@
+//@NO-IMPLICIT-PRELUDE
+
+let { Applicative, apply, wrap } = import! std.applicative
+let { (<<) } = import! std.function
+let { Functor, map } = import! std.functor
+let { lazy, force } = import! std.lazy
+let { Monad, flat_map } = import! std.monad
+
+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 }
+
+{
+    LazyT,
+
+    lazy,
+    force,
+
+    functor,
+    applicative,
+    monad,
+}

std/statet.glu

@@ -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
+}

std/transformer.glu

@@ -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 }

tests/pass/statet.glu

@@ -0,0 +1,56 @@
+
+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 { Applicative, 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)),
+    ],
+    // TODO
+    // should this be moved to std.transformer?
+    // group "StateT s m has effects of monad m" [
+    //     test "Option", <| \_ -> (assert_eq 
+    //     test "List", <| \_ -> (assert_eq 
+    //     test "State String", <| \_ -> (assert_eq 
+    //     test "Writer", <| \_ -> (assert_eq 
+    //     test "Reader", <| \_ -> (assert_eq 
+    //     test "Result Int", <| \_ -> (assert_eq 
+    // ],
+]