[Git][ghc/ghc][wip/pm-no-ewildpat] Stop misusing EWildPat in pattern match coverage checking

[Vladislav Zavialov]

Vladislav Zavialov pushed to branch wip/pm-no-ewildpat at Glasgow Haskell Compiler / GHC


Commits:
6835f0fe by Vladislav Zavialov at 2019-04-19T15:55:23Z
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 changed file:

- compiler/deSugar/Check.hs


Changes:

=====================================
compiler/deSugar/Check.hs
=====================================
@@ -157,7 +157,8 @@ 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
+  PmFake :: PmPat 'PAT
 
 instance Outputable (PmPat a) where
   ppr = pprPmPatDebug
@@ -930,17 +931,9 @@ truePattern = nullaryConPattern (RealDataCon trueDataCon)
 
 -- | 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) }
+fake_pat = PmFake
 {-# 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
@@ -1457,6 +1450,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
@@ -1753,6 +1747,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
@@ -2023,13 +2018,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 +2179,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 +2740,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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6835f0fe79db21fb0afa36a6a198f332f7255672

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6835f0fe79db21fb0afa36a6a198f332f7255672
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190419/1a6b794f/attachment-0001.html>