summaryrefslogtreecommitdiff
path: root/compiler/coreSyn/CoreUtils.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2019-11-29 17:43:58 +0000
committerBen Gamari <ben@smart-cactus.org>2019-12-05 16:05:43 -0500
commitc782ce17354cb3a07df0538ecbe42848b8f1dc53 (patch)
tree6f7dd7a354913525b14f5fc62d47b78b655b735b /compiler/coreSyn/CoreUtils.hs
parent1a2ea01946e4318bcc3e1c7d3e16ab9275b6b483 (diff)
downloadhaskell-wip/T17515.tar.gz
Split up coercionKindwip/T17515
This patch implements the idea in #17515, splitting `coercionKind` into: * `coercion{Left,Right}Kind`, which computes the left/right side of the pair * `coercionKind`, which computes the pair of coercible types This is reduces allocation since we frequently only need only one side of the pair. Specifically, we see the following improvements on x86-64 Debian 9: | test | new | old | relative chg. | | :------- | ---------: | ------------: | ------------: | | T5030 | 695537752 | 747641152.0 | -6.97% | | T5321Fun | 449315744 | 474009040.0 | -5.21% | | T9872a | 2611071400 | 2645040952.0 | -1.28% | | T9872c | 2957097904 | 2994260264.0 | -1.24% | | T12227 | 773435072 | 812367768.0 | -4.79% | | T12545 | 3142687224 | 3215714752.0 | -2.27% | | T14683 | 9392407664 | 9824775000.0 | -4.40% | Metric Decrease: T12545 T9872a T14683 T5030 T12227 T9872c T5321Fun T9872b
Diffstat (limited to 'compiler/coreSyn/CoreUtils.hs')
-rw-r--r--compiler/coreSyn/CoreUtils.hs10
1 files changed, 5 insertions, 5 deletions
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 16f4a00341..50fdcd9c7b 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -177,7 +177,7 @@ isExprLevPoly = go
go_app (Lam _ e) = go_app e
go_app (Let _ e) = go_app e
go_app (Case _ _ ty _) = resultIsLevPoly ty
- go_app (Cast _ co) = resultIsLevPoly (pSnd $ coercionKind co)
+ go_app (Cast _ co) = resultIsLevPoly (coercionRKind co)
go_app (Tick _ e) = go_app e
go_app e@(Type {}) = pprPanic "isExprLevPoly app ty" (ppr e)
go_app e@(Coercion {}) = pprPanic "isExprLevPoly app co" (ppr e)
@@ -267,15 +267,15 @@ mkCast e co
= e
mkCast (Coercion e_co) co
- | isCoVarType (pSnd (coercionKind co))
+ | isCoVarType (coercionRKind co)
-- The guard here checks that g has a (~#) on both sides,
-- otherwise decomposeCo fails. Can in principle happen
-- with unsafeCoerce
= Coercion (mkCoCast e_co co)
mkCast (Cast expr co2) co
- = WARN(let { Pair from_ty _to_ty = coercionKind co;
- Pair _from_ty2 to_ty2 = coercionKind co2} in
+ = WARN(let { from_ty = coercionLKind co;
+ to_ty2 = coercionRKind co2 } in
not (from_ty `eqType` to_ty2),
vcat ([ text "expr:" <+> ppr expr
, text "co2:" <+> ppr co2
@@ -286,7 +286,7 @@ mkCast (Tick t expr) co
= Tick t (mkCast expr co)
mkCast expr co
- = let Pair from_ty _to_ty = coercionKind co in
+ = let from_ty = coercionLKind co in
WARN( not (from_ty `eqType` exprType expr),
text "Trying to coerce" <+> text "(" <> ppr expr
$$ text "::" <+> ppr (exprType expr) <> text ")"