Stop misusing EWildPat in pattern match coverage checking

EWildPat is a constructor of HsExpr used in the parser to represent
wildcards in ambiguous positions:

* in expression context, EWildPat is turned into hsHoleExpr (see rnExpr)
* in pattern context, EWildPat is turned into WildPat (see checkPattern)

Since EWildPat exists solely for the needs of the parser, we could
remove it by improving the parser.

However, EWildPat has also been used for a different purpose since
8a50610: to represent patterns that the coverage checker cannot handle.
Not only this is a misuse of EWildPat, it also stymies the removal of
EWildPat.

1 files changed, 22 insertions, 27 deletions

diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 8496786a8e..e87eb39d26 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -157,7 +157,9 @@ data PmPat :: PatTy -> * where
   PmNLit :: { pm_lit_id   :: Id
             , pm_lit_not  :: [PmLit] } -> PmPat 'VA
   PmGrd  :: { pm_grd_pv   :: PatVec
-            , pm_grd_expr :: PmExpr  } -> PmPat 'PAT
+            , pm_grd_expr :: PmExpr } -> PmPat 'PAT
+  -- | A fake guard pattern (True <- _) used to represent cases we cannot handle.
+  PmFake :: PmPat 'PAT
 
 instance Outputable (PmPat a) where
   ppr = pprPmPatDebug
@@ -928,24 +930,11 @@ truePattern :: Pattern
 truePattern = nullaryConPattern (RealDataCon trueDataCon)
 {-# INLINE truePattern #-}
 
--- | A fake guard pattern (True <- _) used to represent cases we cannot handle
-fake_pat :: Pattern
-fake_pat = PmGrd { pm_grd_pv   = [truePattern]
-                 , pm_grd_expr = PmExprOther (EWildPat noExt) }
-{-# INLINE fake_pat #-}
-
--- | Check whether a guard pattern is generated by the checker (unhandled)
-isFakeGuard :: [Pattern] -> PmExpr -> Bool
-isFakeGuard [PmCon { pm_con_con = RealDataCon c }] (PmExprOther (EWildPat _))
-  | c == trueDataCon = True
-  | otherwise        = False
-isFakeGuard _pats _e = False
-
 -- | Generate a `canFail` pattern vector of a specific type
 mkCanFailPmPat :: Type -> DsM PatVec
 mkCanFailPmPat ty = do
   var <- mkPmVar ty
-  return [var, fake_pat]
+  return [var, PmFake]
 
 vanillaConPattern :: ConLike -> [Type] -> PatVec -> Pattern
 -- ADT constructor pattern => no existentials, no local constraints
@@ -1295,7 +1284,7 @@ translateGuards fam_insts guards = do
     then pure all_guards
     else do
       kept <- filterM shouldKeep all_guards
-      pure (fake_pat : kept)
+      pure (PmFake : kept)
 
 -- | Check whether a pattern can fail to match
 cantFailPattern :: Pattern -> DsM Bool
@@ -1377,7 +1366,7 @@ cases:
           expressivity in our warnings.
 
      Hence, in this case, we replace the guard @([a,b] <- f x)@ with a *dummy*
-     @fake_pat@: @True <- _@. That is, we record that there is a possibility
+     @PmFake@: @True <- _@. That is, we record that there is a possibility
      of failure but we minimize it to a True/False. This generates a single
      warning and much smaller uncovered sets.
 
@@ -1421,7 +1410,7 @@ in the pattern bind case). Hence, we safely drop them.
 
 Additionally, top-level guard translation (performed by @translateGuards@)
 replaces guards that cannot be reasoned about (like the ones we described in
-1-4) with a single @fake_pat@ to record the possibility of failure to match.
+1-4) with a single @PmFake@ to record the possibility of failure to match.
 
 Note [Translate CoPats]
 ~~~~~~~~~~~~~~~~~~~~~~~
@@ -1457,6 +1446,7 @@ pmPatType (PmNLit { pm_lit_id  = x }) = idType x
 pmPatType (PmGrd  { pm_grd_pv  = pv })
   = ASSERT(patVecArity pv == 1) (pmPatType p)
   where Just p = find ((==1) . patternArity) pv
+pmPatType PmFake = pmPatType truePattern
 
 -- | Information about a conlike that is relevant to coverage checking.
 -- It is called an \"inhabitation candidate\" since it is a value which may
@@ -1679,7 +1669,7 @@ mkGuard pv e = do
   let expr = hsExprToPmExpr e
   tracePmD "mkGuard" (vcat [ppr pv, ppr e, ppr res, ppr expr])
   if | res                    -> pure (PmGrd pv expr)
-     | PmExprOther {} <- expr -> pure fake_pat
+     | PmExprOther {} <- expr -> pure PmFake
      | otherwise              -> pure (PmGrd pv expr)
 
 -- | Create a term equality of the form: `(False ~ (x ~ lit))`
@@ -1753,6 +1743,7 @@ coercePmPat (PmCon { pm_con_con = con, pm_con_arg_tys = arg_tys
            , pm_con_tvs  = tvs, pm_con_dicts = dicts
            , pm_con_args = coercePatVec args }]
 coercePmPat (PmGrd {}) = [] -- drop the guards
+coercePmPat PmFake     = [] -- drop the guards
 
 -- | Check whether a 'ConLike' has the /single match/ property, i.e. whether
 -- it is the only possible match in the given context. See also
@@ -1765,7 +1756,7 @@ singleMatchConstructor cl tys =
 Note [Single match constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When translating pattern guards for consumption by the checker, we desugar
-every pattern guard that might fail ('cantFailPattern') to 'fake_pat'
+every pattern guard that might fail ('cantFailPattern') to 'PmFake'
 (True <- _). Which patterns can't fail? Exactly those that only match on
 'singleMatchConstructor's.
 
@@ -2023,13 +2014,15 @@ pmcheck [] guards vva@(ValVec [] _)
   | otherwise   = pmcheckGuardsI guards vva
 
 -- Guard
-pmcheck (p@(PmGrd pv e) : ps) guards vva@(ValVec vas delta)
-    -- short-circuit if the guard pattern is useless.
-    -- we just have two possible outcomes: fail here or match and recurse
-    -- none of the two contains any useful information about the failure
-    -- though. So just have these two cases but do not do all the boilerplate
-  | isFakeGuard pv e = forces . mkCons vva <$> pmcheckI ps guards vva
-  | otherwise = do
+pmcheck (PmFake : ps) guards vva =
+  -- short-circuit if the guard pattern is useless.
+  -- we just have two possible outcomes: fail here or match and recurse
+  -- none of the two contains any useful information about the failure
+  -- though. So just have these two cases but do not do all the boilerplate
+  forces . mkCons vva <$> pmcheckI ps guards vva
+pmcheck (p : ps) guards (ValVec vas delta)
+  | PmGrd { pm_grd_pv = pv, pm_grd_expr = e } <- p
+  = do
       y <- liftD $ mkPmId (pmPatType p)
       let tm_state = extendSubst y e (delta_tm_cs delta)
           delta'   = delta { delta_tm_cs = tm_state }
@@ -2182,6 +2175,7 @@ pmcheckHd (p@(PmCon {})) ps guards (PmNLit { pm_lit_id = x }) vva
   = pmcheckHdI p ps guards (PmVar x) vva
 
 -- Impossible: handled by pmcheck
+pmcheckHd PmFake     _ _ _ _ = panic "pmcheckHd: Fake"
 pmcheckHd (PmGrd {}) _ _ _ _ = panic "pmcheckHd: Guard"
 
 {-
@@ -2742,6 +2736,7 @@ pprPmPatDebug (PmLit li)  = text "PmLit" <+> ppr li
 pprPmPatDebug (PmNLit i nl) = text "PmNLit" <+> ppr i <+> ppr nl
 pprPmPatDebug (PmGrd pv ge) = text "PmGrd" <+> hsep (map pprPmPatDebug pv)
                                            <+> ppr ge
+pprPmPatDebug PmFake = text "PmFake"
 
 pprPatVec :: PatVec -> SDoc
 pprPatVec ps = hang (text "Pattern:") 2