#12916: GHC 8.0.1 vs GHC HEAD (8.1.20161202) doesn't do inlining and unboxing very well -------------------------------------+------------------------------------- Reporter: alexbiehl | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.0.1 Keywords: | Operating System: Unknown/Multiple Architecture: | Type of failure: None/Unknown Unknown/Multiple | Test Case: | Blocked By: Blocking: | Related Tickets: Differential Rev(s): | Wiki Page: -------------------------------------+------------------------------------- Comparing the core output for a small program of mine I found that GHC HEAD produced binary runs 26x slower than with GHC 8.0.1. I have uploaded an example: https://gist.github.com/alexbiehl/0a1b5016223e00ae79a1399176e14eef The following is the output for the empResult function. We can see that GHC 8.0.1 nicely unboxed the accumulator in the loop. While GHC HEAD uses boxed values all over the place and doesn't even do dictionary inlining. For GHC 8.0.1 it produces: {{{#!hs -- RHS size: {terms: 175, types: 184, coercions: 4} $wempResult :: IO (Maybe (Vector ColValue)) -> State# RealWorld -> (# State# RealWorld, Either Error Int #) $wempResult = \ (ww :: IO (Maybe (Vector ColValue))) (w :: State# RealWorld) -> letrec { $sloop :: State# RealWorld -> Int# -> (# State# RealWorld, Either Error Int #) $sloop = \ (sc :: State# RealWorld) (sc1 :: Int#) -> case (ww `cast` ...) sc of _ { (# ipv, ipv1 #) -> case ipv1 of _ { Nothing -> (# ipv, Right (I# sc1) #); Just a -> case length $fVectorVectora a of _ { I# y -> case y of _ { __DEFAULT -> (# ipv, empResult2 #); 4# -> case a of _ { Vector dt dt1 dt2 -> let { $wsucc_ :: Int# -> State# RealWorld -> (# State# RealWorld, Either Error Int #) $wsucc_ = \ (ww1 :: Int#) (w1 :: State# RealWorld) -> let { $wsucc_1 :: Int# -> State# RealWorld -> (# State# RealWorld, Either Error Int #) $wsucc_1 = \ (ww2 :: Int#) (w2 :: State# RealWorld) -> case indexArray# dt2 (+# dt ww2) of _ { (# ipv2 #) -> case ipv2 of _ { __DEFAULT -> (# w2, empResult2 #); CV_Int8 dt4 -> case indexArray# dt2 (+# dt (+# ww2 1#)) of _ { (# ipv3 #) -> case ipv3 of _ { __DEFAULT -> (# w2, empResult2 #); CV_Text t -> $sloop w2 (+# sc1 1#) } }; CV_Int16 dt4 -> case indexArray# dt2 (+# dt (+# ww2 1#)) of _ { (# ipv3 #) -> case ipv3 of _ { __DEFAULT -> (# w2, empResult2 #); CV_Text t -> $sloop w2 (+# sc1 1#) } }; CV_Int32 dt4 -> case indexArray# dt2 (+# dt (+# ww2 1#)) of _ { (# ipv3 #) -> case ipv3 of _ { __DEFAULT -> (# w2, empResult2 #); CV_Text t -> $sloop w2 (+# sc1 1#) } } } } } in case indexArray# dt2 (+# dt ww1) of _ { (# ipv2 #) -> case ipv2 of _ { __DEFAULT -> (# w1, empResult2 #); CV_Int8 dt4 -> $wsucc_1 (+# ww1 1#) w1; CV_Int16 dt4 -> $wsucc_1 (+# ww1 1#) w1; CV_Int32 dt4 -> $wsucc_1 (+# ww1 1#) w1 } } } in case indexArray# dt2 dt of _ { (# ipv2 #) -> case ipv2 of _ { __DEFAULT -> (# ipv, empResult2 #); CV_Int8 dt4 -> $wsucc_ 1# ipv; CV_Int16 dt4 -> $wsucc_ 1# ipv; CV_Int32 dt4 -> $wsucc_ 1# ipv } } } } } } }; } in $sloop w 0# }}} and for GHC HEAD it produces {{{#!hs -- RHS size: {terms: 193, types: 182, coercions: 3} empResult :: Result Int empResult = case <$> $fFunctorRow $WEmp lvl19 of { Row dt fm -> case + $fNumInt (I# dt) lvl17 of dt1 { I# dt2 -> case + $fNumInt dt1 lvl17 of dt3 { I# dt4 -> case + $fNumInt dt3 lvl17 of dt5 { I# dt6 -> (\ (is :: InputStream (Vector ColValue)) -> let { lvl23 :: IO (Maybe (Vector ColValue)) lvl23 = case is of { InputStream ds1 ds2 -> ds1 } } in $! (letrec { loop :: Int -> IO (Either Error Int) loop = \ (s :: Int) -> let { lvl24 :: IO (Either Error Int) lvl24 = $! loop (+ $fNumInt s lvl17) } in let { lvl25 :: IO (Either Error Int) lvl25 = return $fMonadIO (Right s) } in >>= $fMonadIO lvl23 (\ (ma :: Maybe (Vector ColValue)) -> case ma of { Nothing -> lvl25; Just a -> case == $fEqInt dt5 (lvl13 a) of { False -> lvl21; True -> fm (\ _ (j :: Int) -> case a of { Vector dt7 dt8 dt9 -> case + $fNumInt (I# dt7) j of { I# i# -> let { $wsucc_ :: Int -> IO (Either Error Int) $wsucc_ = \ (w :: Int) -> case + $fNumInt (I# dt7) w of { I# i#1 -> case indexArray# dt9 i#1 of { (# ipv #) -> case ipv of { __DEFAULT -> lvl21; CV_Int8 dt10 -> case + $fNumInt (I# dt7) (+ $fNumInt w lvl17) of { I# i#2 -> case indexArray# dt9 i#2 of { (# ipv1 #) -> case ipv1 of { __DEFAULT -> lvl21; CV_Text t -> lvl24 } } }; CV_Int16 dt10 -> case + $fNumInt (I# dt7) (+ $fNumInt w lvl17) of { I# i#2 -> case indexArray# dt9 i#2 of { (# ipv1 #) -> case ipv1 of { __DEFAULT -> lvl21; CV_Text t -> lvl24 } } }; CV_Int32 dt10 -> case + $fNumInt (I# dt7) (+ $fNumInt w lvl17) of { I# i#2 -> case indexArray# dt9 i#2 of { (# ipv1 #) -> case ipv1 of { __DEFAULT -> lvl21; CV_Text t -> lvl24 } } } } } } } in case indexArray# dt9 i# of { (# ipv #) -> case ipv of { __DEFAULT -> lvl21; CV_Int8 dt10 -> $wsucc_ (+ $fNumInt j lvl17); CV_Int16 dt10 -> $wsucc_ (+ $fNumInt j lvl17); CV_Int32 dt10 -> $wsucc_ (+ $fNumInt j lvl17) } } } }) lvl22 a $fShowColValue2 } }); } in loop) $fShowColValue2) `cast` ... } } } } }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/12916 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler