[Git][ghc/ghc][wip/pm-no-ewildpat] Stop misusing EWildPat in pattern match coverage checking
Vladislav Zavialov
gitlab at gitlab.haskell.org
Fri Apr 19 17:56:27 UTC 2019
Vladislav Zavialov pushed to branch wip/pm-no-ewildpat at Glasgow Haskell Compiler / GHC
Commits:
06cbfa85 by Vladislav Zavialov at 2019-04-19T17:56:08Z
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,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 <- _ at . That is, we record that there is a possibility
+ @PmFake@: @True <- _ at . 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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06cbfa85ed2fa4d02336095329fcd47d543bc993
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/06cbfa85ed2fa4d02336095329fcd47d543bc993
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/e6f7a4f3/attachment-0001.html>
More information about the ghc-commits
mailing list