{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Internal.Cont where

import Data.Coerce

import Control.Monad.Trans
import Control.Monad.Base
import qualified Control.Monad.Fail as Fail

import Control.Effect
import Control.Effect.Carrier

import Control.Effect.Internal.Utils

import qualified Control.Monad.Trans.Cont as C
import Control.Monad.Trans.Free.Church.Alternate

-- | An effect for abortive continuations.
newtype Cont m a where
  CallCC :: ((forall b. a -> m b) -> m a) -> Cont m a

-- | An effect for non-abortive continuations of a program
-- that eventually produces a result of type @r@.
--
-- This isn't quite as powerful as proper delimited continuations,
-- as this doesn't provide any equivalent of the @reset@ operator.
--
-- This can be useful as a helper effect.
newtype Shift r m a where
  Shift :: ((a -> m r) -> m r) -> Shift r m a

data ContBase r a where
  Exit    :: r -> ContBase r a
  GetCont :: ContBase r (Either (a -> r) a)


newtype ContC r m a = ContC { ContC r m a -> FreeT (ContBase (m r)) m a
unContC :: FreeT (ContBase (m r)) m a }
  deriving ( a -> ContC r m b -> ContC r m a
(a -> b) -> ContC r m a -> ContC r m b
(forall a b. (a -> b) -> ContC r m a -> ContC r m b)
-> (forall a b. a -> ContC r m b -> ContC r m a)
-> Functor (ContC r m)
forall a b. a -> ContC r m b -> ContC r m a
forall a b. (a -> b) -> ContC r m a -> ContC r m b
forall r (m :: * -> *) a b. a -> ContC r m b -> ContC r m a
forall r (m :: * -> *) a b. (a -> b) -> ContC r m a -> ContC r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ContC r m b -> ContC r m a
$c<$ :: forall r (m :: * -> *) a b. a -> ContC r m b -> ContC r m a
fmap :: (a -> b) -> ContC r m a -> ContC r m b
$cfmap :: forall r (m :: * -> *) a b. (a -> b) -> ContC r m a -> ContC r m b
Functor, Functor (ContC r m)
a -> ContC r m a
Functor (ContC r m)
-> (forall a. a -> ContC r m a)
-> (forall a b. ContC r m (a -> b) -> ContC r m a -> ContC r m b)
-> (forall a b c.
    (a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c)
-> (forall a b. ContC r m a -> ContC r m b -> ContC r m b)
-> (forall a b. ContC r m a -> ContC r m b -> ContC r m a)
-> Applicative (ContC r m)
ContC r m a -> ContC r m b -> ContC r m b
ContC r m a -> ContC r m b -> ContC r m a
ContC r m (a -> b) -> ContC r m a -> ContC r m b
(a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c
forall a. a -> ContC r m a
forall a b. ContC r m a -> ContC r m b -> ContC r m a
forall a b. ContC r m a -> ContC r m b -> ContC r m b
forall a b. ContC r m (a -> b) -> ContC r m a -> ContC r m b
forall a b c.
(a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c
forall r (m :: * -> *). Functor (ContC r m)
forall r (m :: * -> *) a. a -> ContC r m a
forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m a
forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m b
forall r (m :: * -> *) a b.
ContC r m (a -> b) -> ContC r m a -> ContC r m b
forall r (m :: * -> *) a b c.
(a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ContC r m a -> ContC r m b -> ContC r m a
$c<* :: forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m a
*> :: ContC r m a -> ContC r m b -> ContC r m b
$c*> :: forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m b
liftA2 :: (a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c
$cliftA2 :: forall r (m :: * -> *) a b c.
(a -> b -> c) -> ContC r m a -> ContC r m b -> ContC r m c
<*> :: ContC r m (a -> b) -> ContC r m a -> ContC r m b
$c<*> :: forall r (m :: * -> *) a b.
ContC r m (a -> b) -> ContC r m a -> ContC r m b
pure :: a -> ContC r m a
$cpure :: forall r (m :: * -> *) a. a -> ContC r m a
$cp1Applicative :: forall r (m :: * -> *). Functor (ContC r m)
Applicative, Applicative (ContC r m)
a -> ContC r m a
Applicative (ContC r m)
-> (forall a b. ContC r m a -> (a -> ContC r m b) -> ContC r m b)
-> (forall a b. ContC r m a -> ContC r m b -> ContC r m b)
-> (forall a. a -> ContC r m a)
-> Monad (ContC r m)
ContC r m a -> (a -> ContC r m b) -> ContC r m b
ContC r m a -> ContC r m b -> ContC r m b
forall a. a -> ContC r m a
forall a b. ContC r m a -> ContC r m b -> ContC r m b
forall a b. ContC r m a -> (a -> ContC r m b) -> ContC r m b
forall r (m :: * -> *). Applicative (ContC r m)
forall r (m :: * -> *) a. a -> ContC r m a
forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m b
forall r (m :: * -> *) a b.
ContC r m a -> (a -> ContC r m b) -> ContC r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ContC r m a
$creturn :: forall r (m :: * -> *) a. a -> ContC r m a
>> :: ContC r m a -> ContC r m b -> ContC r m b
$c>> :: forall r (m :: * -> *) a b.
ContC r m a -> ContC r m b -> ContC r m b
>>= :: ContC r m a -> (a -> ContC r m b) -> ContC r m b
$c>>= :: forall r (m :: * -> *) a b.
ContC r m a -> (a -> ContC r m b) -> ContC r m b
$cp1Monad :: forall r (m :: * -> *). Applicative (ContC r m)
Monad
           , MonadBase b, Monad (ContC r m)
Monad (ContC r m)
-> (forall a. String -> ContC r m a) -> MonadFail (ContC r m)
String -> ContC r m a
forall a. String -> ContC r m a
forall r (m :: * -> *). MonadFail m => Monad (ContC r m)
forall r (m :: * -> *) a. MonadFail m => String -> ContC r m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ContC r m a
$cfail :: forall r (m :: * -> *) a. MonadFail m => String -> ContC r m a
$cp1MonadFail :: forall r (m :: * -> *). MonadFail m => Monad (ContC r m)
Fail.MonadFail, Monad (ContC r m)
Monad (ContC r m)
-> (forall a. IO a -> ContC r m a) -> MonadIO (ContC r m)
IO a -> ContC r m a
forall a. IO a -> ContC r m a
forall r (m :: * -> *). MonadIO m => Monad (ContC r m)
forall r (m :: * -> *) a. MonadIO m => IO a -> ContC r m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ContC r m a
$cliftIO :: forall r (m :: * -> *) a. MonadIO m => IO a -> ContC r m a
$cp1MonadIO :: forall r (m :: * -> *). MonadIO m => Monad (ContC r m)
MonadIO
           , Monad (ContC r m)
e -> ContC r m a
Monad (ContC r m)
-> (forall e a. Exception e => e -> ContC r m a)
-> MonadThrow (ContC r m)
forall e a. Exception e => e -> ContC r m a
forall r (m :: * -> *). MonadThrow m => Monad (ContC r m)
forall r (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ContC r m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ContC r m a
$cthrowM :: forall r (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ContC r m a
$cp1MonadThrow :: forall r (m :: * -> *). MonadThrow m => Monad (ContC r m)
MonadThrow, MonadThrow (ContC r m)
MonadThrow (ContC r m)
-> (forall e a.
    Exception e =>
    ContC r m a -> (e -> ContC r m a) -> ContC r m a)
-> MonadCatch (ContC r m)
ContC r m a -> (e -> ContC r m a) -> ContC r m a
forall e a.
Exception e =>
ContC r m a -> (e -> ContC r m a) -> ContC r m a
forall r (m :: * -> *). MonadCatch m => MonadThrow (ContC r m)
forall r (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ContC r m a -> (e -> ContC r m a) -> ContC r m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ContC r m a -> (e -> ContC r m a) -> ContC r m a
$ccatch :: forall r (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ContC r m a -> (e -> ContC r m a) -> ContC r m a
$cp1MonadCatch :: forall r (m :: * -> *). MonadCatch m => MonadThrow (ContC r m)
MonadCatch
           )

instance MonadTrans (ContC s) where
  lift :: m a -> ContC s m a
lift = FreeT (ContBase (m s)) m a -> ContC s m a
forall r (m :: * -> *) a. FreeT (ContBase (m r)) m a -> ContC r m a
ContC (FreeT (ContBase (m s)) m a -> ContC s m a)
-> (m a -> FreeT (ContBase (m s)) m a) -> m a -> ContC s m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. m a -> FreeT (ContBase (m s)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINE lift #-}

instance ( Carrier m
         , Threads (FreeT (ContBase (m r))) (Prims m)
         )
      => Carrier (ContC r m) where
  type Derivs (ContC r m) = Cont ': Derivs m
  type Prims  (ContC r m) = Prims m

  algPrims :: Algebra' (Prims (ContC r m)) (ContC r m) a
algPrims = (Union (Prims m) (FreeT (ContBase (m r)) m) a
 -> FreeT (ContBase (m r)) m a)
-> Algebra' (Prims m) (ContC r m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (FreeT (ContBase (m r)) m)
forall (t :: (* -> *) -> * -> *) (p :: [(* -> *) -> * -> *])
       (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(FreeT (ContBase (m r))) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (ContC r m)) (Prims (ContC r m)) (ContC r m) z a
reformulate forall x. ContC r m x -> z x
n Algebra (Prims (ContC r m)) z
alg = Algebra' (Derivs m) z a
-> (Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ContC r m x -> z x
forall x. ContC r m x -> z x
n (ContC r m x -> z x) -> (m x -> ContC r m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> ContC r m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ContC r m)) z
alg) ((Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a)
-> (Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
    CallCC (forall b. a -> z b) -> z a
main -> ContC r m (Either (a -> m r) a) -> z (Either (a -> m r) a)
forall x. ContC r m x -> z x
n (FreeT (ContBase (m r)) m (Either (a -> m r) a)
-> ContC r m (Either (a -> m r) a)
forall r (m :: * -> *) a. FreeT (ContBase (m r)) m a -> ContC r m a
ContC (FreeT (ContBase (m r)) m (Either (a -> m r) a)
 -> ContC r m (Either (a -> m r) a))
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
-> ContC r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ContBase (m r) (Either (a -> m r) a)
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF (ContBase (m r) (Either (a -> m r) a)
 -> FreeT (ContBase (m r)) m (Either (a -> m r) a))
-> ContBase (m r) (Either (a -> m r) a)
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ContBase (m r) (Either (a -> m r) a)
forall r a. ContBase r (Either (a -> r) a)
GetCont) z (Either (a -> m r) a) -> (Either (a -> m r) a -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left a -> m r
c  -> (forall b. a -> z b) -> z a
main (ContC r m b -> z b
forall x. ContC r m x -> z x
n (ContC r m b -> z b) -> (a -> ContC r m b) -> a -> z b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeT (ContBase (m r)) m b -> ContC r m b
forall r (m :: * -> *) a. FreeT (ContBase (m r)) m a -> ContC r m a
ContC (FreeT (ContBase (m r)) m b -> ContC r m b)
-> (a -> FreeT (ContBase (m r)) m b) -> a -> ContC r m b
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. ContBase (m r) b -> FreeT (ContBase (m r)) m b
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF (ContBase (m r) b -> FreeT (ContBase (m r)) m b)
-> (a -> ContBase (m r) b) -> a -> FreeT (ContBase (m r)) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m r -> ContBase (m r) b
forall r a. r -> ContBase r a
Exit (m r -> ContBase (m r) b) -> (a -> m r) -> a -> ContBase (m r) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m r
c)
      Right a
a -> a -> z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  {-# INLINEABLE reformulate #-}


newtype ContFastC (r :: *) m a = ContFastC { ContFastC r m a -> ContT r m a
unContFastC :: C.ContT r m a }
  deriving (a -> ContFastC r m b -> ContFastC r m a
(a -> b) -> ContFastC r m a -> ContFastC r m b
(forall a b. (a -> b) -> ContFastC r m a -> ContFastC r m b)
-> (forall a b. a -> ContFastC r m b -> ContFastC r m a)
-> Functor (ContFastC r m)
forall a b. a -> ContFastC r m b -> ContFastC r m a
forall a b. (a -> b) -> ContFastC r m a -> ContFastC r m b
forall r (m :: * -> *) a b. a -> ContFastC r m b -> ContFastC r m a
forall r (m :: * -> *) a b.
(a -> b) -> ContFastC r m a -> ContFastC r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ContFastC r m b -> ContFastC r m a
$c<$ :: forall r (m :: * -> *) a b. a -> ContFastC r m b -> ContFastC r m a
fmap :: (a -> b) -> ContFastC r m a -> ContFastC r m b
$cfmap :: forall r (m :: * -> *) a b.
(a -> b) -> ContFastC r m a -> ContFastC r m b
Functor, Functor (ContFastC r m)
a -> ContFastC r m a
Functor (ContFastC r m)
-> (forall a. a -> ContFastC r m a)
-> (forall a b.
    ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b)
-> (forall a b c.
    (a -> b -> c)
    -> ContFastC r m a -> ContFastC r m b -> ContFastC r m c)
-> (forall a b.
    ContFastC r m a -> ContFastC r m b -> ContFastC r m b)
-> (forall a b.
    ContFastC r m a -> ContFastC r m b -> ContFastC r m a)
-> Applicative (ContFastC r m)
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
ContFastC r m a -> ContFastC r m b -> ContFastC r m a
ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b
(a -> b -> c)
-> ContFastC r m a -> ContFastC r m b -> ContFastC r m c
forall a. a -> ContFastC r m a
forall a b. ContFastC r m a -> ContFastC r m b -> ContFastC r m a
forall a b. ContFastC r m a -> ContFastC r m b -> ContFastC r m b
forall a b.
ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b
forall a b c.
(a -> b -> c)
-> ContFastC r m a -> ContFastC r m b -> ContFastC r m c
forall r (m :: * -> *). Functor (ContFastC r m)
forall r (m :: * -> *) a. a -> ContFastC r m a
forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m a
forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
forall r (m :: * -> *) a b.
ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b
forall r (m :: * -> *) a b c.
(a -> b -> c)
-> ContFastC r m a -> ContFastC r m b -> ContFastC r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ContFastC r m a -> ContFastC r m b -> ContFastC r m a
$c<* :: forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m a
*> :: ContFastC r m a -> ContFastC r m b -> ContFastC r m b
$c*> :: forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
liftA2 :: (a -> b -> c)
-> ContFastC r m a -> ContFastC r m b -> ContFastC r m c
$cliftA2 :: forall r (m :: * -> *) a b c.
(a -> b -> c)
-> ContFastC r m a -> ContFastC r m b -> ContFastC r m c
<*> :: ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b
$c<*> :: forall r (m :: * -> *) a b.
ContFastC r m (a -> b) -> ContFastC r m a -> ContFastC r m b
pure :: a -> ContFastC r m a
$cpure :: forall r (m :: * -> *) a. a -> ContFastC r m a
$cp1Applicative :: forall r (m :: * -> *). Functor (ContFastC r m)
Applicative, Applicative (ContFastC r m)
a -> ContFastC r m a
Applicative (ContFastC r m)
-> (forall a b.
    ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b)
-> (forall a b.
    ContFastC r m a -> ContFastC r m b -> ContFastC r m b)
-> (forall a. a -> ContFastC r m a)
-> Monad (ContFastC r m)
ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
forall a. a -> ContFastC r m a
forall a b. ContFastC r m a -> ContFastC r m b -> ContFastC r m b
forall a b.
ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b
forall r (m :: * -> *). Applicative (ContFastC r m)
forall r (m :: * -> *) a. a -> ContFastC r m a
forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
forall r (m :: * -> *) a b.
ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ContFastC r m a
$creturn :: forall r (m :: * -> *) a. a -> ContFastC r m a
>> :: ContFastC r m a -> ContFastC r m b -> ContFastC r m b
$c>> :: forall r (m :: * -> *) a b.
ContFastC r m a -> ContFastC r m b -> ContFastC r m b
>>= :: ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b
$c>>= :: forall r (m :: * -> *) a b.
ContFastC r m a -> (a -> ContFastC r m b) -> ContFastC r m b
$cp1Monad :: forall r (m :: * -> *). Applicative (ContFastC r m)
Monad, MonadBase b, Monad (ContFastC r m)
Monad (ContFastC r m)
-> (forall a. IO a -> ContFastC r m a) -> MonadIO (ContFastC r m)
IO a -> ContFastC r m a
forall a. IO a -> ContFastC r m a
forall r (m :: * -> *). MonadIO m => Monad (ContFastC r m)
forall r (m :: * -> *) a. MonadIO m => IO a -> ContFastC r m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ContFastC r m a
$cliftIO :: forall r (m :: * -> *) a. MonadIO m => IO a -> ContFastC r m a
$cp1MonadIO :: forall r (m :: * -> *). MonadIO m => Monad (ContFastC r m)
MonadIO, Monad (ContFastC r m)
Monad (ContFastC r m)
-> (forall a. String -> ContFastC r m a)
-> MonadFail (ContFastC r m)
String -> ContFastC r m a
forall a. String -> ContFastC r m a
forall r (m :: * -> *). MonadFail m => Monad (ContFastC r m)
forall r (m :: * -> *) a. MonadFail m => String -> ContFastC r m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ContFastC r m a
$cfail :: forall r (m :: * -> *) a. MonadFail m => String -> ContFastC r m a
$cp1MonadFail :: forall r (m :: * -> *). MonadFail m => Monad (ContFastC r m)
Fail.MonadFail)
  deriving m a -> ContFastC r m a
(forall (m :: * -> *) a. Monad m => m a -> ContFastC r m a)
-> MonadTrans (ContFastC r)
forall r (m :: * -> *) a. Monad m => m a -> ContFastC r m a
forall (m :: * -> *) a. Monad m => m a -> ContFastC r m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ContFastC r m a
$clift :: forall r (m :: * -> *) a. Monad m => m a -> ContFastC r m a
MonadTrans

instance ( Carrier m
         , Threads (C.ContT r) (Prims m)
         )
      => Carrier (ContFastC r m) where
  type Derivs (ContFastC r m) = Cont ': Derivs m
  type Prims  (ContFastC r m) = Prims m

  algPrims :: Algebra' (Prims (ContFastC r m)) (ContFastC r m) a
algPrims = (Union (Prims m) (ContT r m) a -> ContT r m a)
-> Algebra' (Prims m) (ContFastC r m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (ContT r m)
forall (t :: (* -> *) -> * -> *) (p :: [(* -> *) -> * -> *])
       (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(C.ContT r) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (ContFastC r m))
  (Prims (ContFastC r m))
  (ContFastC r m)
  z
  a
reformulate forall x. ContFastC r m x -> z x
n Algebra (Prims (ContFastC r m)) z
alg = Algebra' (Derivs m) z a
-> (Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ContFastC r m x -> z x
forall x. ContFastC r m x -> z x
n (ContFastC r m x -> z x) -> (m x -> ContFastC r m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> ContFastC r m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ContFastC r m)) z
alg) ((Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a)
-> (Cont z a -> z a) -> Algebra' (Cont : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
    CallCC (forall b. a -> z b) -> z a
main ->
      ContFastC r m (Either (a -> m r) a) -> z (Either (a -> m r) a)
forall x. ContFastC r m x -> z x
n (ContT r m (Either (a -> m r) a)
-> ContFastC r m (Either (a -> m r) a)
forall r (m :: * -> *) a. ContT r m a -> ContFastC r m a
ContFastC (ContT r m (Either (a -> m r) a)
 -> ContFastC r m (Either (a -> m r) a))
-> ContT r m (Either (a -> m r) a)
-> ContFastC r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ((Either (a -> m r) a -> m r) -> m r)
-> ContT r m (Either (a -> m r) a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
C.ContT (((Either (a -> m r) a -> m r) -> m r)
 -> ContT r m (Either (a -> m r) a))
-> ((Either (a -> m r) a -> m r) -> m r)
-> ContT r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ \Either (a -> m r) a -> m r
c -> Either (a -> m r) a -> m r
c ((a -> m r) -> Either (a -> m r) a
forall a b. a -> Either a b
Left (Either (a -> m r) a -> m r
c (Either (a -> m r) a -> m r)
-> (a -> Either (a -> m r) a) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (a -> m r) a
forall a b. b -> Either a b
Right))) z (Either (a -> m r) a) -> (Either (a -> m r) a -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left a -> m r
c  -> (forall b. a -> z b) -> z a
main (\a
a -> ContFastC r m b -> z b
forall x. ContFastC r m x -> z x
n (ContFastC r m b -> z b) -> ContFastC r m b -> z b
forall a b. (a -> b) -> a -> b
$ ContT r m b -> ContFastC r m b
forall r (m :: * -> *) a. ContT r m a -> ContFastC r m a
ContFastC (ContT r m b -> ContFastC r m b) -> ContT r m b -> ContFastC r m b
forall a b. (a -> b) -> a -> b
$ ((b -> m r) -> m r) -> ContT r m b
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
C.ContT (((b -> m r) -> m r) -> ContT r m b)
-> ((b -> m r) -> m r) -> ContT r m b
forall a b. (a -> b) -> a -> b
$ \b -> m r
_ -> a -> m r
c a
a)
        Right a
a -> a -> z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  {-# INLINEABLE reformulate #-}

newtype ShiftC r m a = ShiftC { ShiftC r m a -> FreeT (ContBase (m r)) m a
unShiftC :: FreeT (ContBase (m r)) m a }
  deriving ( a -> ShiftC r m b -> ShiftC r m a
(a -> b) -> ShiftC r m a -> ShiftC r m b
(forall a b. (a -> b) -> ShiftC r m a -> ShiftC r m b)
-> (forall a b. a -> ShiftC r m b -> ShiftC r m a)
-> Functor (ShiftC r m)
forall a b. a -> ShiftC r m b -> ShiftC r m a
forall a b. (a -> b) -> ShiftC r m a -> ShiftC r m b
forall r (m :: * -> *) a b. a -> ShiftC r m b -> ShiftC r m a
forall r (m :: * -> *) a b.
(a -> b) -> ShiftC r m a -> ShiftC r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ShiftC r m b -> ShiftC r m a
$c<$ :: forall r (m :: * -> *) a b. a -> ShiftC r m b -> ShiftC r m a
fmap :: (a -> b) -> ShiftC r m a -> ShiftC r m b
$cfmap :: forall r (m :: * -> *) a b.
(a -> b) -> ShiftC r m a -> ShiftC r m b
Functor, Functor (ShiftC r m)
a -> ShiftC r m a
Functor (ShiftC r m)
-> (forall a. a -> ShiftC r m a)
-> (forall a b.
    ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b)
-> (forall a b c.
    (a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c)
-> (forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m b)
-> (forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m a)
-> Applicative (ShiftC r m)
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
ShiftC r m a -> ShiftC r m b -> ShiftC r m a
ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b
(a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c
forall a. a -> ShiftC r m a
forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m a
forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m b
forall a b. ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b
forall a b c.
(a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c
forall r (m :: * -> *). Functor (ShiftC r m)
forall r (m :: * -> *) a. a -> ShiftC r m a
forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m a
forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
forall r (m :: * -> *) a b.
ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b
forall r (m :: * -> *) a b c.
(a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ShiftC r m a -> ShiftC r m b -> ShiftC r m a
$c<* :: forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m a
*> :: ShiftC r m a -> ShiftC r m b -> ShiftC r m b
$c*> :: forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
liftA2 :: (a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c
$cliftA2 :: forall r (m :: * -> *) a b c.
(a -> b -> c) -> ShiftC r m a -> ShiftC r m b -> ShiftC r m c
<*> :: ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b
$c<*> :: forall r (m :: * -> *) a b.
ShiftC r m (a -> b) -> ShiftC r m a -> ShiftC r m b
pure :: a -> ShiftC r m a
$cpure :: forall r (m :: * -> *) a. a -> ShiftC r m a
$cp1Applicative :: forall r (m :: * -> *). Functor (ShiftC r m)
Applicative, Applicative (ShiftC r m)
a -> ShiftC r m a
Applicative (ShiftC r m)
-> (forall a b.
    ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b)
-> (forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m b)
-> (forall a. a -> ShiftC r m a)
-> Monad (ShiftC r m)
ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
forall a. a -> ShiftC r m a
forall a b. ShiftC r m a -> ShiftC r m b -> ShiftC r m b
forall a b. ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b
forall r (m :: * -> *). Applicative (ShiftC r m)
forall r (m :: * -> *) a. a -> ShiftC r m a
forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
forall r (m :: * -> *) a b.
ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ShiftC r m a
$creturn :: forall r (m :: * -> *) a. a -> ShiftC r m a
>> :: ShiftC r m a -> ShiftC r m b -> ShiftC r m b
$c>> :: forall r (m :: * -> *) a b.
ShiftC r m a -> ShiftC r m b -> ShiftC r m b
>>= :: ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b
$c>>= :: forall r (m :: * -> *) a b.
ShiftC r m a -> (a -> ShiftC r m b) -> ShiftC r m b
$cp1Monad :: forall r (m :: * -> *). Applicative (ShiftC r m)
Monad
           , MonadBase b, Monad (ShiftC r m)
Monad (ShiftC r m)
-> (forall a. String -> ShiftC r m a) -> MonadFail (ShiftC r m)
String -> ShiftC r m a
forall a. String -> ShiftC r m a
forall r (m :: * -> *). MonadFail m => Monad (ShiftC r m)
forall r (m :: * -> *) a. MonadFail m => String -> ShiftC r m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ShiftC r m a
$cfail :: forall r (m :: * -> *) a. MonadFail m => String -> ShiftC r m a
$cp1MonadFail :: forall r (m :: * -> *). MonadFail m => Monad (ShiftC r m)
Fail.MonadFail, Monad (ShiftC r m)
Monad (ShiftC r m)
-> (forall a. IO a -> ShiftC r m a) -> MonadIO (ShiftC r m)
IO a -> ShiftC r m a
forall a. IO a -> ShiftC r m a
forall r (m :: * -> *). MonadIO m => Monad (ShiftC r m)
forall r (m :: * -> *) a. MonadIO m => IO a -> ShiftC r m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ShiftC r m a
$cliftIO :: forall r (m :: * -> *) a. MonadIO m => IO a -> ShiftC r m a
$cp1MonadIO :: forall r (m :: * -> *). MonadIO m => Monad (ShiftC r m)
MonadIO
           , Monad (ShiftC r m)
e -> ShiftC r m a
Monad (ShiftC r m)
-> (forall e a. Exception e => e -> ShiftC r m a)
-> MonadThrow (ShiftC r m)
forall e a. Exception e => e -> ShiftC r m a
forall r (m :: * -> *). MonadThrow m => Monad (ShiftC r m)
forall r (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ShiftC r m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ShiftC r m a
$cthrowM :: forall r (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ShiftC r m a
$cp1MonadThrow :: forall r (m :: * -> *). MonadThrow m => Monad (ShiftC r m)
MonadThrow, MonadThrow (ShiftC r m)
MonadThrow (ShiftC r m)
-> (forall e a.
    Exception e =>
    ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a)
-> MonadCatch (ShiftC r m)
ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a
forall e a.
Exception e =>
ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a
forall r (m :: * -> *). MonadCatch m => MonadThrow (ShiftC r m)
forall r (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a
$ccatch :: forall r (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ShiftC r m a -> (e -> ShiftC r m a) -> ShiftC r m a
$cp1MonadCatch :: forall r (m :: * -> *). MonadCatch m => MonadThrow (ShiftC r m)
MonadCatch
           )

instance MonadTrans (ShiftC s) where
  lift :: m a -> ShiftC s m a
lift = FreeT (ContBase (m s)) m a -> ShiftC s m a
forall r (m :: * -> *) a.
FreeT (ContBase (m r)) m a -> ShiftC r m a
ShiftC (FreeT (ContBase (m s)) m a -> ShiftC s m a)
-> (m a -> FreeT (ContBase (m s)) m a) -> m a -> ShiftC s m a
forall c b a. Coercible c b => (b -> c) -> (a -> b) -> a -> c
#. m a -> FreeT (ContBase (m s)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
  {-# INLINE lift #-}

instance ( Carrier m
         , Threads (FreeT (ContBase (m r))) (Prims m)
         )
      => Carrier (ShiftC r m) where
  type Derivs (ShiftC r m) = Shift r ': Derivs m
  type Prims  (ShiftC r m) = Prims m

  algPrims :: Algebra' (Prims (ShiftC r m)) (ShiftC r m) a
algPrims = (Union (Prims m) (FreeT (ContBase (m r)) m) a
 -> FreeT (ContBase (m r)) m a)
-> Algebra' (Prims m) (ShiftC r m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (FreeT (ContBase (m r)) m)
forall (t :: (* -> *) -> * -> *) (p :: [(* -> *) -> * -> *])
       (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(FreeT (ContBase (m r))) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (ShiftC r m)) (Prims (ShiftC r m)) (ShiftC r m) z a
reformulate forall x. ShiftC r m x -> z x
n Algebra (Prims (ShiftC r m)) z
alg = Algebra' (Derivs m) z a
-> (Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ShiftC r m x -> z x
forall x. ShiftC r m x -> z x
n (ShiftC r m x -> z x) -> (m x -> ShiftC r m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> ShiftC r m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ShiftC r m)) z
alg) ((Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a)
-> (Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
    Shift (a -> z r) -> z r
main -> ShiftC r m (Either (a -> m r) a) -> z (Either (a -> m r) a)
forall x. ShiftC r m x -> z x
n (FreeT (ContBase (m r)) m (Either (a -> m r) a)
-> ShiftC r m (Either (a -> m r) a)
forall r (m :: * -> *) a.
FreeT (ContBase (m r)) m a -> ShiftC r m a
ShiftC (FreeT (ContBase (m r)) m (Either (a -> m r) a)
 -> ShiftC r m (Either (a -> m r) a))
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
-> ShiftC r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ContBase (m r) (Either (a -> m r) a)
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF (ContBase (m r) (Either (a -> m r) a)
 -> FreeT (ContBase (m r)) m (Either (a -> m r) a))
-> ContBase (m r) (Either (a -> m r) a)
-> FreeT (ContBase (m r)) m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ContBase (m r) (Either (a -> m r) a)
forall r a. ContBase r (Either (a -> r) a)
GetCont) z (Either (a -> m r) a) -> (Either (a -> m r) a -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left a -> m r
c  -> (a -> z r) -> z r
main (ShiftC r m r -> z r
forall x. ShiftC r m x -> z x
n (ShiftC r m r -> z r) -> (a -> ShiftC r m r) -> a -> z r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m r -> ShiftC r m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> ShiftC r m r) -> (a -> m r) -> a -> ShiftC r m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m r
c) z r -> (r -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r
r ->
        ShiftC r m a -> z a
forall x. ShiftC r m x -> z x
n (FreeT (ContBase (m r)) m a -> ShiftC r m a
forall r (m :: * -> *) a.
FreeT (ContBase (m r)) m a -> ShiftC r m a
ShiftC (FreeT (ContBase (m r)) m a -> ShiftC r m a)
-> FreeT (ContBase (m r)) m a -> ShiftC r m a
forall a b. (a -> b) -> a -> b
$ ContBase (m r) a -> FreeT (ContBase (m r)) m a
forall (f :: * -> *) a (m :: * -> *). f a -> FreeT f m a
liftF (ContBase (m r) a -> FreeT (ContBase (m r)) m a)
-> ContBase (m r) a -> FreeT (ContBase (m r)) m a
forall a b. (a -> b) -> a -> b
$ m r -> ContBase (m r) a
forall r a. r -> ContBase r a
Exit (r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r))
      Right a
a -> a -> z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  {-# INLINEABLE reformulate #-}

instance ( Carrier m
         , Threads (C.ContT r) (Prims m)
         )
      => Carrier (ShiftFastC r m) where
  type Derivs (ShiftFastC r m) = Shift r ': Derivs m
  type Prims  (ShiftFastC r m) = Prims m

  algPrims :: Algebra' (Prims (ShiftFastC r m)) (ShiftFastC r m) a
algPrims = (Union (Prims m) (ContT r m) a -> ContT r m a)
-> Algebra' (Prims m) (ShiftFastC r m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (ContT r m)
forall (t :: (* -> *) -> * -> *) (p :: [(* -> *) -> * -> *])
       (m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(C.ContT r) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (ShiftFastC r m))
  (Prims (ShiftFastC r m))
  (ShiftFastC r m)
  z
  a
reformulate forall x. ShiftFastC r m x -> z x
n Algebra (Prims (ShiftFastC r m)) z
alg = Algebra' (Derivs m) z a
-> (Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ShiftFastC r m x -> z x
forall x. ShiftFastC r m x -> z x
n (ShiftFastC r m x -> z x)
-> (m x -> ShiftFastC r m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> ShiftFastC r m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ShiftFastC r m)) z
alg) ((Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a)
-> (Shift r z a -> z a) -> Algebra' (Shift r : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
    Shift (a -> z r) -> z r
main ->
      ShiftFastC r m (Either (a -> m r) a) -> z (Either (a -> m r) a)
forall x. ShiftFastC r m x -> z x
n (ContT r m (Either (a -> m r) a)
-> ShiftFastC r m (Either (a -> m r) a)
forall r (m :: * -> *) a. ContT r m a -> ShiftFastC r m a
ShiftFastC (ContT r m (Either (a -> m r) a)
 -> ShiftFastC r m (Either (a -> m r) a))
-> ContT r m (Either (a -> m r) a)
-> ShiftFastC r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ ((Either (a -> m r) a -> m r) -> m r)
-> ContT r m (Either (a -> m r) a)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
C.ContT (((Either (a -> m r) a -> m r) -> m r)
 -> ContT r m (Either (a -> m r) a))
-> ((Either (a -> m r) a -> m r) -> m r)
-> ContT r m (Either (a -> m r) a)
forall a b. (a -> b) -> a -> b
$ \Either (a -> m r) a -> m r
c -> Either (a -> m r) a -> m r
c ((a -> m r) -> Either (a -> m r) a
forall a b. a -> Either a b
Left (Either (a -> m r) a -> m r
c (Either (a -> m r) a -> m r)
-> (a -> Either (a -> m r) a) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (a -> m r) a
forall a b. b -> Either a b
Right))) z (Either (a -> m r) a) -> (Either (a -> m r) a -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left a -> m r
c  -> (a -> z r) -> z r
main (ShiftFastC r m r -> z r
forall x. ShiftFastC r m x -> z x
n (ShiftFastC r m r -> z r) -> (a -> ShiftFastC r m r) -> a -> z r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m r -> ShiftFastC r m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> ShiftFastC r m r) -> (a -> m r) -> a -> ShiftFastC r m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m r
c) z r -> (r -> z a) -> z a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r
r ->
          ShiftFastC r m a -> z a
forall x. ShiftFastC r m x -> z x
n (ContT r m a -> ShiftFastC r m a
forall r (m :: * -> *) a. ContT r m a -> ShiftFastC r m a
ShiftFastC (ContT r m a -> ShiftFastC r m a)
-> ContT r m a -> ShiftFastC r m a
forall a b. (a -> b) -> a -> b
$ ((a -> m r) -> m r) -> ContT r m a
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
C.ContT (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
_ -> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
        Right a
a -> a -> z a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  {-# INLINEABLE reformulate #-}

newtype ShiftFastC (r :: *) m a = ShiftFastC { ShiftFastC r m a -> ContT r m a
unShiftFastC :: C.ContT r m a }
  deriving (a -> ShiftFastC r m b -> ShiftFastC r m a
(a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
(forall a b. (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b)
-> (forall a b. a -> ShiftFastC r m b -> ShiftFastC r m a)
-> Functor (ShiftFastC r m)
forall a b. a -> ShiftFastC r m b -> ShiftFastC r m a
forall a b. (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
forall r (m :: * -> *) a b.
a -> ShiftFastC r m b -> ShiftFastC r m a
forall r (m :: * -> *) a b.
(a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ShiftFastC r m b -> ShiftFastC r m a
$c<$ :: forall r (m :: * -> *) a b.
a -> ShiftFastC r m b -> ShiftFastC r m a
fmap :: (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
$cfmap :: forall r (m :: * -> *) a b.
(a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
Functor, Functor (ShiftFastC r m)
a -> ShiftFastC r m a
Functor (ShiftFastC r m)
-> (forall a. a -> ShiftFastC r m a)
-> (forall a b.
    ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b)
-> (forall a b c.
    (a -> b -> c)
    -> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c)
-> (forall a b.
    ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b)
-> (forall a b.
    ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a)
-> Applicative (ShiftFastC r m)
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a
ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
(a -> b -> c)
-> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c
forall a. a -> ShiftFastC r m a
forall a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a
forall a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
forall a b.
ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
forall a b c.
(a -> b -> c)
-> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c
forall r (m :: * -> *). Functor (ShiftFastC r m)
forall r (m :: * -> *) a. a -> ShiftFastC r m a
forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a
forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
forall r (m :: * -> *) a b.
ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
forall r (m :: * -> *) a b c.
(a -> b -> c)
-> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a
$c<* :: forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m a
*> :: ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
$c*> :: forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
liftA2 :: (a -> b -> c)
-> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c
$cliftA2 :: forall r (m :: * -> *) a b c.
(a -> b -> c)
-> ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m c
<*> :: ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
$c<*> :: forall r (m :: * -> *) a b.
ShiftFastC r m (a -> b) -> ShiftFastC r m a -> ShiftFastC r m b
pure :: a -> ShiftFastC r m a
$cpure :: forall r (m :: * -> *) a. a -> ShiftFastC r m a
$cp1Applicative :: forall r (m :: * -> *). Functor (ShiftFastC r m)
Applicative, Applicative (ShiftFastC r m)
a -> ShiftFastC r m a
Applicative (ShiftFastC r m)
-> (forall a b.
    ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b)
-> (forall a b.
    ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b)
-> (forall a. a -> ShiftFastC r m a)
-> Monad (ShiftFastC r m)
ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
forall a. a -> ShiftFastC r m a
forall a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
forall a b.
ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b
forall r (m :: * -> *). Applicative (ShiftFastC r m)
forall r (m :: * -> *) a. a -> ShiftFastC r m a
forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
forall r (m :: * -> *) a b.
ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ShiftFastC r m a
$creturn :: forall r (m :: * -> *) a. a -> ShiftFastC r m a
>> :: ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
$c>> :: forall r (m :: * -> *) a b.
ShiftFastC r m a -> ShiftFastC r m b -> ShiftFastC r m b
>>= :: ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b
$c>>= :: forall r (m :: * -> *) a b.
ShiftFastC r m a -> (a -> ShiftFastC r m b) -> ShiftFastC r m b
$cp1Monad :: forall r (m :: * -> *). Applicative (ShiftFastC r m)
Monad, MonadBase b, Monad (ShiftFastC r m)
Monad (ShiftFastC r m)
-> (forall a. IO a -> ShiftFastC r m a) -> MonadIO (ShiftFastC r m)
IO a -> ShiftFastC r m a
forall a. IO a -> ShiftFastC r m a
forall r (m :: * -> *). MonadIO m => Monad (ShiftFastC r m)
forall r (m :: * -> *) a. MonadIO m => IO a -> ShiftFastC r m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ShiftFastC r m a
$cliftIO :: forall r (m :: * -> *) a. MonadIO m => IO a -> ShiftFastC r m a
$cp1MonadIO :: forall r (m :: * -> *). MonadIO m => Monad (ShiftFastC r m)
MonadIO, Monad (ShiftFastC r m)
Monad (ShiftFastC r m)
-> (forall a. String -> ShiftFastC r m a)
-> MonadFail (ShiftFastC r m)
String -> ShiftFastC r m a
forall a. String -> ShiftFastC r m a
forall r (m :: * -> *). MonadFail m => Monad (ShiftFastC r m)
forall r (m :: * -> *) a. MonadFail m => String -> ShiftFastC r m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ShiftFastC r m a
$cfail :: forall r (m :: * -> *) a. MonadFail m => String -> ShiftFastC r m a
$cp1MonadFail :: forall r (m :: * -> *). MonadFail m => Monad (ShiftFastC r m)
Fail.MonadFail)
  deriving m a -> ShiftFastC r m a
(forall (m :: * -> *) a. Monad m => m a -> ShiftFastC r m a)
-> MonadTrans (ShiftFastC r)
forall r (m :: * -> *) a. Monad m => m a -> ShiftFastC r m a
forall (m :: * -> *) a. Monad m => m a -> ShiftFastC r m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ShiftFastC r m a
$clift :: forall r (m :: * -> *) a. Monad m => m a -> ShiftFastC r m a
MonadTrans

-- | 'ContThreads' accepts the following primitive effects:
--
-- * 'Control.Effect.Regional.Regional' @s@
-- * 'Control.Effect.Optional.Optional' @s@ (when @s@ is a functor)
-- * 'Control.Effect.Type.Unravel.Unravel' @p@
-- * 'Control.Effect.Type.ListenPrim.ListenPrim' @s@ (when @s@ is a 'Monoid')
-- * 'Control.Effect.Type.ReaderPrim.ReaderPrim' @i@
type ContThreads = FreeThreads

-- | 'ContFastThreads' accepts the following primitive effects:
--
-- * 'Control.Effect.Type.ReaderPrim.ReaderPrim' @i@
class    ( forall s. Threads (C.ContT s) p
         ) => ContFastThreads p
instance ( forall s. Threads (C.ContT s) p
         ) => ContFastThreads p