Stream fusion #27

dagit · 2021-07-26T18:31:35Z

Aside from the lack of tests, do you have any objections to me merging this? @treeowl

As an aside, I see tests as a requirement for the next release. So they're definitely on my mind. I've just been sort of obsessed with closing the performance gap. Although, if we can reliably be within 2x of LogicT that's close enough for now.

dagit · 2021-07-26T18:32:52Z

src/Control/Monad/Logic/Sequence.hs

  , getSeq
 #endif
  , View(..)
+  , alt


I'm not sure if I actually want to export alt, asumSeqT, and chooseSeqT. I think I mainly added them to test things when rewrites were not working for me.

dagit · 2021-07-26T18:33:37Z

src/Control/Monad/Logic/Sequence/Internal.hs

 -- so as to be more efficient in the face of deeply left-associated `<|>` or
 -- `mplus` applications.
-newtype SeqT m a = SeqT (Queue (m (View m a)))
+newtype SeqT m a = SeqT { runSeqT :: (Queue (m (View m a))) }


I don't think I ended up using runSeqT in code, but I keep adding it because generally I feel like it's nice to have named projections like this.

Wouldn't unSeqT be more idiomatic these days? I'm not sure there's much point adding a record selector like that for an internal type, but it's your call of course.

dagit · 2021-07-26T18:34:08Z

src/Control/Monad/Logic/Sequence/Internal.hs

+
+{-# RULES
+      "stream-unstream" [2] forall s. stream (unstream s) = s;
+      "toView-fromView" [1] forall s. fromView (toView s) = s;


I should probably remove this one

treeowl · 2021-07-26T18:35:36Z

Let me finish up my current PR, which adds instances and some basic tests, though not as many as it needs. Then I'll happily take a closer look at this PR and then hopefully add some more tests before release.

dagit · 2021-07-26T18:36:01Z

src/Control/Monad/Logic/Sequence/Internal.hs

+
+done :: Monad m => StreamM m a
+done = StreamM (const (return Done)) Empty
+{-# INLINE CONLIKE [0] done #-}


I think CONLIKE is justifiable here given that everything here is non-polymorphic and concretely specified. So no surprises right?

dagit · 2021-07-26T18:36:18Z

src/Control/Monad/Logic/Sequence/Internal.hs

+      Done -> Skip (Boundary s_a)
+{-# INLINE[1] bind_s #-}
+{-
+bind_s :: Monad m => StreamM m a -> (a -> StreamM m b) -> StreamM m b


oh and I can delete this.

treeowl · 2021-07-26T18:53:27Z

How is that concrete? It has a Monad constraint!

…

On Mon, Jul 26, 2021, 2:36 PM Jason Dagit ***@***.***> wrote: ***@***.**** commented on this pull request. ------------------------------ In src/Control/Monad/Logic/Sequence/Internal.hs <#27 (comment)>: > - Empty -> return Empty - h :< t -> f h `altView` (t >>= f) - - {-# INLINEABLE (>>) #-} - (toView -> m) >> n = fromView $ m >>= \x -> case x of - Empty -> return Empty - _ :< t -> n `altView` (t >> n) + (>>=) = bind + +bind :: Monad m => SeqT m a -> (a -> SeqT m b) -> SeqT m b +bind m f = unstream (bind_s (stream m) (stream . f)) +{-# INLINE[3] bind #-} + +done :: Monad m => StreamM m a +done = StreamM (const (return Done)) Empty +{-# INLINE CONLIKE [0] done #-} I think CONLIKE is justifiable here given that everything here is non-polymorphic and concretely specified. So no surprises right? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#27 (review)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AAOOF7JFXDCTKQ7EOZNHCFDTZWTJZANCNFSM5BAUVYLQ> .

dagit · 2021-07-26T18:55:42Z

How is that concrete? It has a Monad constraint!
…
On Mon, Jul 26, 2021, 2:36 PM Jason Dagit @.> wrote: @.* commented on this pull request. ------------------------------ In src/Control/Monad/Logic/Sequence/Internal.hs <#27 (comment)>: > - Empty -> return Empty - h :< t -> f h altView (t >>= f) - - {-# INLINEABLE (>>) #-} - (toView -> m) >> n = fromView $ m >>= \x -> case x of - Empty -> return Empty - _ :< t -> n altView (t >> n) + (>>=) = bind + +bind :: Monad m => SeqT m a -> (a -> SeqT m b) -> SeqT m b +bind m f = unstream (bind_s (stream m) (stream . f)) +{-# INLINE[3] bind #-} + +done :: Monad m => StreamM m a +done = StreamM (const (return Done)) Empty +{-# INLINE CONLIKE [0] done #-} I think CONLIKE is justifiable here given that everything here is non-polymorphic and concretely specified. So no surprises right? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#27 (review)>, or unsubscribe https://github.com/notifications/unsubscribe-auth/AAOOF7JFXDCTKQ7EOZNHCFDTZWTJZANCNFSM5BAUVYLQ .

As it turns out, I can't use a rewrite rule to replace asum with asumSeqT because asum gets rewritten too early. And having it doesn't appear to give better performance in my benchmark so I think the other inlining and rewrites are good enough. And getting rid of asum means I can get rid of `done.

dagit · 2021-07-26T18:57:08Z

I just pushed a new version that should be cleaner.

dagit · 2021-07-26T19:46:54Z

src/Control/Monad/Logic/Sequence.hs

  , observe
  , observeMaybeT
  , observeMaybe
+  , chooseSeqT


Is there a better name for this? The only reason we provide it as a "primitive" is so we can write it in a way that take advantage of the internals, but maybe choose (without the SeqT) is a better name?

dagit · 2021-07-26T19:47:38Z

src/Control/Monad/Logic/Sequence/Internal.hs

+stream m = StreamM next m where
+  {-# INLINE next #-}
+  next s = do
+    x <- toView s


My kingdom for an <$>....

I think it's better this way. fmap would introduce laziness I'm guessing we don't want.

dagit · 2021-07-26T19:55:54Z

Maybe I should try writing fmap_s and making that fusable too. Any other functions in here that could benefit from it?

treeowl · 2021-07-26T19:57:48Z

I still haven't read this PR. Will try to do so shortly, but also want to work on my own!

…

On Mon, Jul 26, 2021, 3:56 PM Jason Dagit ***@***.***> wrote: Maybe I should try writing fmap_s and making that fusable too. Any other functions in here that could benefit from it? — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub <#27 (comment)>, or unsubscribe <https://github.com/notifications/unsubscribe-auth/AAOOF7P4JOE56EVIY4JIKXTTZW4VJANCNFSM5BAUVYLQ> .

treeowl

I'm not really convinced yet.

treeowl · 2021-07-27T22:00:42Z

src/Control/Monad/Logic/Sequence/Internal.hs

+      Empty -> go t
+      hi :< SeqT ti -> return (hi :< SeqT (ti S.>< t))
+{-# INLINE[0] toView #-}
+


What's go for? Can you just use INLINABLE[0] with the original?

I get a little fuzzy on which things I individually benchmarked, but I would have sworn writing it this way generates slightly faster code and it's just a difference of one line, right?

It's the least of my worries.

treeowl · 2021-07-27T22:03:50Z

src/Control/Monad/Logic/Sequence/Internal.hs

+stream m = StreamM next m where
+  {-# INLINE next #-}
+  next s = do
+    x <- toView s


I think it's better this way. fmap would introduce laziness I'm guessing we don't want.

treeowl · 2021-07-27T22:20:39Z

src/Control/Monad/Logic/Sequence/Internal.hs

-{-# INLINE altView #-}
+alt :: Monad m => SeqT m a -> SeqT m a -> SeqT m a
+alt a b = unstream (alt_s (stream a) (stream b))
+{-# INLINE[3] alt #-}


I'm quite concerned that this approach may cause asymptotic performance trouble in the face of lots of <|> (associated various ways, and especially recursive).

Yeah, I'm curious about that case too. My simple benchmark does an iterative deepening search. And then I convert the generated values to a streamly stream. That conversion can either be done using something like observeAll or msplit with unfoldrM. It's the program where I originally discovered the quadratic slowdown in LogicT. So I've been using that to get a sense of whether our <|> implementation is dealing well with associativity.

For the version here there's no runtime difference between using msplit vs. observeAll for SeqT. Have you looked in bench? Do any of those cover the case you are imagining? It's a little bit hard to get a graph from those benchmarks so I haven't been running those between changes (also they take forever to run). But I would like to be able to answer question like this using benchmarks as a sort of ground truth on runtime.

treeowl · 2021-07-27T22:28:14Z

I haven't read everything, but this proposal smells like a streamy version of the classic

newtype ML m a = ML (m (View (ML m) a))

Isn't the reflection-without-remorse improvement to <|> lost entirely, or at least when the situation gets too complicated for appends to fuse away?

dagit · 2021-07-27T22:37:38Z

I haven't read everything, but this proposal smells like a streamy version of the classic

Not sure what you mean by classic here. Is there something you could point me to?

newtype ML m a = ML (m (View (ML m) a))

If you look through the branch history, you'll probably see that this was the type I tried storing in the stream at first. I ran into some issues with it and when dmwit started helping me we rewrite it to the version you see now.

Isn't the reflection-without-remorse improvement to <|> lost entirely, or at least when the situation gets too complicated for appends to fuse away?

I think that's kind of the point? For the parts that fuse we can use the linearized stream computation and for places where fusion doesn't happen we'd need to fallback on the toView/fromView version (which isn't included in my branch, but see #30). And I was thinking that should preserve the asymptotic improvements. I could be wrong, but that was my mental model for how fusion would work.

treeowl · 2021-07-27T22:48:21Z

The sort of thing I'm worried about is a recursive function that generates things like

((f 1 <|> f 2) <|> (f 3 <|> f 4)) <|>
((f 5 <|> f 6) <|> (f 7 <|> f 8))

to an arbitrary depth. What will your code do with that? The whole point of reflection without remorse is to make sure there are no pathologically bad cases. Now it could be that your approach can be tweaked to ensure that, but from what I understand so far I don't think it does yet.

treeowl · 2021-07-27T22:49:07Z

Previous comment has been edited to fix numbers.

treeowl · 2021-07-28T01:44:33Z

Consider also what happens if someone alternates between msplit and <|>.

treeowl · 2021-07-28T03:06:21Z

What I mean by that last:

boffin :: Monad m => SeqT m a -> SeqT m a
boffin m = do
  Just (_, m') <- msplit m
  m' <|> m'

grump :: Monad m => Int -> SeqT m a -> SeqT m a
grump n m = iterate boffin m !! n

treeowl · 2021-07-28T18:09:58Z

Hmmmmmm.... I haven't been able to make this fall over yet. Interesting....

treeowl · 2021-07-29T02:03:06Z

OK, I was testing wrong. I found an example. This runs in very little time with the current implementation, but takes longer than I was willing to wait with the stream implementation. I'm pretty sure this example could be simplified a bit, but you should get the gist.

{-# language BangPatterns #-}
{-# language LambdaCase #-}
module Main(main) where
import Control.Monad.Logic.Sequence
import Control.Monad.Logic.Class
import Control.Applicative
import Control.Monad.Fail
import Data.Foldable (foldl')
import Data.Bifunctor

grump :: MonadLogic m => Int -> m a -> m a
grump n m = foldl' (\acc _ -> acc <|> m <|> acc) empty [1..n]

msplitN :: MonadLogic m => Int -> m a -> m ([a], m a)
msplitN n !m | n <= 0 = pure ([], empty)
msplitN n m = msplit m >>= \case
  Nothing -> pure ([], empty)
  Just (a, m') -> first (a :) <$> msplitN (n - 1) m'

main :: IO ()
main = do
  r <- observeT . fmap fst . msplitN 10000 $ grump 1000000 (pure (20 :: Int))
  print $ last r

treeowl · 2021-07-29T02:14:52Z

I haven't read everything, but this proposal smells like a streamy version of the classic

Not sure what you mean by classic here. Is there something you could point me to?
newtype ML m a = ML (m (View (ML m) a))

This is in Figure 7 in the Reflection without Remorse paper. They explain that it works great for msplit but falls over with <|> associated the "wrong" way. They apply their explicit-sequence repair to that to arrive at their own remorseless implementation.

dagit · 2021-07-29T03:19:30Z

OK, I was testing wrong. I found an example. This runs in very little time with the current implementation, but takes longer than I was willing to wait with the stream implementation. I'm pretty sure this example could be simplified a bit, but you should get the gist.

{-# language BangPatterns #-}
{-# language LambdaCase #-}
module Main(main) where
import Control.Monad.Logic.Sequence
import Control.Monad.Logic.Class
import Control.Applicative
import Control.Monad.Fail
import Data.Foldable (foldl')
import Data.Bifunctor

grump :: MonadLogic m => Int -> m a -> m a
grump n m = foldl' (\acc _ -> acc <|> m <|> acc) empty [1..n]

msplitN :: MonadLogic m => Int -> m a -> m ([a], m a)
msplitN n !m | n <= 0 = pure ([], empty)
msplitN n m = msplit m >>= \case
  Nothing -> pure ([], empty)
  Just (a, m') -> first (a :) <$> msplitN (n - 1) m'

main :: IO ()
main = do
  r <- observeT . fmap fst . msplitN 10000 $ grump 1000000 (pure (20 :: Int))
  print $ last r

I see. I'm sad you found a counter example but also glad you found a counter example.

We should make sure something like this is in the benchmark suite. In my local benchmark, and part of the reason I've been slow to convert it, is I convert the values to streamly streams because they have a nice batching API. I can then time batches. If each batch takes roughly the same amount of time I know we haven't introduced asymptotic factors but if the time between batches increases I know I'm in trouble.

dagit · 2021-07-29T03:22:04Z

Oh, I forgot to say this in my last message.

The big speedup happened when I made >>= fusable but no speedup when I made just <|> fusable. So I wonder if maybe one of the following might be true:

we have to leave <|> as non-stream but other things can be stream and still get a win?
we need to track different state inside <|> so as to not cause the asymptotic slowdown?

treeowl · 2021-07-29T03:31:49Z

It sounds plausible, since >>= does a lot more restructuring than <|>. Personally, I'd want to see a more detailed argument supporting it, because my intuition on this is not so that wonderful. But that might be a good direction to take. Broadly speaking, I think a good goal is to pack things together as much as possible before sticking them in the queue, to allow the optimizer to do its thing. I'm not sure that either your approach or the vague hint of one I tossed out earlier is the best way to achieve that.

dagit · 2021-07-30T05:55:01Z

I had just been testing this branch with my benchmark. I wish I had thought to test a few simple uses of bind in the repl. It's completely bogus. observeAllT (pure 1 >> pure 2) runs forever. I'm going to push a new version of this branch after merging with your test suite, but the tests won't pass. They get stuck. However, I don't really want to lose this branch yet so I feel like it's worth it to commit it broken.

dagit commented Jul 26, 2021

View reviewed changes

dagit force-pushed the stream branch from f192c53 to 0efd801 Compare July 26, 2021 19:39

dagit commented Jul 26, 2021

View reviewed changes

dagit force-pushed the stream branch from bd08a50 to 5ae0238 Compare July 26, 2021 21:37

dagit mentioned this pull request Jul 26, 2021

Investigate undoing fusion with RULES #30

Closed

treeowl reviewed Jul 27, 2021

View reviewed changes

dagit added 8 commits July 31, 2021 11:13

It's slow but it technically it's stream fusion

e179ade

Minor refinements

95cd98d

Fix bind

c797421

Clean up

dd7fb89

Make old GHCs happy

6f20a83

Make old GHCs happy

44a91ef

Make fmap fusable

1297035

Tests will fail but at least they won't loop

9ad78e7

dagit force-pushed the stream branch from 70001e7 to 9ad78e7 Compare July 31, 2021 18:21

Merge branch 'main' into stream

b220797

Stream fusion #27

Are you sure you want to change the base?

Stream fusion #27

Uh oh!

Conversation

dagit commented Jul 26, 2021

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

treeowl commented Jul 26, 2021

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

treeowl commented Jul 26, 2021 via email

Uh oh!

dagit commented Jul 26, 2021

Uh oh!

dagit commented Jul 26, 2021

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

dagit commented Jul 26, 2021

Uh oh!

treeowl commented Jul 26, 2021 via email

Uh oh!

treeowl left a comment

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

treeowl commented Jul 27, 2021

Uh oh!

dagit commented Jul 27, 2021

Uh oh!

treeowl commented Jul 27, 2021 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

treeowl commented Jul 27, 2021

Uh oh!

treeowl commented Jul 28, 2021

Uh oh!

treeowl commented Jul 28, 2021

Uh oh!

treeowl commented Jul 28, 2021

Uh oh!

treeowl commented Jul 29, 2021

Uh oh!

treeowl commented Jul 29, 2021 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

dagit commented Jul 29, 2021

Uh oh!

dagit commented Jul 29, 2021

Uh oh!

treeowl commented Jul 29, 2021

Uh oh!

dagit commented Jul 30, 2021

Uh oh!

treeowl commented Jul 27, 2021 •

edited

Loading

treeowl commented Jul 29, 2021 •

edited

Loading