Faster implementation for Free

[thomashoneyman]

I tested a new implementation for Free when benchmarking Halogen Hooks and found it sped up the library (and Halogen) by as much as 25% while using less memory.

This PR adds this new implementation while preserving the existing API. The benchmarks prove the new implementation is significantly more performant than the existing v5.2.0 implementation -- an even greater performance difference than between the current version and v0.6.1 (see benchmarks below).

That means Halogen, Run, and other Free-based applications will see a nice performance boost going forward.

API Changes

This PR preserves the existing API and introduces three new functions: run, interpret, and interpretRec.

Of these functions, interpret is a drop-in replacement for substFree and for foldFree, and interpretRec is a drop-in replacement for foldFree (with the MonadRec constraint).

I think these names better indicate what the functions are for (interpreting a Free structure into another monad or Free structure, or doing the same thing except with a MonadRec constraint). substFree and foldFree still exist, just with a deprecation warning. If desired, I can remove the deprecation warnings and only add the interpret function.

In the future I think we should adopt more of @natefaubion's implementation, which I can put in a separate issue. In my opinion it provides an API with simpler, more approachable naming conventions than those which currently exist. Specifically, it drops suffixes except for functions which have a MonadRec constraint, so:

liftF -> lift
suspendF -> suspend
hoistFree -> hoist
runFree -> run
runFreeM -> runRec

In addition, the substFree and foldFree functions are renamed to better clarify what they're doing:

substFree -> interpret
foldFree -> interpretRec

However, I think these changes are worth exploring in a separate proposal because they would be breaking changes.

Notes

• Only commits from 3bf25fa onward are relevant to this PR. The prior commits are the same as Update benchmarks #103, which just fixes the benchmarks but doesn't change any of the implementations. You might want to look at the diff with only that PR in mind.

• To avoid too many breaking changes I've added a Compat module for any modules which would no longer work in user code. These Compat modules can be directly dropped in to preserve existing behavior in libraries and applications. But I think they should be removed in a future version. I have instead preserved the existing API.

Benchmark Results

(Note: v6.0.1 stack overflows on this benchmark, so we're only comparing this implementation to the current v5.2.0 implementation)

[thomashoneyman]

As I look at this again -- Free is exported without constructors, so it might be safe for me to just directly drop in this new implementation of Free in the modules where it was previously used, which would cut down on the Compat modules quite a bit.

[safareli]

It seams that if you have:

loop x = Free.pure (x + 1) >>= loop
oops = loop 0

oops will blow the stack, before it's even interpreted.

[natefaubion]

That will always happen. You are building an infinite tree strictly since there’s no eta expansion within loop.

[safareli]

Ok, but here it's eta expanded version:

loop x = Free.pure (x + 1) >>= \k => loop k
oops = loop 0

Because bind is implemented like this: bind (Pure a) k = k a I suspect it will blow stack, wouldn't it?

[thomashoneyman]

A couple of updates for y'all:

• In 6180532 I changed the Compat modules so that they only preserve the prior API but re-use the new implementation. This is possible because Free's constructors were never exported, so this isn't breaking. This greatly reduces the number of affected modules.
• In 9377e08 I added back the missing instances for Eq, Ord, Eq1, Ord1, Foldable, Traversable, Semigroup, Monoid, MonadRec, and MonadTrans. It's not clear to me that all of these instances are necessary, but removing any of them would be a breaking change not addressable via a Compat module now that the same implementation is reused there.

At this point, beyond any discussion we need to have about potential issues with the implementation itself, it really comes down to whether these API changes are palatable or not. If they aren't, then I'd like to see where we can meet in the middle on some of these function renames and changes.

[natefaubion]

Because bind is implemented like this: bind (Pure a) k = k a I suspect it will blow stack, wouldn't it?

Ah, yep! That's a great point. It needs to just be suspended as a bind instead of taking a shortcut.

[thomashoneyman]

I have reverted changes that would break the existing API. I'm still of the opinion we should make those changes, but I shouldn't have pushed to make them in this PR. I've updated the PR description with details:

#104 (comment)

This PR now offers a performance improvement without breaking changes.

[thomashoneyman]

@natefaubion @safareli I've verified that this blows up (at compile time):

loop x = Free.pure (x + 1) >>= \k => loop k
oops = loop 0

I'm not quite sure how to suspend Pure as a bind; while k can be dealt with the same as the existing Bind implementation, a is not so simple.

Here's the existing implementation (source):

instance bindFree :: Bind (Free f) where
  bind (Pure a) k = k a
  bind (Bind a bs) k = Bind a (Node (unsafeCoerce bs) (Leaf (unsafeCoerce k)))

I can partially rewrite this as:

instance bindFree :: Bind (Free f) where
  bind (Pure a) k = Bind (?wat a) (Leaf (unsafeCoerce k))
  bind (Bind a bs) k = Bind a (Node (unsafeCoerce bs) (Leaf (unsafeCoerce k)))

producing the error

Hole 'wat' has the inferred type
                             
  a0 -> f1 UnsafeBoundValue
                             
You could substitute the hole with one of these values:
                                                     
  Unsafe.Coerce.unsafeCoerce  :: forall a b. a -> b
                                                     
in the following context:

  a :: a0
  k :: a0 -> Free f1 b2

in value declaration bindFree

---

I'm open to suggestions on how to address this, and I'll keep working on it on my own!

[safareli]

This shouldwork but it might not be as elegant

= Pure a
+  | BindPure UnsafeBoundValue (FreeBinds f UnsafeBoundValue a)
 | Bind (f UnsafeBoundValue) (FreeBinds f UnsafeBoundValue a)

[thomashoneyman]

@safareli That's a good idea. I gave it a try and I was able to get it working except for one place -- resume':

resume'
  :: forall f a r
   . (forall b. f b -> (b -> Free f a) -> r)
  -> (a -> r)
  -> Free f a
  -> r
resume' bind' pure' = case _ of
  Pure a -> pure' a
  BindPure a bs -> bind' ?a (go1 bs)
  Bind a bs -> bind' a (go1 bs)
  where
  go1 :: forall x y. FreeBinds f x y -> x -> Free f y
  go1 bs x = case bs of
    Leaf k -> k x
    Node l r -> case uncons l r of
      FreeCons k bs' -> case k x of
        Pure a -> go1 bs' a
        BindPure a bs'' -> BindPure a (Node bs'' bs')
        Bind a bs'' -> Bind a (Node bs'' bs')
    Hoist nat bs' ->
      go2 nat bs' x

  go2 :: forall g x y. (UnsafeBoundF ~> g) -> FreeBinds UnsafeBoundF x y -> x -> Free g y
  go2 nat bs x = case bs of
    Leaf k -> hoistFree nat (k x)
    Node l r -> case uncons l r of
      FreeCons k bs' -> case k x of
        Pure a -> go2 nat bs' a
        BindPure a bs'' -> BindPure a (Hoist nat (Node bs'' bs'))
        Bind a bs'' -> Bind (nat a) (Hoist nat (Node bs'' bs'))
    Hoist nat' bs' ->
      go2 (nat <<< nat') bs' x

That's quite a bit of code -- this is the excerpt worth looking at:

resume' bind' pure' = case _ of
  Pure a -> pure' a
  BindPure a bs -> bind' ?a (go1 bs)
  Bind a bs -> bind' a (go1 bs)
  where
  ...

which produces the following error with the typed hole:

Compiling Control.Monad.Free
Error found:
in module Control.Monad.Free
at src/Control/Monad/Free.purs:232:26 - 232:28 (line 232, column 26 - line 232, column 28)

  Hole 'a' has the inferred type
                       
    f0 UnsafeBoundValue
                       
  in the following context:

    a :: UnsafeBoundValue
    bind' :: forall b. f0 b -> (b -> ...) -> r2
    bs :: FreeBinds f0 UnsafeBoundValue a1
    go1 :: forall x y. FreeBinds f0 x y -> x -> Free f0 y
    go2 :: forall g x y. NaturalTransformation UnsafeBoundF g -> FreeBinds UnsafeBoundF x y -> x -> ...


in value declaration resume'

...which feels like the same issue, deeper in the code. This possibly means that pure' and bind' are not enough and a third function is required, which would introduce the only breaking change in the PR. However, I might be missing something else simple :)