diff options
| author | Richard Eisenberg <rae@richarde.dev> | 2020-08-05 14:04:50 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-09-29 00:31:27 -0400 |
| commit | 583a2070f1ad9162a365b034b27c3b80daafb8df (patch) | |
| tree | f12a0048b691cbd210d4f711acdc2852a6085564 /compiler/GHC/Core/Coercion/Opt.hs | |
| parent | a9ce159ba58ca7e8946b46e19b1361588b677a26 (diff) | |
| download | haskell-583a2070f1ad9162a365b034b27c3b80daafb8df.tar.gz | |
Optimize NthCo (FunCo ...) in coercion opt
We were missing this case previously.
Close #18528.
Metric Decrease:
T18223
T5321Fun
Diffstat (limited to 'compiler/GHC/Core/Coercion/Opt.hs')
| -rw-r--r-- | compiler/GHC/Core/Coercion/Opt.hs | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs index b9656a45bb..fb0a6b0cc0 100644 --- a/compiler/GHC/Core/Coercion/Opt.hs +++ b/compiler/GHC/Core/Coercion/Opt.hs @@ -332,6 +332,7 @@ opt_co4 env _sym rep r (NthCo _r n co) , Just (_tc, args) <- ASSERT( r == _r ) splitTyConApp_maybe ty = liftCoSubst (chooseRole rep r) env (args `getNth` n) + | Just (ty, _) <- isReflCo_maybe co , n == 0 , Just (tv, _) <- splitForAllTy_maybe ty @@ -342,6 +343,11 @@ opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos)) = ASSERT( r == r1 ) opt_co4_wrap env sym rep r (cos `getNth` n) +-- see the definition of GHC.Builtin.Types.Prim.funTyCon +opt_co4 env sym rep r (NthCo r1 n (FunCo _r2 w co1 co2)) + = ASSERT( r == r1 ) + opt_co4_wrap env sym rep r (mkNthCoFunCo n w co1 co2) + opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) -- works for both tyvar and covar = ASSERT( r == _r ) @@ -349,18 +355,16 @@ opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _)) opt_co4_wrap env sym rep Nominal eta opt_co4 env sym rep r (NthCo _r n co) - | TyConAppCo _ _ cos <- co' - , let nth_co = cos `getNth` n + | Just nth_co <- case co' of + TyConAppCo _ _ cos -> Just (cos `getNth` n) + FunCo _ w co1 co2 -> Just (mkNthCoFunCo n w co1 co2) + ForAllCo _ eta _ -> Just eta + _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo then opt_co4_wrap (zapLiftingContext env) False True Nominal nth_co else nth_co - | ForAllCo _ eta _ <- co' - = if rep - then opt_co4_wrap (zapLiftingContext env) False True Nominal eta - else eta - | otherwise = wrapRole rep r $ NthCo r n co' where |