diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Core/Opt/Arity.hs | 14 | ||||
| -rw-r--r-- | compiler/GHC/Core/Utils.hs | 2 |
2 files changed, 9 insertions, 7 deletions
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 8a0a69ca97..9312e7d48b 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -2353,7 +2353,7 @@ tryEtaReduce rec_ids bndrs body eval_sd -- for why we have an accumulating coercion -- -- Invariant: (go bs body co) returns an expression - -- equivalent to (\(reverse bs). body |> co) + -- equivalent to (\(reverse bs). (body |> co)) -- See Note [Eta reduction with casted function] go bs (Cast e co1) co2 @@ -2380,14 +2380,16 @@ tryEtaReduce rec_ids bndrs body eval_sd , remaining_bndrs `ltLength` bndrs -- Only reply Just if /something/ has happened , ok_fun fun - , let etad_expr = mkLams (reverse remaining_bndrs) (mkCast fun co) - used_vars = exprFreeVars etad_expr + , let used_vars = exprFreeVars fun `unionVarSet` tyCoVarsOfCo co reduced_bndrs = mkVarSet (dropList remaining_bndrs bndrs) + -- reduced_bndrs are the ones we are eta-reducing away , used_vars `disjointVarSet` reduced_bndrs - -- Check for any of the binders free in the result, - -- including the accumulated coercion + -- Check for any of the reduced_bndrs (about to be dropped) + -- free in the result, including the accumulated coercion. -- See Note [Eta reduction makes sense], intro and point (1) - = Just etad_expr + -- NB: don't compute used_vars from exprFreeVars (mkCast fun co) + -- because the latter may be ill formed if the guard fails (#21801) + = Just (mkLams (reverse remaining_bndrs) (mkCast fun co)) go _remaining_bndrs _fun _ = -- pprTrace "tER fail" (ppr _fun $$ ppr _remaining_bndrs) $ Nothing diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index e34e77ef9b..5ae6bf235a 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -275,7 +275,7 @@ mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) -- | Wrap the given expression in the coercion safely, dropping -- identity coercions and coalescing nested coercions -mkCast :: CoreExpr -> CoercionR -> CoreExpr +mkCast :: HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr mkCast e co | assertPpr (coercionRole co == Representational) (text "coercion" <+> ppr co <+> text "passed to mkCast" |