diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-11-29 17:43:58 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-12-06 21:21:14 -0500 |
| commit | 0a4ca9eb152c6bfbc3aad71c180a38bbfeca5bfb (patch) | |
| tree | da325d83503a19c97ac9459f5c3943f752d67e42 /compiler/simplCore/Simplify.hs | |
| parent | ee07421fcf99189de6506cf8d17185ed540ea2b3 (diff) | |
| download | haskell-0a4ca9eb152c6bfbc3aad71c180a38bbfeca5bfb.tar.gz | |
Split up coercionKind
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/simplCore/Simplify.hs')
| -rw-r--r-- | compiler/simplCore/Simplify.hs | 7 |
1 files changed, 3 insertions, 4 deletions
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 2613244696..408006f75a 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -50,7 +50,6 @@ import Maybes ( orElse ) import Control.Monad import Outputable import FastString -import Pair import Util import ErrUtils import Module ( moduleName, pprModuleName ) @@ -440,7 +439,7 @@ prepareRhs :: SimplMode -> TopLevelFlag -- x = Just a -- See Note [prepareRhs] prepareRhs mode top_lvl occ info (Cast rhs co) -- Note [Float coercions] - | Pair ty1 _ty2 <- coercionKind co -- Do *not* do this if rhs has an unlifted type + | let ty1 = coercionLKind co -- Do *not* do this if rhs has an unlifted type , not (isUnliftedType ty1) -- see Note [Float coercions (unlifted)] = do { (floats, rhs') <- makeTrivialWithInfo mode top_lvl occ sanitised_info rhs ; return (floats, Cast rhs' co) } @@ -1308,7 +1307,7 @@ simplCast env body co0 cont0 -- only needed by `sc_hole_ty` which is often not forced. -- Consequently it is worthwhile using a lazy pattern match here to -- avoid unnecessary coercionKind evaluations. - , ~(Pair hole_ty _) <- coercionKind co + , let hole_ty = coercionLKind co = {-#SCC "addCoerce-pushCoTyArg" #-} do { tail' <- addCoerceM m_co' tail ; return (cont { sc_arg_ty = arg_ty' @@ -1319,7 +1318,7 @@ simplCast env body co0 cont0 addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup, sc_cont = tail }) | Just (co1, m_co2) <- pushCoValArg co - , Pair _ new_ty <- coercionKind co1 + , let new_ty = coercionRKind co1 , 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 |