diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-11-19 16:13:18 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2022-09-27 14:51:23 +0100 |
| commit | 9725dd6d418cc4fce0d01083fef1a82cf2633283 (patch) | |
| tree | 824aced18976482cdf77137a7f95d1dfd6b1a75f | |
| parent | 615e22789a04e74d7e02239b4580b95b077c3ae0 (diff) | |
| download | haskell-wip/T19001.tar.gz | |
Kill ad hoc Note [Case MFEs] hackwip/T19001
See discussion in #19001. I'm keen to kill this hack off.
This MR is to check CI and perf.
Also enable CaseOfCase in InitialPhase
| -rw-r--r-- | compiler/GHC/Core/Opt/SetLevels.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Iteration.hs | 8 |
2 files changed, 9 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs index 1d811b12cf..6a95327e72 100644 --- a/compiler/GHC/Core/Opt/SetLevels.hs +++ b/compiler/GHC/Core/Opt/SetLevels.hs @@ -637,9 +637,12 @@ lvlMFE env strict_ctxt (_, AnnCast e (_, co)) = do { e' <- lvlMFE env strict_ctxt e ; return (Cast e' (substCo (le_subst env) co)) } +{- Not doing this any more: #19001 lvlMFE env strict_ctxt e@(_, AnnCase {}) | strict_ctxt -- Don't share cases in a strict context = lvlExpr env e -- See Note [Case MFEs] +-} + lvlMFE env strict_ctxt ann_expr | floatTopLvlOnly env && not (isTopLvl dest_lvl) diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs index cfee2e5e56..358f526b1d 100644 --- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs +++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs @@ -1747,7 +1747,7 @@ simplNonRecE env bndr (rhs, rhs_se) body cont -- Deal with strict bindings -- See Note [Dark corner with representation polymorphism] - | isStrictId bndr1 && seCaseCase env + | isStrictId bndr1 -- && seCaseCase env || needs_case_binding -> simplExprF (rhs_se `setInScopeFromE` env) rhs (StrictBind { sc_bndr = bndr, sc_body = body @@ -1904,12 +1904,14 @@ wrapJoinCont env cont thing_inside | contIsStop cont -- Common case; no need for fancy footwork = thing_inside env cont +{- | not (seCaseCase env) -- See Note [Join points with -fno-case-of-case] = do { (floats1, expr1) <- thing_inside env (mkBoringStop (contHoleType cont)) ; let (floats2, expr2) = wrapJoinFloatsX floats1 expr1 ; (floats3, expr3) <- rebuild (env `setInScopeFromF` floats2) expr2 cont ; return (floats2 `addFloats` floats3, expr3) } +-} | otherwise -- Normal case; see Note [Join points and case-of-case] @@ -2212,7 +2214,7 @@ rebuildCall env fun_info -- Strict arguments | isStrictArgInfo fun_info - , seCaseCase env +-- , seCaseCase env = -- pprTrace "Strict Arg" (ppr arg $$ ppr (seIdSubst env) $$ ppr (seInScope env)) $ simplExprF (arg_se `setInScopeFromE` env) arg (StrictArg { sc_fun = fun_info, sc_fun_ty = fun_ty @@ -2955,10 +2957,12 @@ doCaseToLet scrut case_bndr -------------------------------------------------- reallyRebuildCase env scrut case_bndr alts cont +{- | not (seCaseCase env) = do { case_expr <- simplAlts env scrut case_bndr alts (mkBoringStop (contHoleType cont)) ; rebuild env case_expr cont } +-} | otherwise = do { (floats, env', cont') <- mkDupableCaseCont env alts cont |