Thoughts on monad-par

I’m thinking about implementing an API for parallel programming for Bluefin. Effect system seems like a nice home for the idea.

But.

There exist monad-par package that does this. I vaguely remember it being a poster child for Haskell, look what Haskell can do! Nowadays, I rarely see it being mentioned.

Are you using monad-par (or some alternative)? Why/why not? What would make you use it?

I’ll answer first. I have never used monad-par. I just don’t think about using it. It is a combination of, me mostly shoving stuff around in IO, not caring that much about performance, parallelism requiring benchmarks, laziness. I also suspect that giving it some thoughts and being better integrated into my main monad stack (or effect system) might change this.

4 Likes

Having briefly looked at the current documentation and original research article, I’ve noticed a similarity to the advent of seq in Haskell 1.3 - it originally was a method of the Eval type class, so any definition which tried using seq generically would have Eval appear in its context. Likewise for newFull, put and spawn:

newFull :: NFData a => a -> Par (IVar a)
put     :: NFData a => IVar a -> a -> Par ()
spawn   :: NFData a => Par a -> Par (IVar a)

with NFData needing to be added to the type-signature contexts of generic callers (or providing instances instead).

It seems reasonable…but it didn’t work “in the large” for Eval:

…and looking at all of its instances (over 100 of them!) listed in monad-par alone, relying on NFData so much must also be laborious at times, having to define extra instances for NFData or add it to contexts far and wide merely to use newFull, put or spawn.

1 Like

@atravers you make it sound as if NFData is something peculiar, specific to monad-par and not a cornerstone type class, instances of which are provided by pretty much every library out there.

3 Likes

It’s peculiar much like the Strict type class was in pH, as I dimly recall - the type system was being used to work around a limitation of the implementation; in pH, Strict was being used like the old Eval class - to constrain polymorphism.

For NFData, the deficiency is more operational: Haskell doesn’t have a primitive hyperstrict-evaluation function (e.g. compel :: a -> a) like Miranda™’s force.

Returning to theory: I once defined a Monomo type class:

newIORef   :: Monomo a => a -> IO a -> IO (IORef a)
readIORef  :: Monomo a => IORef a -> IO (IORef a)
writeIORef :: Monomo a => IORef a -> IO a -> IO ()

to work around not being able to use Haskell’s monomorphism restriction directly with mutable references in an attempt to solve the problem of polymorphic references (that once afflicted Standard ML). Just like Eval, it too started to be laborious “in the large”, with me having to placate GHC by adding instances here, there and elsewhere - something like:

newIORef   :: monomo a . a -> IO a -> IO (IORef a)
readIORef  :: monomo a . IORef a -> IO (IORef a)
writeIORef :: monomo a . IORef a -> IO a -> IO ()

would have been simpler.

So if compel :: a -> a did appear soon in a version of GHC, it would be interesting to see how many of those instances of NFData now provided by pretty much every library out there would continue to exist.

@atravers Thanks. I understand your point, but on the other hand, what can be done in Haskell today?

I see NFData as a helpful interface, so that the library can force threads to do the actual work, instead of returning thunk, making threading pointless. But it is a choice, that can be left for users to figure out. And to be fair, there are NFData-less variants of functions in monad-par. Yet none of their users are here :slight_smile: .

In your opening post, you asked these questions:

  1. Are you using monad-par[…]?

  2. […] why not?

  3. What would make you use it?

To clarify my previous responses:

  1. No.

  2. Because of the need to either:

    • add NFData contexts to the type signatures of generic callers;
    • or define extra instances where monad-par definitions are used.
  3. An alternative to NFData (such as my suggestion - compel :: a -> a, a primitive hyperstrict-evaluation function), much the same way an independent primitive seq was the chosen alternative for Eval in Haskell 98.


Now to respond to your subsequent post:

  • […] what can be done in Haskell today?

    Without something like compel, NFData is probably the least-worst option.

  • I see NFData as a helpful interface, so that the library can force threads to do the actual work, instead of returning thunks, making threading pointless.

    Eval was also intended to be helpful.

  • But it is a choice, that can be left for users to figure out.

    From what I’ve read, there was nothing preventing users of Eval from defining a library module for it and using that instead of the primitive seq. But most chose the new primitive.

  • And to be fair, there are NFData-less variants of functions in monad-par.

    But those variants are only head-strict - “tail-thunks” would be left unevaluated, thereby making threading “partially-pointless”.

this library is implementing parallelism for pure computations?
i thought the threaded runtime already did that?
why would i want to micromanage my program’s execution?

why would I want to micromanage my program’s execution?

Why indeed:

But the threaded runtime system of GHC doesn’t (yet) work like that - it relies instead on the appearance of calls to par (and sometimes pseq) in Haskell sources, which can be tedious to always use correctly:

1 Like

I don’t think using NFData is a problem in practice and I’ve never seen anyone complain about it before. One advantage of it being a class is that implementations can keep thunks that are used by the structure of the type (one example being Seq). The reason monad-par uses NFData is to avoid bugs where runPar only evaluates to WHNF, doing almost no work.

Even if NFData was a problem, I don’t think it would be fair to blame libraries for not using a nonexistant alternative (there’s not even a proposal for it!).

I’ve used it a bit, but I found it a bit unergonomic that everything is wrapped in a Par monad, so you can’t easily compose it with pure functions. In my micro-benchmarks I also found it to be quite slow, but take that with a grain of salt. An alternative is parallel, which provides “strategies” that give you precise control over how and when to evaluate your data. It relies on laziness instead, so you can do something like x `par` f x which will start evaluation of x in parallel, until it is needed by f. This also makes it harder to get right though. It also provides an Eval monad that has a similar interface to Par.

However, parallelism has an overhead, so it often actually makes your program slower. It’s hard to know when exactly it provides a speedup. Another approach to parallelism is massiv, a multi-dimensional array library, that automatically parallelizes most of its operations (this works much better IME).

Automatically letting the compiler parallelize your pure functions seems like a really bad idea, due to the reasons above.

1 Like

I don’t think using NFData is a problem in practice and I’ve never seen anyone complain about it before.

And you still haven’t - my comments are not complaints but observations: there are certain similarities between the (old, pre-H.98) Eval, Monomo (by me), and NFData which I’ve noted.


Even if NFData was a problem, I don’t think it would be fair to blame libraries for not using a nonexistent alternative (there’s not even a proposal for it!).

Proposals - you mean like this one:

“going nowhere fast” for over five years? Yeah, that’s working really well.


Automatically letting the compiler parallelize your pure functions seems like a really bad idea […]

Some people still think that automatically letting the compiler manage the program’s heap memory is also a really bad idea. But the rest of us are willing to let the compiler do just that anyway.

Likewise for parallelism…elsewhere:

But this is starting to drift away from the original topic:

Are you using monad-par (or some alternative)?

I have never used monad-par, not even just to experiment with. These days I will occasionally use the massiv library or, less commonly but more happily, par and seq. Related to par and seq is the parallel package, which is more theoretically appealing to me than monad-par, but I have never actually had a reason to use it in anger. That’s about it as far as parallelism for me.

Why/why not?

From the very beginning, I felt like its interface was too imperative for my tastes. Explicitly getting and setting from mutable references may be something I do occasionally, but parallelism is supposed to be something that purely functional programming is theoretically great for (although, admittedly, there is some misalignment between theory and practice so far), so ivars, especially with restrictions that result in runtime exceptions if you violate them, don’t hold much appeal for me.

What would make you use it?

I think it is just not the abstraction I’m looking for, so anything that would make me use it would change it at such a fundamental level as not be monad-par anymore.


I vaguely remember it being a poster child for Haskell, look what Haskell can do!

Although I do remember a bit of promotion for it, and some due attention simply because of its author’s reputation, I do not remember it ever holding “poster child” status. IMO, there are two (kind of weak) candidates as poster children for parallelism with Haskell:

  • par (i.e., sparks)
  • “data parallelism.” Although the exact library/research getting the most hype has changed a few times, I remember being very excited about the now-abandoned nested data parallelism research, and there have been some interesting libraries for non-nested parallelism, like accelerate, repa, and massiv, the latter being the one I currently view most favorably.

I know the topic here is parallelism, not concurrency, but I’ll add that I think there is a lot more convergence on what the poster children in the area of concurrency are. There are several, but I would say the ones that stand out the most are:

  • GHC itself, for its excellent support for lightweight threads
  • STM

There are other indispensable things in this space, but they feel a bit less unique to Haskell, so I would not go as far as to call them poster children.