[commit: ghc] master: Fix performance regressions from #14737 (d92c755)
git at git.haskell.org
git at git.haskell.org
Mon May 14 13:27:33 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/d92c7556501a4cdeb7d269c4624992c94d9b3b8b/ghc
>---------------------------------------------------------------
commit d92c7556501a4cdeb7d269c4624992c94d9b3b8b
Author: Tobias Dammers <tdammers at gmail.com>
Date: Mon May 14 08:50:29 2018 -0400
Fix performance regressions from #14737
See #15019. When removing an unnecessary type equality check in #14737,
several regression tests failed. The cause was that some coercions that
are actually Refl coercions weren't passed in as such, which made the
equality check needlessly complex (Refl coercions can be discarded in
this particular check immediately, without inspecting the types at all).
We fix that, and get additional performance improvements for free.
Reviewers: goldfire, bgamari, simonpj
Reviewed By: bgamari, simonpj
Subscribers: simonpj, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4635
>---------------------------------------------------------------
d92c7556501a4cdeb7d269c4624992c94d9b3b8b
compiler/coreSyn/CoreOpt.hs | 6 ++++
compiler/simplCore/Simplify.hs | 70 ++++++++++++++++++++++++++-----------
testsuite/tests/perf/compiler/all.T | 4 ++-
3 files changed, 58 insertions(+), 22 deletions(-)
diff --git a/compiler/coreSyn/CoreOpt.hs b/compiler/coreSyn/CoreOpt.hs
index 03bc6cd..2027928 100644
--- a/compiler/coreSyn/CoreOpt.hs
+++ b/compiler/coreSyn/CoreOpt.hs
@@ -982,6 +982,9 @@ pushCoTyArg co ty
-- -- | tyL `eqType` tyR
-- -- = Just (ty, Nothing)
+ | isReflCo co
+ = Just (ty, Nothing)
+
| isForAllTy tyL
= ASSERT2( isForAllTy tyR, ppr co $$ ppr ty )
Just (ty `mkCastTy` mkSymCo co1, Just co2)
@@ -1017,6 +1020,9 @@ pushCoValArg co
-- -- | tyL `eqType` tyR
-- -- = Just (mkRepReflCo arg, Nothing)
+ | isReflCo co
+ = Just (mkRepReflCo arg, Nothing)
+
| isFunTy tyL
, (co1, co2) <- decomposeFunCo Representational co
-- If co :: (tyL1 -> tyL2) ~ (tyR1 -> tyR2)
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 2580720..b50771a 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -1209,40 +1209,73 @@ rebuild env expr cont
************************************************************************
-}
+{- Note [Optimising reflexivity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's important (for compiler performance) to get rid of reflexivity as soon
+as it appears. See Trac #11735, #14737, and #15019.
+
+In particular, we want to behave well on
+
+ * e |> co1 |> co2
+ where the two happen to cancel out entirely. That is quite common;
+ e.g. a newtype wrapping and unwrapping cancel.
+
+
+ * (f |> co) @t1 @t2 ... @tn x1 .. xm
+ Here we wil use pushCoTyArg and pushCoValArg successively, which
+ build up NthCo stacks. Silly to do that if co is reflexive.
+
+However, we don't want to call isReflexiveCo too much, because it uses
+type equality which is expensive on big types (Trac #14737 comment:7).
+
+A good compromise (determined experimentally) seems to be to call
+isReflexiveCo
+ * when composing casts, and
+ * at the end
+
+In investigating this I saw missed opportunities for on-the-fly
+coercion shrinkage. See Trac #15090.
+-}
+
+
simplCast :: SimplEnv -> InExpr -> Coercion -> SimplCont
-> SimplM (SimplFloats, OutExpr)
simplCast env body co0 cont0
= do { co1 <- {-#SCC "simplCast-simplCoercion" #-} simplCoercion env co0
- ; cont1 <- {-#SCC "simplCast-addCoerce" #-} addCoerce co1 cont0
+ ; cont1 <- {-#SCC "simplCast-addCoerce" #-}
+ if isReflCo co1
+ then return cont0 -- See Note [Optimising reflexivity]
+ else addCoerce co1 cont0
; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 }
where
-- If the first parameter is Nothing, then simplifying revealed a
-- reflexive coercion. Omit.
- addCoerce0 :: Maybe OutCoercion -> SimplCont -> SimplM SimplCont
- addCoerce0 Nothing cont = return cont
- addCoerce0 (Just co) cont = addCoerce co cont
+ addCoerceM :: Maybe OutCoercion -> SimplCont -> SimplM SimplCont
+ addCoerceM Nothing cont = return cont
+ addCoerceM (Just co) cont = addCoerce co cont
addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont
-
- addCoerce co1 (CastIt co2 cont)
- = {-#SCC "addCoerce-simple-recursion" #-}
- addCoerce (mkTransCo co1 co2) cont
+ addCoerce co1 (CastIt co2 cont) -- See Note [Optimising reflexivity]
+ | isReflexiveCo co' = return cont
+ | otherwise = addCoerce co' cont
+ where
+ co' = mkTransCo co1 co2
addCoerce co cont@(ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail })
| Just (arg_ty', m_co') <- pushCoTyArg co arg_ty
= {-#SCC "addCoerce-pushCoTyArg" #-}
- do { tail' <- addCoerce0 m_co' tail
+ do { tail' <- addCoerceM m_co' tail
; return (cont { sc_arg_ty = arg_ty', sc_cont = tail' }) }
addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
- , sc_dup = dup, sc_cont = tail })
+ , sc_dup = dup, sc_cont = tail })
| Just (co1, m_co2) <- pushCoValArg co
, Pair _ new_ty <- coercionKind co1
- , not (isTypeLevPoly new_ty) -- without this check, we get a lev-poly arg
+ , not (isTypeLevPoly new_ty) -- Without this check, we get a lev-poly arg
-- See Note [Levity polymorphism invariants] in CoreSyn
-- test: typecheck/should_run/EtaExpandLevPoly
= {-#SCC "addCoerce-pushCoValArg" #-}
- do { tail' <- addCoerce0 m_co2 tail
+ do { tail' <- addCoerceM m_co2 tail
; if isReflCo co1
then return (cont { sc_cont = tail' })
-- Avoid simplifying if possible;
@@ -1260,15 +1293,10 @@ simplCast env body co0 cont0
, sc_cont = tail' }) } }
addCoerce co cont
- | isReflexiveCo co = {-#SCC "addCoerce-reflexive" #-}
- return cont
- | otherwise = {-#SCC "addCoerce-other" #-}
- return (CastIt co cont)
- -- It's worth checking isReflexiveCo.
- -- For example, in the initial form of a worker
- -- we may find (coerce T (coerce S (\x.e))) y
- -- and we'd like it to simplify to e[y/x] in one round
- -- of simplification
+ | isReflexiveCo co = return cont -- Having this at the end makes a huge
+ -- difference in T12227, for some reason
+ -- See Note [Optimising reflexivity]
+ | otherwise = return (CastIt co cont)
simplArg :: SimplEnv -> DupFlag -> StaticEnv -> CoreExpr
-> SimplM (DupFlag, StaticEnv, OutExpr)
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 02668cf..3647b8a 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1051,6 +1051,7 @@ test('T12425',
# 2017-04-28: 127500136 Remove exponential behaviour in simplifier
# 2017-05-23: 134780272 Addition of llvm-targets in dynflags (D3352)
# 2018-04-15: 141952368 Collateral of #14737
+ # 2018-04-30: 130646336 improved simplCast performance #15019
# 2018-04-26: 150743648 Do not unpack class dictionaries with INLINABLE
]),
],
@@ -1122,7 +1123,7 @@ test('T13056',
test('T12707',
[ compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 1237898376, 5),
+ [(wordsize(64), 1141555816, 5),
# initial: 1271577192
# 2017-01-22: 1348865648 Allow top-level strings in Core
# 2017-01-31: 1280336112 Join points (#12988)
@@ -1131,6 +1132,7 @@ test('T12707',
# 2017-03-02: 1231809592 Drift from recent simplifier improvements
# 2017-05-14: 1163821528 (amd64/Linux) Two-pass CmmLayoutStack
# 2018-04-09: 1237898376 Inexplicable, collateral of #14737
+ # 2018-04-30: 1141555816 improved simplCast performance #15019
]),
],
compile,
More information about the ghc-commits
mailing list