[GHC] #9434: GHC.List.reverse does not fuse

Simon Peyton Jones simonpj at microsoft.com
Mon Aug 18 06:26:38 UTC 2014


I have not looked into this, but
	Note [CSE for INLINE and NOINLINE]
in CSE.lhs looks like a promising place to start understanding what is going on here.

I'd prefer to avoid creating duplicate code in the first place, rather than rely on CSE to eliminate it.

Simon

| -----Original Message-----
| From: Libraries [mailto:libraries-bounces at haskell.org] On Behalf Of
| David Feuer
| Sent: 17 August 2014 10:32
| To: Dan Doel; Haskell Libraries
| Subject: Re: [GHC] #9434: GHC.List.reverse does not fuse
| 
| By the way, I think there's some strangeness in the (optional) CSE pass
| that may be what prevents it from doing anything about the cases the
| above rule doesn't work on. In particular, it apparently refuses to
| perform CSE on anything that's marked INLINE or NOINLINE *regardless of
| phase*, and when enabled it looks like it runs too early to be able to
| handle these situations anyway. Of course, I could be reading things a
| bit wrong, but this looks off to me.
| 
| On Sun, Aug 17, 2014 at 4:31 AM, David Feuer <david.feuer at gmail.com>
| wrote:
| > It looks like the following works at least reasonably well:
| >
| > {-# INLINE[0] revFlip #-}
| > revFlip :: (a -> b -> b) -> b -> a -> b revFlip f b a = f a b
| >
| > {-# NOINLINE[1] reverse #-}
| > reverse :: [a] -> [a]
| > reverse xs = rv xs []
| >   where
| >     rv [] r = r
| >     rv (y:ys) r = rv ys (y:r)
| >
| > {-# RULES
| > "reverse" [~1] forall xs . reverse xs = build $ \c n -> foldl
| (revFlip
| > c) n xs "reversePlain" [1] forall xs . foldr (\v fn z -> fn ((revFlip
| > (:)) z
| > v)) id xs [] = reverse xs
| >  #-}
| >
| > The complicated reversePlain rule actually fires, at least in my
| > tests. If we miss a few, that may not be a disaster. I'm not at all
| > confident that there's anything to be done about your concern about
| > beta reduced forms without totally hosing other optimizations.
| >
| > David Feuer
| >
| > On Fri, Aug 15, 2014 at 3:22 PM, Dan Doel <dan.doel at gmail.com> wrote:
| >> Yeah, I realized that part of the idea is for (the new) foldl to be
| >> defined in terms of foldr, then inline (or rewrite), fuse, and get
| >> optimized. So maybe you can't delay the foldl inlining.
| >>
| >> But it should be possible to recognize the foldr definition of foldl
| >> and rewrite back, as long as the definition of foldl has
| >> appropriately recognizable combinators instead of just lambda
| expressions.
| >>
| >>
| >> On Fri, Aug 15, 2014 at 3:13 PM, David Feuer <david.feuer at gmail.com>
| wrote:
| >>>
| >>> I forgot about the flip! I wonder if I can even avoid NOINLINEing
| >>> the foldl if I noninliningFlip and then bring it back from the
| resulting foldr.
| >>> I'll have to try tonight. Thanks!
| >>>
| >>> On Aug 15, 2014 12:57 PM, "Dan Doel" <dan.doel at gmail.com> wrote:
| >>>>
| >>>> Make foldl's inline phased, and see what happens?
| >>>>
| >>>> Presumably the reason it doesn't have a phase limit yet is that it
| >>>> never participated in any fusion before, so there was never a
| >>>> reason to not just inline.
| >>>>
| >>>> Other than that it seems like:
| >>>>
| >>>>     reverse xs
| >>>>       => rewrite
| >>>>     build (\c n -> foldl (noinlineFlip c) n xs)
| >>>>       => inline
| >>>>     foldl (noinlineFlip (:)) [] xs
| >>>>       => rewrite
| >>>>     reverse xs
| >>>>
| >>>> where I assume you need a special flip which may or may not exist
| >>>> in these modules already.
| >>>>
| >>>>
| >>>> On Fri, Aug 15, 2014 at 12:46 PM, David Feuer
| >>>> <david.feuer at gmail.com>
| >>>> wrote:
| >>>>>
| >>>>> Yes, but I'm not sure how to do that, especially because foldl
| >>>>> doesn't have the phased NOINLINE that foldr does.
| >>>>>
| >>>>> On Aug 15, 2014 12:45 PM, "Dan Doel" <dan.doel at gmail.com> wrote:
| >>>>>>
| >>>>>> Isn't this kind of thing fixed for other functions by rewriting
| >>>>>> back into the direct recursive definition if no fusion happens?
| >>>>>>
| >>>>>>
| >>>>>> On Fri, Aug 15, 2014 at 11:41 AM, David Feuer
| >>>>>> <david.feuer at gmail.com>
| >>>>>> wrote:
| >>>>>>>
| >>>>>>> I'm having trouble when it doesn't fuse—it ends up with
| >>>>>>> duplicate bindings at the top level, because build gets inlined
| >>>>>>> n times, and the result lifted out. Nothing's *wrong* with the
| >>>>>>> code, except that there are multiple copies of it.
| >>>>>>>
| >>>>>>> On Aug 15, 2014 10:58 AM, "GHC" <ghc-devs at haskell.org> wrote:
| >>>>>>>>
| >>>>>>>> #9434: GHC.List.reverse does not fuse
| >>>>>>>>
| >>>>>>>> -------------------------------------+------------------------
| -
| >>>>>>>> -------------------------------------+------------
| >>>>>>>>               Reporter:  dfeuer      |            Owner:
| >>>>>>>>                   Type:  bug         |           Status:  new
| >>>>>>>>               Priority:  normal      |        Milestone:
| >>>>>>>>              Component:              |          Version:  7.9
| >>>>>>>>   libraries/base                     |         Keywords:
| >>>>>>>>             Resolution:              |     Architecture:
| >>>>>>>> Unknown/Multiple
| >>>>>>>>       Operating System:              |       Difficulty:  Easy
| (less
| >>>>>>>> than 1
| >>>>>>>>   Unknown/Multiple                   |  hour)
| >>>>>>>>        Type of failure:  Runtime     |       Blocked By:
| >>>>>>>>   performance bug                    |  Related Tickets:
| >>>>>>>>              Test Case:              |
| >>>>>>>>               Blocking:              |
| >>>>>>>> Differential Revisions:              |
| >>>>>>>>
| >>>>>>>> -------------------------------------+------------------------
| -
| >>>>>>>> -------------------------------------+------------
| >>>>>>>>
| >>>>>>>> Comment (by simonpj):
| >>>>>>>>
| >>>>>>>>  Great.  Just check that when fusion ''doesn't'' take place,
| >>>>>>>> the result is  good. And do a `nofib` comparison for good
| luck.
| >>>>>>>> Then submit a patch.
| >>>>>>>>
| >>>>>>>>  Thanks for doing all this work on fusion, David.
| >>>>>>>>
| >>>>>>>>  Simon
| >>>>>>>>
| >>>>>>>> --
| >>>>>>>> Ticket URL:
| >>>>>>>> <http://ghc.haskell.org/trac/ghc/ticket/9434#comment:2>
| >>>>>>>> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler
| >>>>>>>
| >>>>>>>
| >>>>>>> _______________________________________________
| >>>>>>> ghc-devs mailing list
| >>>>>>> ghc-devs at haskell.org
| >>>>>>> http://www.haskell.org/mailman/listinfo/ghc-devs
| >>>>>>>
| >>>>>>
| >>>>
| >>
| _______________________________________________
| Libraries mailing list
| Libraries at haskell.org
| http://www.haskell.org/mailman/listinfo/libraries


More information about the Libraries mailing list