summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
diff options
context:
space:
mode:
authorsheaf <sam.derbyshire@gmail.com>2021-07-30 13:50:25 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-08-04 16:38:40 -0400
commit7a9d8803cfde3c42da4b27a7b89bdcb2ac870e3f (patch)
tree0d2e0dd78e719d93e276fff0a668e8315639ff45 /compiler/GHC/Core/Opt/WorkWrap/Utils.hs
parent477bc2dd6d506ece1c5c030f79f3934ff1922a5f (diff)
downloadhaskell-7a9d8803cfde3c42da4b27a7b89bdcb2ac870e3f.tar.gz
Use Reductions to keep track of rewritings
We define Reduction = Reduction Coercion !Type. A reduction of the form 'Reduction co new_ty' witnesses an equality ty ~co~> new_ty. That is, the rewriting happens left-to-right: the right-hand-side type of the coercion is the rewritten type, and the left-hand-side type the original type. Sticking to this convention makes the codebase more consistent, helping to avoid certain applications of SymCo. This replaces the parts of the codebase which represented reductions as pairs, (Coercion,Type) or (Type,Coercion). Reduction being strict in the Type argument improves performance in some programs that rewrite many type families (such as T9872). Fixes #20161 ------------------------- Metric Decrease: T5321Fun T9872a T9872b T9872c T9872d -------------------------
Diffstat (limited to 'compiler/GHC/Core/Opt/WorkWrap/Utils.hs')
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap/Utils.hs3
1 files changed, 2 insertions, 1 deletions
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index c3e708c60d..beafa01b1c 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -30,6 +30,7 @@ import GHC.Core.Type
import GHC.Core.Multiplicity
import GHC.Core.Predicate ( isClassPred )
import GHC.Core.Coercion
+import GHC.Core.Reduction
import GHC.Core.FamInstEnv
import GHC.Core.TyCon
import GHC.Core.TyCon.RecWalk
@@ -1239,7 +1240,7 @@ findTypeShape fam_envs ty
= TsUnk
go_tc rec_tc tc tc_args
- | Just (_, rhs, _) <- topReduceTyFamApp_maybe fam_envs tc tc_args
+ | Just (HetReduction (Reduction _ rhs) _) <- topReduceTyFamApp_maybe fam_envs tc tc_args
= go rec_tc rhs
| Just con <- tyConSingleAlgDataCon_maybe tc