Why are there so many libraries for algebraic effects?

Say I was on the moon for the last 10 years and now I have landed back on Earth. Immediately I check on the state of the Haskell ecosystem. I observe that there are many «effect» libraries out there now, while 10 years ago the idea was known to few.

One thing that makes me suspicious is the apparent absence of universality. For instance, there is only one Either monad in the world — you can change the names, but the two will be interchangeable. We only have one StateT, only one Witherable, and so on. (If there were two, they would be interchangeable.) What is it about algebraic effects that makes it profitable to have more than one implementation?

As Andrej Bauer explains, the whole deal with algebraic effects is the «free model» thing. As he says, computations are free models of an algebraic theory. And surely all free models of a given theory are interchangeable — the free model construction is universal.

So, what is going on?

This reminds me of the situation with functional reactive programming, which started simple and ended in a situation of a thousand different, variously motivated approaches. The issue with functional reactive programming is that it does not explain how to work with time-varying values that are constructed and destructed unpredictably, depending on other time-varying values. This is the fatal flaw that ruined everything. Is there, likewise, a fatal flaw in the theory of algebraic effects?

Another possibility is that we have a case of computer programmers ruining something beautiful out of ignorance, as they tend to do. When we say «effects», are we talking about algebraic effects in the same sense as Andrej in the link above? Or are we talking about some hodgepodge of informal design patterns and best practices?

A third explanation I have on my mind is that implementing algebraic effects requires «fancy type level magic» like type level sets, extensible records, type level lists and such. There is no good way to work with these things in Haskell, and confusion about «dependent types» abounds. Maybe this is the problem?

4 Likes

Only denotationally, not operationally. Different free models can have different performance characteristics. Furthermore, people have figured out that restricting the expressiveness of the theories (e.g. disallowing nondeterminism) can allow for significantly more performant models.

13 Likes

Do you have some concrete example for us to think about?

1 Like

If denotation is the same, there should be only one library for denoting «effective» programs with many different plug-in «operationalizations» on offer, so that I can run my program in any of a variety of ways. Is this the case? If it is not the case, why not?

people have figured out that restricting the expressiveness of the theories (e.g. disallowing nondeterminism) can allow for significantly more performant models

Curious! Where can I read about this? Do you have something specific in mind that is already available for Haskell? Or, are you saying that many of the effect libraries we have in Haskell work with variously restricted theories? Is there some «base line» set of theories that any library can understand?

Well that’s just not true. You can implement Either/ExceptT on top of pattern matching or IOExceptions (which will behave differently), you can implement StateT with functions or IORefs/MVars/TVars/…, there are famously several incompatible implementations of ListT with varying levels of quality. MTL alone has 3 implementations of WriterT!

The fundamental ideas are pretty universal (that’s why every effect system has Reader, Writer, State, etc. effects) but they have wildly different implementation strategies with different trade offs.
Dismissing those because monad transformers got popular first seems a little unfair.

E.g. free monads are, frankly, a pretty bad implementation that fundamentally adds a ton of overhead to every operation regardless of the effects it actually performs.

9 Likes

Do you have some concrete example for us to think about?

Examples of fancy types used to implement algebraic effects, you mean? I do not say that fancy types are necessary, but it seems plausible that they are. One specific example is the article Freer Monads, More Extensible Effects — it defines and uses a «type-aligned sequence».

1 Like

I can be wrong, of course. But in this case I think we have a misunderstanding and most likely we are both right but with different assumptions.

Well that’s just not true. You can implement Either/ExceptT on top of pattern matching or IOExceptions (which will behave differently), you can implement StateT with functions or IORefs/MVars/TVars/…, there are famously several incompatible implementations of ListT with varying levels of quality. MTL alone has 3 implementations of WriterT!

All three implementations of WriterT are interchangeable, as far as I know. If a program terminates, it will terminate with the same value, no matter which you use. If this is not the case, I should be alarmed.

As for StateT, it has no IO in its type signature, so the only way you can define it with mutable variables is by going around the type checker. Right? To my mind, StateT is that monad transformer which arises from the curryuncurry adjunction in the unique way. Which way it is executed by the computer is to me a secondary question. If a more efficient version that uses unsafePerformIO gives me different results for some programs than a pure and simple StateT I can define myself in an evening, then I shall request that the more efficient version be called something else.

Dismissing those because monad transformers got popular first seems a little unfair.

Am I dismissing anything? Or are you referring to something written elsewhere? Who dismisses algebraic effects because of monad transformers?

I am not dismissing anything. I am here because I woke up today with a strong desire to write a program that uses algebraic effects instead of monad transformers, and then I found myself lost.

I also understand the need for more than one implementation. For instance, having a lazy and a strict version of Writer is good and necessary. But they are interchangeable. They live in the same library. Not so with algebraic effects.

2 Likes

In what way are you lost? Perhaps I can help you write your program using Bluefin.

3 Likes

There are also at least two StateTs: Lazy and Strict. They are not interchangable!

2 Likes

Adding to the fray here…

What is the nature of “seq”, “pseq/par”, “lseq” combinators? Are they completely independent concepts/mechanisms of effects, per se?

1 Like
  • Like FRP, the concepts are new and still evolving.
  • There are lots of inherent trade offs in the space. Each library explores different approaches. For example, lens and optics both exist for a reason - neither is truly better than the other.
  • People probably have fun writing these libraries. I know a lot of “serious” Haskellers have taken to maligning the “fancy” Haskeller who does advanced Haskell for advanced Haskell’s sake, but it’s a legitimate reason.
6 Likes

Let me answer point by your point.

  • I do not think it is fair to say that functional programming is new and still evolving. What is the news of the last year? I may have missed something, but I really do not see any new hope. For specificity, the first release of elerea is published in April of 2009 — how long can something be called «new» for? I shall be very happy if you tell me I missed everything great happening in this area for the last few years. I very much want to see a great unifying view on functional reactive programming.

  • As to lens and optics — my understanding is that there are several different but interchangeable presentations of the same thing. There is the «explicit» presentation as a view function and a set function, there is the «function» presentation as a function of type (a → F b) → (c → F d), and then there is the «profunctor» presentation used in optics. Somewhere in literature I expect to be a proof that all three are interchangeable with one another — I was digging into it a year ago or so and I do not recall the details now, but I believe. What is important is that there are as many libraries as there are big mathematical ideas. (Well, and microlens on top.) If the same is the case for effect libraries, I want to know what the big mathematical ideas are!

  • I can accept that people have fun writing these libraries, but then I want to know what is fun about each of them, and whether they are all fun in the same way or in different ways.

There’s various free monads, the more recent phantoms over what is essentially ReaderT IO, even in that there’s trade offs in data structures (cleff vs effectful), there’s the new ideas with continuations, and my understanding is there is research still to be done. That’s plenty of knobs to twiddle.

Not sure what your wish is here. I really doubt Haskell will coalesce around an effects library anytime soon. It’s more like streaming libraries -
there’s gonna be a handful and the ecosystem is gonna be split. Some people consider that bad but it isn’t objectively true - just opinion.

1 Like

I am confident that I can write my program using Bluefin. As far as I can judge, it is excellently programmed and documented, so I do not foresee any issues.

What I am trying to explore here is a more general and fundamental angle.

But let me be specific, so that we are on the same page.

Bluefin is an effect system which allows you to freely mix a variety of effects …and to create your own effects in terms of existing ones (…). Bluefin effects are accessed explicitly through value-level handles.

Bluefin

This does not explain anything to me. I can infer that there is this kind of thing called «effect», that you can compose these «effect» things and that you can «access» them «explicitly» through «value»-level «handles». Rarely have I met such a confusing sentence.

I can try to compare this with Oleg’s «more extensible effects» that I am acquainted with through the article on his web site that I linked above in this thread, but he talks about «effect handlers», not «handles». Then there is Jasper’s article about something he calls «the handle design pattern» — but he mentions it in contrast to, among other things, effect systems! The way I understand it, the handle design pattern is the same as the ReaderT IO design pattern, but with the function representation of ReaderT instead of a new type.

I can infer that there are type-level handles somewhere but I do not recall ever seeing a type-level handle in my life (nor a value-level one).

I think maybe you want the reader to assume that what you call «effect» here is the same as what Eugenio calls «side effects» in his foundational article. But it does not quite align. I do not think Eugenio had streams and pure state in mind when he was saying «side effects». I imagine if I read 10 more research articles on effect systems I shall understand what you have in mind. But could there be a simple, one paragraph definition? Like so:

definition 1 an effect is …

Ideally I want to see some categorial semantics… A commutative diagram… A natural transformation… An indexed family of functions… Some solid ground. Something basic. Something that does not refer to a myriad of formless assumptions in a post-modern way.

Can you help me with this?

1 Like

There’s various free monads …

No! There is only one free monad arising from any given functor! It is a universal construction! There are many ways to encode the free monad construction in software. But they are all interchangeable.

Aside: my understanding is that free monads are not the same as monads arising from free models of algebraic theories. Correct me if I am wrong about this.

What my wish here is answers that are not the warm and fuzzy type. I get enough warm and fuzzy answers in the JavaScript land. In the Haskell land, I want hard and cold answers made from the strongest steel of logic. Are all «effect systems» interchangeable and, if so, how exactly does the underlying universal construction manifest in software?

There are also at least two StateTs: Lazy and Strict. They are not interchangable!

It is the same construction, only evaluated with different evaluation strategies. Saying there are two StateTs is like saying there are two [ ]'s. You can make a type of lists that are strict in every element. Or in every second element. Or in every third element. And so on. Would you say we have ℕ types of lists?

What I am saying is perhaps not very clear. Let me try again.

You are of course right to say that there are two different state monad transformers. But you would also be right to say that the only difference between them is the order of evaluation. We can produce any number of types by varying order of evaluation. For a tuple of N elements, we can offer N → 2 different ways to put strictness annotations in them. Do you want to talk about 1024 different types of tuples of length 10?

We have a much bigger fish to fry here. The state monad transformer arises from the curryuncurry adjunction (and we can at our leisure enumerate all of its strictness variations). What do the many effect system libraries arise from?

Right but it’s those different encodings that beget the various libraries.

2 Likes

Haskell doesn’t offer cold hard answers. That’s the biggest issue I see with people using Haskell - they think there’s one true solution they’re trying to uncover.

Good Haskell is about taste and tradeoffs and aesthetics as much as it is about the math-y stuff. So it’s plenty warm and fuzzy. (Doesn’t mean it’s on the level of JS tho lol.)

4 Likes

it’s those different encodings that beget the various libraries

This is what I want to know about. What are the different encodings, and what are they encoding? Is there anything specific you can tell me? I pray you, do not keep me in the dark.

For example, does Bluefin encode free models of algebraic theories? Or does it encode something else? Non-free models? Of non-algebraic theories? What?

Haskell doesn’t offer cold hard answers. That’s the biggest issue I see with people using Haskell - they think there’s one true solution they’re trying to uncover.

Good Haskell is about taste and tradeoffs and aesthetics as much as it is about the math-y stuff. So it’s plenty warm and fuzzy. (Doesn’t mean it’s on the level of JS tho lol.)

I hear you, but I do not want to either agree or disagree with you right now.

2 Likes

Great! Well, do drop me a line if I can be of any help with anything.

“Effect system” is not something precisely defined, so it’s not clear whether “the handle pattern” is a rudimentary effect system or not. I would say that it is.

If you have used effecful then you have seen a type-level handle. Consider an effectful constraint State Int :> es, and observe the role :> plays; it encodes an Int:

class (e :: Effect) :> (es :: [Effect]) where
  -- | Get the position of @e@ in @es@.
  --
  -- /Note:/ GHC is kind enough to cache these values as they're top level CAFs,
  -- so the lookup is amortized @O(1)@ without any language level tricks.
  reifyIndex :: Int

That Int is the position of e in es, so e :> (e : es) encodes 0, e :> (e1 : e : es) encodes 1, etc. What are these Ints? They are indices into arrays in the Env (itself inside effectful’s monad Eff):

newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)

data Env (es :: [Effect]) = Env
  { envOffset  :: !Int
  , envRefs    :: !(PrimArray Int)
  , envStorage :: !(IORef Storage)
  }

-- | A storage of effects.
data Storage = Storage
  { stSize      :: !Int
  , stVersion   :: !Int
  , stVersions  :: !(MutablePrimArray RealWorld Int)
  , stEffects   :: !(SmallMutableArray RealWorld Any)
  , stRelinkers :: !(SmallMutableArray RealWorld Any)
  }

I don’t recall which array it is an index into (probably envRefs?) but in any case, the value at that index is used to determine how to perform some effect, i.e. it’s an effect handle.

So, I call State Int :> es a type-level effect handle. This corresponds to Bluefin’s State Int e, which is a type not a constraint, so its values are value-level effect handles. I’m not sure this is standard terminology, but it’s the terminology I use.

In fact that seems to be precisely what he meant!

side-effects T A = (A × S)^S , where S is a set of states, e.g. a set U L of stores or a set of
input/output sequences U∗

So, what Haskellers call “effects” is far broader than Moggi’s “side-effect”. Exceptions are “effects” for Haskellers. For Moggi it seems they’re just exceptions. Anyway, Moggi is more about semantics than programming languages, so I’m not sure it’s of much help. It was Wadler, as far as I know, who introduce monads to programming language practice.

Probably not, unfortunately, no more than I can help you with what a function is. Of course, I could say “it’s a mathematical function, as axiomatized by set theory”, but that doesn’t help with operational semantics, polymorphism (see Reynolds) or what C programmers call “functions”.

Up to isomorphism. Yet your isomorphism ignores a great deal of structure, including operational semantics.

Unfortunately, I think your wish will go unfulfilled, for now. I know of know precise definition of “effect” or “effect system”.

No, effect systems that are IO wrappers (Bluefin, effectful, ReaderT IO, etc.) can only deal with effects that have at most a single continuation. Most effects have a single continuation, exceptions have zero. Therefore IO wrapper effect systems cannot handle the style of “non-determinism” as seen in LogicT.

(And if you don’t ignore operational semantics, then of course they have all sorts of performance differences, and differences in the way they interact with Haskell’s RTS. For some discussion of the latter, see effectful’s docs.)

And indeed a type of lists that’s strict in the spine, or only part of the spine …

I think you mean 2^ℕ types of lists. Yes, I would say that. I’d also say that they are all lists.

Yes, why not? And they are all still tuples of length 10.

I’ve never found this a useful way of thinking. What non-trivial conclusion have you obtained from that knowledge?

I don’t know what that means, but I doubt it. It may well encode free and non-free models of certain algebraic theories. They will be ones that correspond to zero-or-one shot continuations.

I don’t know what they’re encoding, but something that you might like is that I draw a distinction between “synthetic” and “analytic” effect systems.

Transformers are “synthetic”. They build “effects” from language primitives and allow you to compose them. For example, StateT s (ExceptT e (Reader r)) a is an algebraic data type, just formed from the language primitives sums, products and exponentials.

By contrast, Bluefin and effectful are “analytic”. They are simply IO underneath. The kitchen sink. The whole world. There is no attempt to synthesise from smaller pieces. On the other hand, they analyse individual pieces of IO and determine how they can be partitioned into small pieces that correspond to the primitives of the synthetic approach. Thus, they come to roughly the same end building on a different basis.

8 Likes