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?
Related
I am trying to come up with an implementation of State Monad derived from examples of function composition. Here I what I came up with:
First deriving the concept of Monad:
data Maybe' a = Nothing' | Just' a deriving Show
sqrt' :: (Floating a, Ord a) => a -> Maybe' a
sqrt' x = if x < 0 then Nothing' else Just' (sqrt x)
inv' :: (Floating a, Ord a) => a -> Maybe' a
inv' x = if x == 0 then Nothing' else Just' (1/x)
log' :: (Floating a, Ord a) => a -> Maybe' a
log' x = if x == 0 then Nothing' else Just' (log x)
We can have function that composes these functions as follows:
sqrtInvLog' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog' x = case (sqrt' x) of
Nothing' -> Nothing'
(Just' y) -> case (inv' y) of
Nothing' -> Nothing'
(Just' z) -> log' z
This could be simplified by factoring out the case statement and function application:
fMaybe' :: (Maybe' a) -> (a -> Maybe' b) -> Maybe' b
fMaybe' Nothing' _ = Nothing'
fMaybe' (Just' x) f = f x
-- Applying fMaybe' =>
sqrtInvLog'' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog'' x = (sqrt' x) `fMaybe'` (inv') `fMaybe'` (log')`
Now we can generalize the concept to any type, instead of just Maybe' by defining a Monad =>
class Monad' m where
bind' :: m a -> (a -> m b) -> m b
return' :: a -> m a
instance Monad' Maybe' where
bind' Nothing' _ = Nothing'
bind' (Just' x) f = f x
return' x = Just' x
Using Monad' implementation, sqrtInvLog'' can be written as:
sqrtInvLog''' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog''' x = (sqrt' x) \bind'` (inv') `bind'` (log')`
Trying to apply the concept to maintain state, I defined something as shown below:
data St a s = St (a,s) deriving Show
sqrtLogInvSt' :: (Floating a, Ord a) => St a a -> St (Maybe' a) a
sqrtLogInvSt' (St (x,s)) = case (sqrt' x) of
Nothing' -> St (Nothing', s)
(Just' y) -> case (log' y) of
Nothing' -> St (Nothing', s+y)
(Just' z) -> St (inv' z, s+y+z)
It is not possible to define a monad using the above definition as bind needs to be defined as taking in a single type "m a".
Second attempt based on Haskell's definition of State Monad:
newtype State s a = State { runState :: s -> (a, s) }
First attempt to define function that is built using composed functions and maintains state:
fex1 :: Int->State Int Int
fex1 x = State { runState = \s->(r,(s+r)) } where r = x `mod` 2`
fex2 :: Int->State Int Int
fex2 x = State { runState = \s-> (r,s+r)} where r = x * 5
A composed function:
fex3 x = (runState (fex2 y)) st where (st, y) = (runState (fex1 x)) 0
But the definition newtype State s a = State { runState :: s -> (a, s) } does not fit the pattern of m a -> (a -> m b) -> m b of bind
An attempt could be made as follows:
instance Monad' (State s) where
bind' st f = undefined
return' x = State { runState = \s -> (x,s) }
bind' is undefined above becuase I did not know how I would implement it.
I could derive why monads are useful and apply it the first example (Maybe') but cannot seem to apply it to State. It will be useful to understand how I could derive the State Moand using concepts defined above.
Note that I have asked a similar question earlier: Haskell - Unable to define a State monad like function using a Monad like definition but I have expanded here and added more details.
Your composed function fex3 has the wrong type:
fex3 :: Int -> (Int, Int)
Unlike with your sqrtInvLog' example for Maybe', State does not appear in the type of fex3.
We could define it as
fex3 :: Int -> State Int Int
fex3 x = State { runState = \s ->
let (y, st) = runState (fex1 x) s in
runState (fex2 y) st }
The main difference to your definition is that instead of hardcoding 0 as the initial state, we pass on our own state s.
What if (like in your Maybe example) we wanted to compose three functions? Here I'll just reuse fex2 instead of introducing another intermediate function:
fex4 :: Int -> State Int Int
fex4 x = State { runState = \s ->
let (y, st) = runState (fex1 x) s in
let (z, st') = runState (fex2 y) st in
runState (fex2 z) st' }
SPOILERS:
The generalized version bindState can be extracted as follows:
bindState m f = State { runState = \s ->
let (x, st) = runState m s in
runState (f x) st }
fex3' x = fex1 x `bindState` fex2
fex4' x = fex1 x `bindState` fex2 `bindState` fex2
We can also start with Monad' and types.
The m in the definition of Monad' is applied to one type argument (m a, m b). We can't set m = State because State requires two arguments. On the other hand, partial application is perfectly valid for types: State s a really means (State s) a, so we can set m = State s:
instance Monad' (State s) where
-- return' :: a -> m a (where m = State s)
-- return' :: a -> State s a
return' x = State { runState = \s -> (x,s) }
-- bind' :: m a -> (a -> m b) -> m b (where m = State s)
-- bind' :: State s a -> (a -> State s b) -> State s b
bind' st f =
-- Good so far: we have two arguments
-- st :: State s a
-- f :: a -> State s b
-- We also need a result
-- ... :: State s b
-- It must be a State, so we can start with:
State { runState = \s ->
-- Now we also have
-- s :: s
-- That means we can run st:
let (x, s') = runState st s in
-- runState :: State s a -> s -> (a, s)
-- st :: State s a
-- s :: s
-- x :: a
-- s' :: s
-- Now we have a value of type 'a' that we can pass to f:
-- f x :: State s b
-- We are already in a State { ... } context, so we need
-- to return a (value, state) tuple. We can get that from
-- 'State s b' by using runState again:
runState (f x) s'
}
Have a look to this. Summing and extending a bit.
If you have a function
ta -> tb
and want to add "state" to it, then you should pass that state along, and have
(ta, ts) -> (tb, ts)
You can transform this by currying it:
ta -> ts -> (tb, ts)
If you compare this with the original ta -> tb, we obtain (adding parentheses)
ta -> (ts -> (tb, ts))
Summing up, if a function returns tb from ta (i.e. ta -> tb), a "stateful"
version of it will return (ts -> (tb, ts)) from ta (i.e. ta -> (ts -> (tb, ts)))
Therefore, a "stateful computation" (just one function, or either a chain of functions dealing with state) must return/produce this:
(ts -> (tb, ts))
This is the typical case of a stack of ints.
[Int] is the State
pop :: [Int] -> (Int, [Int]) -- remove top
pop (v:s) -> (v, s)
push :: Int -> [Int] -> (int, [Int]) -- add to the top
push v s -> (v, v:s)
For push, the type of push 5 is the same than type of pop :: [Int] -> (Int, [Int]).
So we would like to combine/join this basic operations to get things as
duplicateTop =
v <- pop
push v
push v
Note that, as desired, duplicateTop :: [Int] -> (Int, [Int])
Now: how to combine two stateful computations to get a new one?
Let's do it (Caution: this definition is not the same that the
used for the bind of monad (>>=) but it is equivalent).
Combine:
f :: ta -> (ts -> (tb, ts))
with
g :: tb -> (ts -> (tc, ts))
to get
h :: ta -> (ts -> (tc, ts))
This is the construction of h (in pseudo-haskell)
h = \a -> ( \s -> (c, s') )
where we have to calculate (c, s') (the rest in the expressions are just parameters a and s). Here it is how:
-- 1. run f using a and s
l1 = f a -- use the parameter a to get the function (ts -> (tb, ts)) returned by f
(b, s1) = l1 s -- use the parameter s to get the pair that l1 returns ( :: (tb, ts) )
-- 2. run g using f output, b and s1
l2 = g b -- use b to get the function (ts -> (tb, ts)) returned by g
(c, s') = l2 s1 -- use s1 to get the pair that l2 returns ( :: (tc, ts) )
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.
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.
I'd like to write the function
fixProxy :: (Monad m, Proxy p) => (b -> m b) -> b -> () -> p a' a () b m r
fixProxy f a () = runIdentityP $ do
v <- respond a
a' <- lift (f a)
fixProxy f a' v
which works just like you'd think until I try to run the proxy
>>> :t \g -> runRVarT . runWriterT . runProxy $ fixProxy g 0 >-> toListD
(Num a, RandomSource m s, MonadRandom (WriterT [a] (RVarT n)),
Data.Random.Lift.Lift n m) =>
(a -> WriterT [a] (RVarT n) a) -> s -> m (a, [a])
where I use RVarT intentionally to highlight the existence of the Lift class in RVar. Lift represents the existence of a natural transformation n :~> m which ought to encapsulate what I'm looking for, a function like:
fixProxy :: (Monad m, Monad n, Lift m n, Proxy p)
=> (b -> m b) -> b -> () -> p a' a () b n r
Is Lift the right answer (which would require many orphan instances) or is there a more standard natural transformation MPTC to use?
Note the practical solution, as described in comments below, is something like
runRVarT . runWriterT . runProxy
$ hoistK lift (fixProxy (const $ sample StdUniform) 0) >-> toListD
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.