diff options
| -rw-r--r-- | compiler/GHC/Core.hs | 5 | ||||
| -rw-r--r-- | compiler/GHC/Core/Rules.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/Subst.hs | 12 |
3 files changed, 13 insertions, 6 deletions
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs index ecd9a6ee00..878068b903 100644 --- a/compiler/GHC/Core.hs +++ b/compiler/GHC/Core.hs @@ -114,7 +114,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Utils.Trace import Data.Data hiding (TyCon) import Data.Int @@ -1595,9 +1594,7 @@ cmpAltCon (DataAlt _) DEFAULT = GT cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2 cmpAltCon (LitAlt _) DEFAULT = GT -cmpAltCon con1 con2 = warnPprTrace True (text "Comparing incomparable AltCons" <+> - ppr con1 <+> ppr con2) $ - LT +cmpAltCon con1 con2 = pprPanic "cmpAltCon" (text "Incomparable AltCons" $$ ppr con1 $$ ppr con2) {- ************************************************************************ diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs index 878b905929..02511d96b5 100644 --- a/compiler/GHC/Core/Rules.hs +++ b/compiler/GHC/Core/Rules.hs @@ -933,7 +933,7 @@ match_var renv@(RV { rv_tmpls = tmpls, rv_lcl = rn_env, rv_fltR = flt_env }) Var v2 | v1' == rnOccR rn_env v2 -> Just subst - | Var v2' <- lookupIdSubst flt_env v2 + | Var v2' <- lookupIdSubstUnchecked flt_env v2 , v1' == v2' -> Just subst diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index 36f3bad0d4..7e0c0ef8f4 100644 --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -18,6 +18,7 @@ module GHC.Core.Subst ( substTy, substCo, substExpr, substExprSC, substBind, substBindSC, substUnfolding, substUnfoldingSC, lookupIdSubst, lookupTCvSubst, substIdType, substIdOcc, + lookupIdSubstUnchecked, substTickish, substDVarSet, substIdInfo, -- ** Operations on substitutions @@ -250,12 +251,21 @@ extendSubstList subst [] = subst extendSubstList subst ((var,rhs):prs) = extendSubstList (extendSubst subst var rhs) prs -- | Find the substitution for an 'Id' in the 'Subst' -lookupIdSubst :: HasDebugCallStack => Subst -> Id -> CoreExpr +lookupIdSubst :: HasCallStack => Subst -> Id -> CoreExpr lookupIdSubst (Subst in_scope ids _ _) v | not (isLocalId v) = Var v | Just e <- lookupVarEnv ids v = e | Just v' <- lookupInScope in_scope v = Var v' -- Vital! See Note [Extending the Subst] + | otherwise = pprPanic "lookupIdSubst" (ppr v $$ ppr in_scope) + +-- | Find the substitution for an 'Id' in the 'Subst' +lookupIdSubstUnchecked :: HasDebugCallStack => Subst -> Id -> CoreExpr +lookupIdSubstUnchecked (Subst in_scope ids _ _) v + | not (isLocalId v) = Var v + | Just e <- lookupVarEnv ids v = e + | Just v' <- lookupInScope in_scope v = Var v' + -- Vital! See Note [Extending the Subst] | otherwise = warnPprTrace True (text "GHC.Core.Subst.lookupIdSubst" <+> ppr v $$ ppr in_scope) $ Var v |