summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-05-09 23:20:44 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2021-05-09 23:20:44 +0100
commit504b07ae7dfa42135ec54ffb08ff6af8f881a6b8 (patch)
treeae61013bde363cc5edc1657cdfb6ddd4c5797d32
parent8e0f48bdd6e83279939d8fdd2ec1e5707725030d (diff)
downloadhaskell-wip/T19815.tar.gz
Use isReflexiveCo when building an MCorecionwip/T19815
This patch just changes `isReflCo` to `isReflexiveCo` when we build an MCoercion, in `mkMCo`. It turns out that this makes a gigantic difference to test T18223. I also changed the name from `coToMCo` to `mkMCo`, which is more consistent with how we name smart constructors.
-rw-r--r--compiler/GHC/Core/Coercion.hs22
-rw-r--r--compiler/GHC/Core/Opt/Arity.hs8
2 files changed, 17 insertions, 13 deletions
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index b364091958..ccf5ef1f11 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -72,7 +72,7 @@ module GHC.Core.Coercion (
isReflCoVar_maybe, isGReflMCo, mkGReflLeftMCo, mkGReflRightMCo,
mkCoherenceRightMCo,
- coToMCo, mkTransMCo, mkTransMCoL, mkCastTyMCo, mkSymMCo, isReflMCo,
+ mkMCo, mkTransMCo, mkTransMCoL, mkTransMCoR, mkCastTyMCo, mkSymMCo, isReflMCo,
-- ** Coercion variables
mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique,
@@ -305,11 +305,13 @@ tidyCoAxBndrsForUser init_env tcvs
* *
********************************************************************* -}
-coToMCo :: Coercion -> MCoercion
--- Convert a coercion to a MCoercion,
--- It's not clear whether or not isReflexiveCo would be better here
-coToMCo co | isReflCo co = MRefl
- | otherwise = MCo co
+mkMCo :: Coercion -> MCoercion
+-- Convert a coercion to a MCoercion
+-- I'm using isReflexiveCo to check whether the coercion is reflexive,
+-- because it makes a gigantic difference in T18223, and does little
+-- harm otherwise (#19815)
+mkMCo co | isReflexiveCo co = MRefl
+ | otherwise = MCo co
-- | Tests if this MCoercion is obviously generalized reflexive
-- Guaranteed to work very quickly.
@@ -329,11 +331,15 @@ mkGReflCo r ty mco
mkTransMCo :: MCoercion -> MCoercion -> MCoercion
mkTransMCo MRefl co2 = co2
mkTransMCo co1 MRefl = co1
-mkTransMCo (MCo co1) (MCo co2) = MCo (mkTransCo co1 co2)
+mkTransMCo (MCo co1) (MCo co2) = mkMCo (mkTransCo co1 co2)
mkTransMCoL :: MCoercion -> Coercion -> MCoercion
mkTransMCoL MRefl co2 = MCo co2
-mkTransMCoL (MCo co1) co2 = MCo (mkTransCo co1 co2)
+mkTransMCoL (MCo co1) co2 = mkMCo (mkTransCo co1 co2)
+
+mkTransMCoR :: Coercion -> MCoercion -> MCoercion
+mkTransMCoR co1 MRefl = MCo co1
+mkTransMCoR co1 (MCo co2) = mkMCo (mkTransCo co1 co2)
-- | Get the reverse of an 'MCoercion'
mkSymMCo :: MCoercion -> MCoercion
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs
index 36a2535c09..aa0b936058 100644
--- a/compiler/GHC/Core/Opt/Arity.hs
+++ b/compiler/GHC/Core/Opt/Arity.hs
@@ -1672,11 +1672,9 @@ pushCoValArg co
-- then co1 :: tyL1 ~ tyR1
-- co2 :: tyL2 ~ tyR2
= ASSERT2( isFunTy tyR, ppr co $$ ppr arg )
- Just (coToMCo (mkSymCo co1), coToMCo co2)
- -- Critically, coToMCo to checks for ReflCo; the whole coercion may not
- -- be reflexive, but either of its components might be
- -- We could use isReflexiveCo, but it's not clear if the benefit
- -- is worth the cost, and it makes no difference in #18223
+ Just (mkMCo (mkSymCo co1), mkMCo co2)
+ -- Critically, mkMCo to checks for isReflexiveCo; the whole coercion
+ -- may not be reflexive, but either of its components might be
| otherwise
= Nothing