Intuition to understand poor man's concurrency

Hello all, I am trying to understand the ideas of Koen Klaessen, published in Functional Pearls: "A poor man's concurrency" (1993). The code in the paper doesn't compile. E.g. uses "lambda dot" instead of "labmda arrow", i.e. the way the labmda calculus guys write things. Was that ever legal haskell or is this the result of some lhs2lex pretty printer? Anyways, I believe I was able to convert that into modern haskell syntax - at least it compiles. But I have trouble to understand the Monad instance presented there. Could anyobody walk me through the bind function? But even more important: how do you guys develop an intuition about what the bind operator does in a specific monad. I saw a Google tech talk where Douglas Crockford explains mondads in terms of Objects in javascript (https://www.youtube.com/watch?v=b0EF0VTs9Dc), which was certainly enlightening, but I couldn't apply it to this particular modad. I also tried using something like Data Flow Diagrams. This kinda works for simple Mondads such as the state mondad, but I couldn't apply it to the concurrency mondad. In general DFDs are not very good when it comes to higher order functions. In any case here is the code. I made it more verbose than necessary in order to understand it (bind was originally just one line), but to no avail. newtype C m a = C ((a -> Action m) -> Action m) instance Monad m => Monad (C m) where (C m) >>= k = C cont where cont c = m (\a -> let C h = k a in h c) return x = C $ \c -> c x data Action m = Atom (m (Action m)) | Fork (Action m) (Action m) | Stop

That looks like a continuation monad to me. `C m a` can also be expressed
as `Cont (Action m) a`, where Cont is from the transformers library.
In this case, I suggest looking at how the C type is used, rather than
focusing on the Monad instance. Since it's all bog standard continuation
passing so far, most likely the interesting part is elsewhere.
I'm on my phone so I can't supply links, but I hope this helps a bit.
On Jul 27, 2014 10:48 PM, "martin"
Hello all,
I am trying to understand the ideas of Koen Klaessen, published in Functional Pearls: "A poor man's concurrency" (1993).
The code in the paper doesn't compile. E.g. uses "lambda dot" instead of "labmda arrow", i.e. the way the labmda calculus guys write things. Was that ever legal haskell or is this the result of some lhs2lex pretty printer?
Anyways, I believe I was able to convert that into modern haskell syntax - at least it compiles. But I have trouble to understand the Monad instance presented there. Could anyobody walk me through the bind function?
But even more important: how do you guys develop an intuition about what the bind operator does in a specific monad. I saw a Google tech talk where Douglas Crockford explains mondads in terms of Objects in javascript (https://www.youtube.com/watch?v=b0EF0VTs9Dc), which was certainly enlightening, but I couldn't apply it to this particular modad.
I also tried using something like Data Flow Diagrams. This kinda works for simple Mondads such as the state mondad, but I couldn't apply it to the concurrency mondad. In general DFDs are not very good when it comes to higher order functions.
In any case here is the code. I made it more verbose than necessary in order to understand it (bind was originally just one line), but to no avail.
newtype C m a = C ((a -> Action m) -> Action m)
instance Monad m => Monad (C m) where (C m) >>= k = C cont where cont c = m (\a -> let C h = k a in h c) return x = C $ \c -> c x
data Action m = Atom (m (Action m)) | Fork (Action m) (Action m) | Stop _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

On 27.07.2014 13:30, Chris Wong wrote:
That looks like a continuation monad to me. `C m a` can also be expressed as `Cont (Action m) a`, where Cont is from the transformers library.
I'm not sure if this fits properly here, but Continuation + Concurrency reminded me of a blog post by Neil Mitchell [1].
On Jul 27, 2014 10:48 PM, "martin"
wrote: Anyways, I believe I was able to convert that into modern haskell syntax - at least it compiles. But I have trouble to understand the Monad instance presented there. Could anyobody walk me through the bind function?
In case it's the Continuation monad Chris mentioned (and I think he's right), you might enjoy Gabriel Gonzale's blog post about the Continuation monad [2], where he gives motivation, walks through the monad itself step by step and finally gives some examples. [1] http://neilmitchell.blogspot.com.es/2014/06/optimisation-with-continuations.... [2] http://www.haskellforall.com/2012/12/the-continuation-monad.html HTH, Jochen

Am 07/27/2014 09:22 PM, schrieb Jochen Keil:
In case it's the Continuation monad Chris mentioned (and I think he's right)
I believe so too. But I still have trouble understanding it. Let's forget about this particular monad for a while and focus on intuition in general. I managed to dissect the continuation monad and write the bind operator correctly. But it took me hours and the train of thought is very elusive. I wouldn't call this "understanding". When I truly understand things I can come up with analogies, counter examples and the like. I can draw diagrams to visualize the thing. I can embed the new thing into a world of old things. But I cannot do any of these things with the Continuation Monad. Right now I am trying to get there by staring at it, asking myself questions, trying to write bind in different ways - hoping that one day it will click. Someone on the web said that this (hard work) is the only way. Douglas Crockford said that monads come with a curse, that is as soon as you understand them you loose the ability to explain them to anyone else. Someone else said, the way to a monad's heart is through its Kleisli arrow. So I wonder what you guys do to develop intuition about tricky haskell things, such as the Continuation monad.

martin
Let's forget about this particular monad for a while and focus on intuition in general.
I managed to dissect the continuation monad and write the bind operator correctly. But it took me hours and the train of thought is very elusive. I wouldn't call this "understanding".
When I truly understand things I can come up with analogies, counter examples and the like. I can draw diagrams to visualize the thing. I can embed the new thing into a world of old things.
But I cannot do any of these things with the Continuation Monad. Right now I am trying to get there by staring at it, asking myself questions, trying to write bind in different ways - hoping that one day it will click.
So I wonder what you guys do to develop intuition about tricky haskell things, such as the Continuation monad.
Bind can often be a bit tricky. I usually find it easier to define bind as:
x >>= f = join (fmap f x)
Then ignore it and focus on fmap and join instead. This is a 'divide and conquer' approach.
fmap :: (Functor f) => (a -> b) -> f a -> f b
This is the usual Functor method. We can ignore all the monadic stuff when defining it, which makes our life easier. With fmap defined, we can turn "f :: a -> m b" and "x :: m a" into "fmap f x :: m (m b)"
join :: (Monad m) => m (m a) -> m a
This needs to turn two nested monadic "wrappers" into one, using some logic specific to our monad. I find this easier to think about than bind since we're now only dealing with one argument. Cheers, Chris

Am 07/29/2014 11:09 AM, schrieb Chris Warburton:
Bind can often be a bit tricky. I usually find it easier to define bind as:
x >>= f = join (fmap f x)
Then ignore it and focus on fmap and join instead. This is a 'divide and conquer' approach.
So you're really throwing symbols around? When I do math, I do similar things. Particularly in algebra I don't ask myself what e.g. a cubic root does, because I know the laws of roots and I know what I can do with the symbols. However, for other things, like an integral or a gradient I have a strong intuition. I have intuition for some of the simpler things in haskell too. For functions, folds and functors I have some intuition. In math, the only ways I know of to get a better intuition is practice and a good teacher. Maybe it is the same in haskell?

Le 30/07/2014 20:00, martin a écrit :
for other things, like an integral or a gradient I have a strong intuition. Oh, do you?... My deepest respect and admiration.
In math, the only ways I know of to get a better intuition is practice and a good teacher. Maybe it is the same in haskell? In math, your practice doesn't give you any intuition. Your training and your teacher increase your belief that the model you use is right. It is
I have used gradients and integrals for almost a half of century, and I lost all intuition thereof several times... I thought I had quite a quite substantial intuition of gradients, and then I discovered tensorial calculus, and when my intuition "progressed", I discovered differential forms, and then fibre bundles, and I broke some teeth on topological issues, and then ... And with integrals it was much worse. Без водки не разберешь! the "love after marriage" syndrome. It works with most formal, disciplined approach to anything, Haskell included. It is needed that you can *formulate* your thoughts, but the true intuition, your insight, the impression that you KNOW that something is "right", is independent of it. The best. Jerzy Karczmarczuk Caen, France

On 14-07-30 02:00 PM, martin wrote:
When I do math, I do similar things. Particularly in algebra I don't ask myself what e.g. a cubic root does, because I know the laws of roots and I know what I can do with the symbols.
However, for other things, like an integral or a gradient I have a strong intuition. I have intuition for some of the simpler things in haskell too. For functions, folds and functors I have some intuition.
In math, the only ways I know of to get a better intuition is practice and a good teacher. Maybe it is the same in haskell?
What, exactly, is intuition? Or, ironically, we shouldn't be asking that, just like we shouldn't be asking "what, exactly, is a set, or a number, or a cubic root?". Perhaps we should be asking: Where, exactly, does intuition come from? http://www.vex.net/~trebla/weblog/intuitive.html It seems logically obvious to me: If you are learning something new to you, then by definition of "new to you", you are not supposed to have any intuition yet (any correct intuition anyway --- oh, the human brain is great at manufacturing all kinds of wrong intuitions). You are supposed to practice the rules a lot, and then you gain intuition. I am always fond of citing Chess as an example. I don't think any Chess teachers teach intuition first, rules later. I'm pretty sure it's the other way round. And most likely they don't even tell you the intuition "control the centre" until you've practiced a million hours or something. And then, I don't value intuition very highly, certainly not as highly as most other people. Intuition is a great accelerator when it's right, but you never know whether it's right a priori. Symbolic manipulation has the final say. And symbolic manipulation teaches you new, correct intuition sometimes. Regarding bind and join, I find bind more obvious for some examples, and join for some other examples. I'm sure it is subjective.

martin
x >>= f = join (fmap f x)
So you're really throwing symbols around?
When I do math, I do similar things. Particularly in algebra I don't ask myself what e.g. a cubic root does, because I know the laws of roots and I know what I can do with the symbols.
Not quite. Cube roots are a special case of roots. Here, I'm building bind out of two conceptually-simpler parts. Of course, it's subjective which is "simpler", but in any case we'll need to define fmap sooner or later, since all Monads must be Functors; we might as well use it!
In math, the only ways I know of to get a better intuition is practice and a good teacher. Maybe it is the same in haskell?
Practice definitely helps. I've managed so far without a teacher (does stackoverlow.com count as a teacher? ;) ) Cheers, Chris

martin wrote:
I am trying to understand the ideas of Koen Klaessen, published in Functional Pearls: "A poor man's concurrency" (1993).
The code in the paper doesn't compile. E.g. uses "lambda dot" instead of "labmda arrow", i.e. the way the labmda calculus guys write things. Was that ever legal haskell or is this the result of some lhs2lex pretty printer?
Anyways, I believe I was able to convert that into modern haskell syntax - at least it compiles. But I have trouble to understand the Monad instance presented there. Could anyobody walk me through the bind function?
But even more important: how do you guys develop an intuition about what the bind operator does in a specific monad.
I find it very helpful to think of monads as "lists of instructions". I have written a thorough and hopefully accessible explanation here http://apfelmus.nfshost.com/articles/operational-monad.html which also discusses a transparent implementation Koen Classen's parser combinators. From this point of view, the continuation monad corresponds to a particular list implementation, namely "difference lists". If you have trouble understanding the continuation monad, I would recommend to go via the "list of instructions" route, as it involves only functions of a less higher order. Best regards, Heinrich Apfelmus -- http://apfelmus.nfshost.com

martin wrote:
I am trying to understand the ideas of Koen Klaessen, published in Functional Pearls: "A poor man's concurrency" (1993).
Anyways, I believe I was able to convert that into modern haskell syntax - at least it compiles. But I have trouble to understand the Monad instance presented there. Could anyobody walk me through the bind function?
newtype C m a = C ((a -> Action m) -> Action m)
instance Monad m => Monad (C m) where (C m) >>= k = C cont where cont c = m (\a -> let C h = k a in h c) return x = C $ \c -> c x
data Action m = Atom (m (Action m)) | Fork (Action m) (Action m) | Stop
I find it easier to think about continuations when I remove the wrapping and unwrapping of the newtype. To further simplify things, we note that the above code makes no use whatsoever of the structure of 'Action m'. (In particular, the 'Monad m' constraint is not needed.) This means we can replace 'Action m' by a simple type variable 'w': type C w a = (a -> w) -> w The definition of >>= can then almost be derived from the types alone: m >>= k = ... We have m :: (a -> w) -> w and k :: a -> (b -> w) -> w, so m >>= k :: (b -> w) -> w We are given an f :: b -> w as argument and the only function we have that takes such a thing as an argument is k, which additionally has the right return type (namely w). We could be tempted to try r = k x f where ... with some x :: a as its first argument. However, we do not have a function that gives us an x :: a as result. Instead, let's take a look at what we do have. We already used the k, but not yet the m. The type of m tells us that it takes a function of type a -> w and returns some x :: w. With a bit of squinting, one sees that, if we abstract out the x from k x f, we get exactly what m takes as input: \x -> k x f :: a -> w and so the solution is clear: we apply the given m to this function, resulting in: m >>= k = \f -> m (\x -> k x f) If you re-add the newtype wrapping and unwrapping, this is exactly the same as your definition above. This is one answer to the question of how one can arrive at a suitable definition of >>= for the continuation monad. But it does not tell us anything about how to arrive at an intuition about what this implementation really does. Maybe someone else can explain this... Cheers Ben -- "Make it so they have to reboot after every typo." â Scott Adams

Benjamin Franksen
martin wrote:
I am trying to understand the ideas of Koen Klaessen, published in Functional Pearls: "A poor man's concurrency" (1993).
[...]
m >>= k = \f -> m (\x -> k x f)
If you re-add the newtype wrapping and unwrapping, this is exactly the same as your definition above.
This is one answer to the question of how one can arrive at a suitable definition of >>= for the continuation monad. But it does not tell us anything about how to arrive at an intuition about what this implementation really does. Maybe someone else can explain this...
Values of `Cont a` are functions in continuation-passing style. That is, they are functions that hand their results to a continuation passing function, instead of returning. I think the trickiness of this stuff has more to do with continuation-passing style in general and less to do with any inherent abstruseness of monadic bind. With some CPS familiarity, you can see that `m` is just a function that accepts a continuation, and `k` is a function that accepts the intermediate result and the next continuation. We know that our new CPS function is going to accept a continuation argument. We also know -- by the semantics of CPS -- that this continuation will be handed to `k`. So this CPS function \f -> m (\x -> k x f) says: given a continuation `f`, invoke `m` with a continuation that hands the intermediate result to `k` with the continuation `f`. You can see how a chain like (given the actual Monad instance) do x <- m1 y <- m2 x m3 y will expand into a CPS function that passes along the continuation such that `m3` is finally invoked with the continuation of the entire block. And then, the presence of the Monad constraint just makes it obvious that this can be used as a monad transformer. -- Mikael Brockman mikael@silk.co

Mikael Brockman
Values of `Cont a` are functions in continuation-passing style. That is, they are functions that hand their results to a continuation passing function, instead of returning.
Ehh, this should be something like "hand their results to explicitly passed continuation functions." Sorry for the confusion. :)
participants (9)
-
Albert Y. C. Lai
-
Benjamin Franksen
-
Chris Warburton
-
Chris Wong
-
Heinrich Apfelmus
-
Jerzy Karczmarczuk
-
Jochen Keil
-
martin
-
Mikael Brockman