I've just read this very interesting article about an alternative implementation for the Prompt Monad : http://joeysmandatory.blogspot.com/2012/06/explaining-prompt-monad-with-simpler.html
Here is a simplified code that can be run :
data Request a where
GetLine :: Request String
PutStrLn :: String -> Request ()
data Prompt p r
= forall a. Ask (p a) (a -> Prompt p r)
| Answer r
instance Monad (Prompt p) where
return = Answer
Ask req cont >>= k = Ask req (\ans -> cont ans >>= k)
Answer x >>= k = k x
prompt :: p a -> Prompt p a
prompt req = Ask req Answer
runPromptM :: Monad m => (forall a. p a -> m a) -> Prompt p r -> m r
runPromptM perform (Ask req cont) = perform req
>>= runPromptM perform . cont
runPromptM _ (Answer r) = return r
handleIO :: Request a -> IO a
handleIO GetLine = return ""
handleIO (PutStrLn s) = putStrLn s
req :: Prompt Request ()
req = do
answers <- sequence $ replicate 20000 (prompt GetLine)
prompt $ PutStrLn (concat answers)
main = runPromptM handleIO req
A comment in the article mentions that :
it has a problem that left recursion of >>= takes quadratic time to evaluate (it's the same as the left-recursion of ++ problem!)
I don't understand where the quadratic time (which I checked experimentally) come from. Is it related to lazy evaluation ?
Can someone explain me why ?
I feel this is a little easier to explain using the Free
monad over Prompt
, though they are very similar.
data Free f a = Pure a | Free (f (Free f a)) deriving Functor
The Free
monad is either a completed operation marked by Pure
or an f
-indexed effect marked by Free
. If f
is a Functor
then Free f
is a Monad
instance Functor f => Monad (Free f) where
return = Pure
Pure a >>= f = f a
Free m >>= f = Free (fmap (>>= f) m)
This Monad
instance work by "pushing" binds down through the layers of the Functor
to reach the Pure
nodes at the bottom and then applying f
. What's important about this is that the number of Functor
layers does not change. To wit, here's an example bind occurring in Free Maybe ()
.
Free (Just (Free (Just (Free Nothing)))) >>= (const (return ()))
Free (fmap (>>= (const (return ()))) (Just (Free (Just (Free Nothing))))
Free (Just (Free (Just (Free Nothing)) >>= (const (return ())))
Free (Just (Free (fmap (>>= (const (return ()))) (Just (Free Nothing))))
Free (Just (Free (Just (Free Nothing >>= (const (return ()))))))
Free (Just (Free (Just (Free Nothing))))
We see here a hint of what's to come—we had to traverse the entire tree down to the root just to do nothing at all.
One way to see the Free
monad is to think of it as the "substitution monad". Its bind looks like
(=<<) :: (a -> Free f b) -> Free f a -> Free f b
and if you think of a -> Free f b
as converting Pure
leaf values into new trees of effects then (=<<)
just descends through the tree of effects Free f a
and performs substitution over the a
values.
Now if we have a chain of right associating binds (written using Kleisli composition (>=>)
to prove that reassociation is valid—Kleisli arrows are a category)
f >=> (g >=> h)
then we only must descend into the tree once—the substitution function is computed at all of the nodes of the tree. However, if we're associated the other direction
(f >=> g) >=> h
we get the same result, but must compute the entire result (f >=> g)
before we're able to apply the substitution function in h
. What this means is that if we have a deeply nested left-associated bind sequence
((((f >=> g) >=> h) >=> i) >=> j) >=> k
then we're continually recomputing the left results so that we can recurse on them. This is where the quadratic slowdown appears.
There's a really strange type called Codensity
which is related to continuation passing style and the ContT
monad.
data Codensity m a = Codensity { runCodensity :: forall b . (a -> m b) -> m b }
-- Codensity m a = forall b . ContT b m a
Codensity has the interesting property that it's a Functor
even when m
isn't:
instance Functor (Codensity m) where
fmap f m = Codensity (\amb -> runCodensity m (amb . f))
and the unique property that it's a Monad
even when m
isn't:
instance Monad (Codensity m) where
return a = Codensity (\amb -> amb a)
m >>= f = Codensity (\bmc -> runCodensity m (\a -> runCodensity (f a) bmc))
We can also round-trip Monad
s through Codensity
toCodensity :: Monad m => m a -> Codensity m a
toCodensity ma = Codensity (\amb -> ma >>= amb)
fromCodensity :: Monad m => Codensity m a -> m a
fromCodensity m = runCodensity m return
roundtrip :: Monad m => m a -> m a
roundtrip = fromCodensity . toCodensity
but when we do this something very, very interesting happens: all of the binds become right-associated!.
Consider the classic left associated append problem. You are probably aware that whenever you have a series of left associated append-like functions (I'll use (++)
here), you run into O(n^2)
issues:
(((as ++ bs) ++ cs) ++ ds) ++ ...
It is easy to see that each additional append will have to traverse the entire length of the previously appended list, resulting in horrendously slow O(n^2)
algorithm.
The solution is to right associate:
as ++ (bs ++ (cs ++ (ds ++ ...)))
This is O(a + b + c + d + ...)
where a
is the length of as
, etc. or simply O(n)
in the length of the total list.
Now, what does this have to do with Free
? Let's suggestively compare the definition of Free
with []
:
data Free f r = Pure r | Free (f (Free f r))
data [] a = [] | Cons a [a]
While []
has values at each Cons
node, Free
only has a value at the Pure
tip. Apart from that the definitions are very similar. A good intuition for Free
is that it is a list-like data structure of Functor
s.
Now the Monad
instance for Free
, we only care about (>>=)
:
Pure r >>= f = f r
Free x >>= f = Free (fmap (>>= f) x)
Notice that (>>=)
traverses the structure of Free
until it reaches the Pure
value, and then grafts (appends) additional Free
structure onto the end. Remarkably similar to (++)
!
With this intuition of Free
as a list of Functor
, and (>>=)
behaving as (++)
, it should be clear why left associated (>>=)
causes problems.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With