Изменения

class (Functor f) => Applicative f where pure :: a -> f a

data Identity a = Identity { a runIdentity :: a }= a instance Monad Identity where return x = Identity x (Identity x) >>= f = f x

class MonadFish m where returnFish :: a -> m a (>=>) :: (a -> m b) -> (b -> m c) -> (a -> m c) data State s r = State (s -> (r, s)) runState (State f) s = f s instance Monad (State s) where return r = State (\s -> (r, s)) (State x) >>= f = State h where h s0 = let (r1, s1) = x s0 State g = f r1 (r2, s2) = g s1 in (r2, s2) newtype IdentityCPS a = IdentityCPS {runIdentityCPS :: forall r . (a -> r) -> r} caseIdentityCPS :: IdentityCPS a -> (a -> r) -> r caseIdentityCPS = \x -> \f -> runIdentityCPS x f constrIdentityCPS :: a -> IdentityCPS a constrIdentityCPS = \a -> IdentityCPS $ \f -> f a instance Functor IdentityCPS where fmap f ma = IdentityCPS $ \g -> caseIdentityCPS ma (\a -> g (f a)) instance Applicative IdentityCPS where pure = constrIdentityCPS mf <*> ma = IdentityCPS $ \g -> caseIdentityCPS ma (\a -> caseIdentityCPS mf (\f -> g (f a ))) instance Monad IdentityCPS where return = constrIdentityCPS ma >>= f = IdentityCPS $ \g -> caseIdentityCPS ma (\a -> runIdentityCPS (f a) g) newtype MaybeCPS r a = MaybeCPS {runMaybeCPS :: (a -> r) -> r -> r} caseMaybeCPS :: MaybeCPS r a -> (a -> r) -> r -> r caseMaybeCPS = \x -> \f -> \g -> runMaybeCPS x f g justCPS :: a -> MaybeCPS r a justCPS a = MaybeCPS $ \f -> \g -> f a nothing :: MaybeCPS r a nothing = MaybeCPS $ \f -> \g -> g instance Functor (MaybeCPS r) where fmap f ma = MaybeCPS $ \g -> \h -> caseMaybeCPS ma (\a -> g (f a)) h instance Applicative (MaybeCPS r) where pure = justCPS mf <*> ma = MaybeCPS $ \g -> \h -> caseMaybeCPS ma (\a -> caseMaybeCPS mf (\f -> g $ f a) h) h

instance Monad State(MaybeCPS r) where return = justCPS ma >>= f = MaybeCPS $ \g -> \h -> caseMaybeCPS ma (\a -> runMaybeCPS (f a) g h) h

newtype CpsIdentityStateCPS s a = StateCPS {runStateCPS :: forall r . s -> (s -> a -> r) -> r}

instance Monad CpsIdentitycaseStateCPS :: (StateCPS s a) -> ((s -> (s, a)) -> r) -> r caseStateCPS = \x -> \f -> f $ \s -> runStateCPS x s (\s -> \a -> (s, a))

newtype CpsMaybestate' :: (s -> (s, a)) -> StateCPS s a state' st = StateCPS $ \s -> \f -> let (s', a) = st s in f s' a

instance Monad CpsMaybeFunctor (StateCPS s) where fmap f sa = StateCPS $ \s -> \g -> caseStateCPS sa (\st -> let (s', a) = st s in g s' (f a))

newtype CpsStateinstance Applicative (StateCPS s) where pure a = state' $ \s -> (s, a) sf <*> sa = StateCPS $ \s -> \g -> caseStateCPS sf (\stf -> let (s', f) = stf s in caseStateCPS sa (\sta -> let (s'', a) = sta s' in g s'' (f a)))

instance Monad CpsState(StateCPS s) where return a = state' $ \s -> (s, a) sa >>= f = StateCPS $ \s -> \g -> caseStateCPS sa (\sta -> let (s', a) = sta s in runStateCPS (f a) s' g)