| Safe Haskell | None |
|---|---|
| Language | GHC2021 |
Control.Monad.Indexed.Cont2
Description
This module defines a 2-continuation flavour of indexed monads. Having two
continuation allows unrestricted backtracking (hence the Additive instance
for Cont2W below).
Most of this module is focused on using the indexed continuation monads for
delimited control, hence adopts its terminology. For instance in `Cont2 w r
r'`, r and r' are called the input and output answer types respectively.
They are to be thought as a stack (a stack of `a -> b -> r` being a stack
whose two first elements are of type a and b).
Cont2W is an indexed monad because the answer type can change along the
computation. This is called answer-type modification in the delimited
control literature.
Synopsis
- class Stacked m => Shifty (m :: Type -> Type -> Type -> Type) where
- shift :: ((a -> r' -> r') -> r -> m r k k) -> m r r' a
- class Stacked (m :: Type -> Type -> Type -> Type) where
- shift_ :: ((r' -> r') -> r -> m r r'' r'') -> m r r' ()
- stack :: (Applicative m, Stacked m) => (i -> j -> i) -> (i -> j) -> m i j ()
- pop :: (Applicative m, Shifty m) => m (a -> i) i a
- pop_ :: (Applicative m, Stacked m) => m (a -> i) i ()
- push :: (Applicative m, Stacked m) => a -> m i (a -> i) ()
- (@) :: (Applicative m, Stacked m) => m (a -> i) j b -> a -> m i j b
- newtype Cont2W (w :: Type -> Type) r r' a = Cont2W {
- runCont2W :: w (a -> r' -> r') -> r -> r
- shift0 :: Comonad w => (w (a -> r' -> r') -> r -> Cont2W w r k k) -> Cont2W w r r' a
- yield :: Comonad w => (w (a -> r) -> r) -> Cont2W w r r a
- yield_ :: Comonad w => (w r -> r) -> Cont2W w r r ()
- some :: (Alternative m, Stacked m) => (forall r'. m (a -> r') r' b) -> m ([a] -> r) r [b]
- many :: (Alternative m, Stacked m) => (forall r'. m (a -> r') r' b) -> m ([a] -> r) r [b]
- optional :: (Alternative m, Stacked m) => (forall r'. m (a -> r') r' b) -> m (Maybe a -> r) r (Maybe b)
- sepBy :: (MonadPlus m, Stacked m) => (forall r'. m (a -> r') r' b) -> (forall r'. m r' r' ()) -> m ([a] -> r) r [b]
Abstract delimited control
class Stacked m => Shifty (m :: Type -> Type -> Type -> Type) where Source #
A type class abstracting over delimited control capability for this 2-continuation flavour of monads.
class Stacked (m :: Type -> Type -> Type -> Type) where Source #
Restricted delimited control where continuations can be captured but can't
return values. This is enough for most stack-manipulating functions (the
stack, however, cannot influence the control flow anymore). Compared to
Shifty it captures the additional case where the stack doesn't actually
exist at runtime (IgnoreIndices).
Instances
| Comonad w => Stacked (Cont2W w) Source # | |
| Applicative m => Stacked (IgnoreIndices m :: Type -> Type -> Type -> Type) Source # | |
Defined in Control.Monad.Indexed.Cont2 Methods shift_ :: ((r' -> r') -> r -> IgnoreIndices m r r'' r'') -> IgnoreIndices m r r' () Source # | |
| (Stacked f, Stacked g) => Stacked (f :*: g) Source # | |
stack :: (Applicative m, Stacked m) => (i -> j -> i) -> (i -> j) -> m i j () Source #
stack is a partial mapping operation on the stack.
In a first approximation it can be thought of as a function with type
:: (j -> i) -> m i j ()
The direction of the arrow is explained by the representation of stack types as function. A function with type
((d -> e -> r) -> (a -> b -> c -> r))
actually maps three elements a, b, c to two elements d, e.
The additional parameter of type i is a failure continuation. For instance
the following always fails to modify the stack:
stack (\fl _ -> fl)
Finally, the extra function of type (i -> j) is called an “unrolling
function” and is tasked with restoring the stack in its original state if a
later failure causes backtracking.
pop :: (Applicative m, Shifty m) => m (a -> i) i a Source #
pop_ :: (Applicative m, Stacked m) => m (a -> i) i () Source #
push :: (Applicative m, Stacked m) => a -> m i (a -> i) () Source #
(@) :: (Applicative m, Stacked m) => m (a -> i) j b -> a -> m i j b infixl 9 Source #
Comonad-to-indexed-monad transformer
newtype Cont2W (w :: Type -> Type) r r' a Source #
Instances
| Comonad w => Applicative (Cont2W w :: Type -> Type -> Type -> Type) Source # | |
Defined in Control.Monad.Indexed.Cont2 Methods pure :: a -> Cont2W w i i a Source # (<*>) :: Cont2W w i j (a -> b) -> Cont2W w j k1 a -> Cont2W w i k1 b Source # liftA2 :: (a -> b -> c) -> Cont2W w i j a -> Cont2W w j k1 b -> Cont2W w i k1 c Source # (*>) :: Cont2W w i j a -> Cont2W w j k1 b -> Cont2W w i k1 b Source # (<*) :: Cont2W w i j a -> Cont2W w j k1 b -> Cont2W w i k1 a Source # | |
| Comonad w => Monad (Cont2W w :: Type -> Type -> Type -> Type) Source # | |
| Comonad w => Shifty (Cont2W w) Source # | |
| Comonad w => Stacked (Cont2W w) Source # | |
| Comonad w => Alternative (Cont2W w r r) Source # | |
| Comonad w => Applicative (Cont2W w r r) Source # | |
Defined in Control.Monad.Indexed.Cont2 | |
| Functor w => Functor (Cont2W w r r') Source # | |
| Comonad w => Monad (Cont2W w r r) Source # | |
| Comonad w => MonadPlus (Cont2W w r r) Source # | |
| Additive (Cont2W w r r' a) Source # | |
shift0 :: Comonad w => (w (a -> r' -> r') -> r -> Cont2W w r k k) -> Cont2W w r r' a Source #
shift0 is the most general delimited control operation on Cont2W.
About the name
It's named by analogy with the eponymous delimited control operation from the
delimited control literature (see A Dynamic Interpretation of the CPS
Hierarchy).
The traditional shift0 captures all the continuations introduced by nested
resets; here we think of the comonad w as carrying the information of
additional resets.
Bidirectional variants of traditional combinators
some :: (Alternative m, Stacked m) => (forall r'. m (a -> r') r' b) -> m ([a] -> r) r [b] Source #
many :: (Alternative m, Stacked m) => (forall r'. m (a -> r') r' b) -> m ([a] -> r) r [b] Source #