GHC 8.0.1 vs GHC HEAD (8.1.20161202) doesn't do inlining and unboxing very well
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:
-- 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
-- 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` ...
}
}
}
}
Trac metadata
| Trac field | Value |
|---|---|
| Version | 8.0.1 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | mpickering |
| Operating system | |
| Architecture |