[GHC] #13623: join points produce bad code for stream fusion
GHC
ghc-devs at haskell.org
Fri Apr 28 02:05:06 UTC 2017
#13623: join points produce bad code for stream fusion
-------------------------------------+-------------------------------------
Reporter: choenerzs | Owner: (none)
Type: bug | Status: new
Priority: high | Milestone: 8.2.1
Component: Compiler | Version: 8.2.1-rc1
Resolution: | Keywords: JoinPoints
Operating System: Unknown/Multiple | Architecture:
Type of failure: Runtime | Unknown/Multiple
performance bug | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by RyanGlScott):
For the sake of convenience, here's a version which brings in the relevant
code from `vector` to avoid dependencies:
{{{#!hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Test where
import GHC.Types (SPEC(..))
foo :: Int -> Int -> IO Int
foo = \i j -> sfoldl' (+) 0 $ xs i j +++ ys i j
where xs k l = senumFromStepN k l 2
ys k l = senumFromStepN k l 3
{-# Inline xs #-}
{-# Inline ys #-}
{-# Inline foo #-}
-------------------------------------------------------------------------------
-- vector junk
-------------------------------------------------------------------------------
#define PHASE_FUSED [1]
#define PHASE_INNER [0]
#define INLINE_FUSED INLINE PHASE_FUSED
#define INLINE_INNER INLINE PHASE_INNER
data Stream m a = forall s. Stream (s -> m (Step s a)) s
data Step s a where
Yield :: a -> s -> Step s a
Skip :: s -> Step s a
Done :: Step s a
senumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a
{-# INLINE_FUSED senumFromStepN #-}
senumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n)
where
{-# INLINE_INNER step #-}
step (w,m) | m > 0 = return $ Yield w (w+y,m-1)
| otherwise = return $ Done
sfoldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a
{-# INLINE sfoldl' #-}
sfoldl' f = sfoldlM' (\a b -> return (f a b))
sfoldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a
{-# INLINE_FUSED sfoldlM' #-}
sfoldlM' m w (Stream step t) = foldlM'_loop SPEC w t
where
foldlM'_loop !_ z s
= z `seq`
do
r <- step s
case r of
Yield x s' -> do { z' <- m z x; foldlM'_loop SPEC z' s' }
Skip s' -> foldlM'_loop SPEC z s'
Done -> return z
infixr 5 +++
(+++) :: Monad m => Stream m a -> Stream m a -> Stream m a
{-# INLINE_FUSED (+++) #-}
Stream stepa ta +++ Stream stepb tb = Stream step (Left ta)
where
{-# INLINE_INNER step #-}
step (Left sa) = do
r <- stepa sa
case r of
Yield x sa' -> return $ Yield x (Left sa')
Skip sa' -> return $ Skip (Left sa')
Done -> return $ Skip (Right tb)
step (Right sb) = do
r <- stepb sb
case r of
Yield x sb' -> return $ Yield x (Right sb')
Skip sb' -> return $ Skip (Right sb')
Done -> return $ Done
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13623#comment:5>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list