[GHC] #12916: GHC 8.0.1 vs GHC HEAD (8.1.20161202) doesn't do inlining and unboxing very well
GHC
ghc-devs at haskell.org
Fri Dec 2 14:16:48 UTC 2016
#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
More information about the ghc-tickets
mailing list