I have a simple continuation type (similar to the Free monad):
data C m a = C {runC :: (a -> m a) -> m a}
toBeContinued :: Int -> C Maybe Int
toBeContinued i = C $ \todo -> todo i
continuing :: Int -> Maybe Int
continuing i = Just 100
I'm then looking to create two interleaved threads of these suspended continuations, all of which to be executed using the same continuing function:
data PoorMans m a = Atomic (m (PoorMans m a)) | Done a
instance Monad m => Monad (PoorMans m) where
(>>=) (Atomic m) f = Atomic $ (liftM (>>= f) m)
(>>=) (Done m) f = f m
return = Done
atomic :: Monad m => m a -> PoorMans m a
atomic m = Atomic $ liftM Done m
runThread :: Monad m => m a -> PoorMans m a
runThread (Atomic m) = m >>= runThread
runThread (Done m) = return m
interleave :: Monad m => PoorMans m a -> PoorMans m a -> PoorMans m a
interleave (Atomic m1) (Atomic m2) = do
n1 <- m1
n2 <- m2
interleave n1 n2
interleave (Done _) m2 = m2
interleave m1 (Done _) = m1
I'm now trying to create two threads of suspended operations, which I can then pass to interleave then into runThread with a continuation operation to be applied to all suspended operations:
createSuspendedOperations :: Int -> PoorMans (C Maybe) Int
createSuspendedOperations i = atomic $ toBeContinued 12
Error:
No instance for (Monad (C Maybe))
arising from a use of ‘atomic’
I understand that I must make C an instance of Monad as atomic is bound by Monad m =>:
instance Monad m => Monad (C m) where
However here I am stuck as to how to define the behaviors of >>= and return for C m a?
There's no way this is a monad, because a is an invariant parameter of C m a. (Here is an FPComplete post about variance.)
You might want to take a look at the "continuation monad" in transformers.
Related
I'm wanting to create an interleaved thread with suspended functions, which I can pass a single function at the time of invocation.
Basic continuation type:
data ContT m a = ContT {runContT :: (a -> m a) -> m a}
suspendedFunction :: Int -> ContT Maybe Int
suspendedFunction i = ContT $ \todo -> todo i
calculation :: Int -> Maybe Int --(a -> m a)
calculation i = Just 100
Continuations with Poor Mans Concurrency:
data C m a = Atomic (m (C m a)) | Done a
instance Monad m => Monad (C m) where
(>>=) (Atomic m) f = Atomic $ (liftM (>>= f) m)
(>>=) (Done a) f = f a
return = Done
atomic :: Monad m => m a -> C m a
atomic m = Atomic $ liftM Done m
interleave :: Monad m => C m a -> C m a -> C m a
interleave (Atomic m1) (Atomic m2) = do
n1 <- atom $ m1
n2 <- atom $ m2
interleave n1 n2
interleave m1 (Done _) = m1
interleave (Done _) m2 = m2
runInterleavedThread :: Monad m => C m a -> m a
runInterleavedThread m = m >>= runInterleaved
createSuspendedThread :: Int -> C (ContT Maybe) Int
createSuspendedThread i = atomic $ suspendedFunction i
main = do
let inter = interleave (createSuspendedThread 1) (createSuspendedThread 2)
let complete = runContT $ runThreads inter $ calculation
Error:
"No instance for (Monad (ContT Maybe))
arising from a use of ‘atomic’"
Am I missing something basic here, can anyone shed some light?
I am slightly confused by the interleave function given in this guide.
I have the following data type:
data M m r = Atomic (m (M m r)) | Done r
I've created a lifting function to take a m a, inserts the a inside Done, and then re-inserts Done a back into m (). This forms the Atomic structure:
atm :: Monad m => m a -> M m a
atm m = Atomic $ liftM Done m
I've made M m an instance of the Monad class (which pattern matches based on data constructor):
instance (Monad m) => Monad (M m) where
return = Done
(Atomic m) >>= f = Atomic liftM (>>= f) m
(Done r) >>= f = f v
There's a simple implementation function which accesses nested values within the Atomic wrapper:
runThread :: Monad m => M m a -> m a
runThread (Atomic m) = m >>= runThread --Extract m and recursively pass to runThread
runThread (Done r) = return r --Return Done
Then, there is the following interleave function:
interleave :: Monad m => M m r -> M m r -> M m r
interleave (Atomic m1) (Atomic m2) = do
next1 <- atm m1 --?
next2 <- atm m2 --?
interleave next1 next2
interleave (Done _) t2 = interleave t2
interleave t1 (Done _) = interleave t1
My points of confusion are at next1 <- atm m1 and next2 <- atm m2.
As I understand it, all this is doing is taking m1 from the (Atomic m1) wrapper and reinserting it back into an Atomic wrapper? How is this operation interleaving?
Am I missing something basic here? The code works fine, so I'm sure it's due to my confusion.
The rest of the code:
threadOne :: M IO ()
threadOne = do
atm $ print 1
threadTwo :: M IO ()
threadTwo = do
atm $ print 2
main = do
runThread (interleave threadOne threadTwo)
You are partially right. The code
next1 <- atm m1
takes the atomic action that the first thread starts with and inserts it into the merged/interleaved thread. What's returned from the call to atm is the continuation next1 of that first thread.
But next, we are taking an action from the second thread, by saying
next2 <- atm m2
So the merged thread ends up executing an action from the first thread, and then one from the second thread. Hence "interleaving". We then continue by calling interleave recursively on the two continuations via
interleave next1 next2
i have data structures (here B and T) which include a monad as a type parameter (here m) (it is a simplified form from Data.Binding.Simple) and it is used in a class (here Variables3) with functions with the same monad type. in the instance of the class using the data the type parameter for the monad (say m) appears twice (here Variable3 (T m) m a). this compiles but when i use the functions in code which has for some of the types parameters (here test3) i get an error (could not deduce ... m ..m1) which indicates that the compiler sees the two occurrences of the type variable as distinct.
i found a solution: name the two occurrences with distinct type parameters (say m and m1) and add equivalence m ~ m1 (using the TypeFamilies extension). compiles and runs.
here some very much simplified code which produces the error for test3
class (Monad m) => Variable3 v m a where
newVar3 :: a -> m (v a)
readVar3 :: v a -> m a
writeVar3 :: v a -> a -> m ()
data B a m = B {f1 :: a
, f2 :: a -> m () }
data T m a = T {unT :: TVar (B a m)}
instance (Variable3 TVar m (B a m)
, MonadIO m
) => Variable3 (T m) m a where
newVar3 a = do
n <- newVar3 (B {f1 = a, f2 = \a -> return () })
return (T n)
readVar3 a = do
v <- liftIO $ readTVarIO . unT $ a
return . f1 $ v
test3 :: ( MonadIO m
, Variable3 TVar m (B a m)
, Eq a) => [a] -> m Bool
test3 [v1, v2] = do
n1 :: (T m1 a) <- newVar3 v1
r1 <- readVar3 n1
let b1 = r1 == v1
return True `
replacing the instance head with:
instance (Variable3 TVar m (B a m1)
, MonadIO m
, m ~ m1
) => Variable3 (T m1 ) m a where
allows to compile and run test3!
what is the rule behind this? is this an error in the compiler?
I don't have a complete answer for you, but I know this much.
When GHC is resolving the Variable3 instance and sees
instance (Variable3 TVar m (B a m1)
, MonadIO m
, m ~ m1
) => Variable3 (T m1 ) m a
It checks that the first parameter is of the form T m1. It then commits to that instance and dedicates itself to resolving the context.
When it sees
instance (Variable3 TVar m (B a m)
, MonadIO m
) => Variable3 (T m) m a
it won't commit to the instance unless it can see that the first argument is T applied to the second argument. After all, you could have another instance for Variable3 (T (MaybeT m)) m a! It can't go ahead and try to unify the type variables because that would change the type checker's state (no backtracking there). So something else would, I believe, have had to let it know about that equality already.
The work-around you found is, in any case, quite a standard one, and usually recommended.
How can we prove that the continuation monad has no valid instance of MonadFix?
Well actually, it's not that there can't be a MonadFix instance, just that the library's type is a bit too constrained. If you define ContT over all possible rs, then not only does MonadFix become possible, but all instances up to Monad require nothing of the underlying functor :
newtype ContT m a = ContT { runContT :: forall r. (a -> m r) -> m r }
instance Functor (ContT m) where
fmap f (ContT k) = ContT (\kb -> k (kb . f))
instance Monad (ContT m) where
return a = ContT ($a)
join (ContT kk) = ContT (\ka -> kk (\(ContT k) -> k ka))
instance MonadFix m => MonadFix (ContT m) where
mfix f = ContT (\ka -> mfixing (\a -> runContT (f a) ka<&>(,a)))
where mfixing f = fst <$> mfix (\ ~(_,a) -> f a )
Consider the type signature of mfix for the continuation monad.
(a -> ContT r m a) -> ContT r m a
-- expand the newtype
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
Here's the proof that there's no pure inhabitant of this type.
---------------------------------------------
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
introduce f, k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
a
dead end, backtrack
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply f
f :: a -> (a -> m r) -> m r f :: a -> (a -> m r) -> m r
k :: a -> m r k :: a -> m r
--------------------------- ---------------------------
a a -> m r
dead end reflexivity k
As you can see the problem is that both f and k expect a value of type a as an input. However, there's no way to conjure a value of type a. Hence, there's no pure inhabitant of mfix for the continuation monad.
Note that you can't define mfix recursively either because mfix f k = mfix ? ? would lead to an infinite regress since there's no base case. And, we can't define mfix f k = f ? ? or mfix f k = k ? because even with recursion there's no way to conjure a value of type a.
But, could we have an impure implementation of mfix for the continuation monad? Consider the following.
import Control.Concurrent.MVar
import Control.Monad.Cont
import Control.Monad.Fix
import System.IO.Unsafe
instance MonadFix (ContT r m) where
mfix f = ContT $ \k -> unsafePerformIO $ do
m <- newEmptyMVar
x <- unsafeInterleaveIO (readMVar m)
return . runContT (f x) $ \x' -> unsafePerformIO $ do
putMVar m x'
return (k x')
The question that arises is how to apply f to x'. Normally, we'd do this using a recursive let expression, i.e. let x' = f x'. However, x' is not the return value of f. Instead, the continuation given to f is applied to x'. To solve this conundrum, we create an empty mutable variable m, lazily read its value x, and apply f to x. It's safe to do so because f must not be strict in its argument. When f eventually calls the continuation given to it, we store the result x' in m and apply the continuation k to x'. Thus, when we finally evaluate x we get the result x'.
The above implementation of mfix for the continuation monad looks a lot like the implementation of mfix for the IO monad.
import Control.Concurrent.MVar
import Control.Monad.Fix
instance MonadFix IO where
mfix f = do
m <- newEmptyMVar
x <- unsafeInterleaveIO (takeMVar m)
x' <- f x
putMVar m x'
return x'
Note, that in the implementation of mfix for the continuation monad we used readMVar whereas in the implementation of mfix for the IO monad we used takeMVar. This is because, the continuation given to f can be called multiple times. However, we only want to store the result given to the first callback. Using readMVar instead of takeMVar ensures that the mutable variable remains full. Hence, if the continuation is called more than once then the second callback will block indefinitely on the putMVar operation.
However, only storing the result of the first callback seems kind of arbitrary. So, here's an implementation of mfix for the continuation monad that allows the provided continuation to be called multiple times. I wrote it in JavaScript because I couldn't get it to play nicely with laziness in Haskell.
// mfix :: (Thunk a -> ContT r m a) -> ContT r m a
const mfix = f => k => {
const ys = [];
return (function iteration(n) {
let i = 0, x;
return f(() => {
if (i > n) return x;
throw new ReferenceError("x is not defined");
})(y => {
const j = i++;
if (j === n) {
ys[j] = k(x = y);
iteration(i);
}
return ys[j];
});
}(0));
};
const example = triple => k => [
{ a: () => 1, b: () => 2, c: () => triple().a() + triple().b() },
{ a: () => 2, b: () => triple().c() - triple().a(), c: () => 5 },
{ a: () => triple().c() - triple().b(), b: () => 5, c: () => 8 },
].flatMap(k);
const result = mfix(example)(({ a, b, c }) => [{ a: a(), b: b(), c: c() }]);
console.log(result);
Here's the equivalent Haskell code, sans the implementation of mfix.
import Control.Monad.Cont
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> ContT r [] Triple
example triple = ContT $ \k ->
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
] >>= k
result :: [Triple]
result = runContT (mfix example) pure
main :: IO ()
main = print result
Notice that this looks a lot like the list monad.
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> [Triple]
example triple =
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
]
result :: [Triple]
result = mfix example
main :: IO ()
main = print result
This makes sense because after all the continuation monad is the mother of all monads. I'll leave the verification of the MonadFix laws of my JavaScript implementation of mfix as an exercise for the reader.
After reading (and skimming some sections of) Wadler's paper on monads, I decided to work through the paper more closely, defining functor and applicative instances for each of the monads he describes. Using the type synonym
type M a = State -> (a, State)
type State = Int
Wadler uses to define the state monad, I have the following (using related names so I can define them with a newtype declaration later on).
fmap' :: (a -> b) -> M a -> M b
fmap' f m = \st -> let (a, s) = m st in (f a, s)
pure' :: a -> M a
pure' a = \st -> (a, st)
(<#>) :: M (a -> b) -> M a -> M b
sf <#> sv = \st -> let (f, st1) = sf st
(a, st2) = sv st1
in (f a, st2)
return' :: a -> M a
return' a = pure' a
bind :: M a -> (a -> M b) -> M b
m `bind` f = \st -> let (a, st1) = m st
(b, st2) = f a st1
in (b, st2)
When I switch to using a type constructor in a newtype declaration, e.g.,
newtype S a = S (State -> (a, State))
everything falls apart. Everything is just a slight modification, for instance,
instance Functor S where
fmap f (S m) = S (\st -> let (a, s) = m st in (f a, s))
instance Applicative S where
pure a = S (\st -> (a, st))
however nothing runs in GHC due to the fact that the lambda expression is hidden inside that type constructor. Now the only solution I see is to define a function:
isntThisAnnoying s (S m) = m s
in order to bind s to 'st' and actually return a value, e.g.,
fmap f m = S (\st -> let (a, s) = isntThisAnnoying st m in (f a, s))
Is there another way to do this that doesn't use these auxiliary functions?
If you look here, you will see that they define it this way:
newtype State s a = State { runState :: (s -> (a,s)) }
so as to give the inner lambda a name.
The usual way is to define newtype newtype S a = S {runState : State -> (a, State)}. Then instead of your isntThisAnnoying s (S m) you can write runState t s where t is the same as S m.
You have to use a newtype because type synonyms cannot be typeclass instances.