summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore/Expr.hs
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2020-02-20 16:48:16 +0100
committerSebastian Graf <sebastian.graf@kit.edu>2020-02-26 13:35:54 +0100
commit054e7ac57418c55f1004cf432cb3a5485464fd4b (patch)
treef03d566d38a9a52e479f5b2d8a22fc4bc8390089 /compiler/GHC/HsToCore/Expr.hs
parent9d09411122b9b534b96e988b6d3f6d7eb04b8f66 (diff)
downloadhaskell-wip/pmcheck-ldi.tar.gz
PmCheck: Implement Long-distance information with Covered setswip/pmcheck-ldi
Consider ```hs data T = A | B | C f :: T -> Int f A = 1 f x = case x of A -> 2 B -> 3 C -> 4 ``` Clearly, the RHS returning 2 is redundant. But we don't currently see that, because our approximation to the covered set of the inner case expression just picks up the positive information from surrounding pattern matches. It lacks the context sensivity that `x` can't be `A` anymore! Therefore, we adopt the conceptually and practically superior approach of reusing the covered set of a particular GRHS from an outer pattern match. In this case, we begin checking the `case` expression with the covered set of `f`s second clause, which encodes the information that `x` can't be `A` anymore. After this MR, we will successfully warn about the RHS returning 2 being redundant. Perhaps surprisingly, this was a great simplification to the code of both the coverage checker and the desugarer. Found a redundant case alternative in `unix` submodule, so we have to bump it with a fix. Metric Decrease: T12227
Diffstat (limited to 'compiler/GHC/HsToCore/Expr.hs')
-rw-r--r--compiler/GHC/HsToCore/Expr.hs11
1 files changed, 6 insertions, 5 deletions
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index b627d6e841..6328d473ec 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -69,6 +69,7 @@ import Outputable
import PatSyn
import Control.Monad
+import Data.List.NonEmpty ( nonEmpty )
{-
************************************************************************
@@ -216,8 +217,8 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss
, pat_ext = NPatBindTc _ ty }) body
= -- let C x# y# = rhs in body
-- ==> case rhs of C x# y# -> body
- do { rhs <- dsGuarded grhss ty
- ; checkGuardMatches PatBindGuards grhss
+ do { rhs_deltas <- checkGuardMatches PatBindGuards grhss
+ ; rhs <- dsGuarded grhss ty (nonEmpty rhs_deltas)
; let upat = unLoc pat
eqn = EqnInfo { eqn_pats = [upat],
eqn_orig = FromSource,
@@ -446,9 +447,9 @@ dsExpr (HsMultiIf res_ty alts)
= mkErrorExpr
| otherwise
- = do { match_result <- liftM (foldr1 combineMatchResults)
- (mapM (dsGRHS IfAlt res_ty) alts)
- ; checkGuardMatches IfAlt (GRHSs noExtField alts (noLoc emptyLocalBinds))
+ = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds)
+ ; rhss_deltas <- checkGuardMatches IfAlt grhss
+ ; match_result <- dsGRHSs IfAlt grhss res_ty (nonEmpty rhss_deltas)
; error_expr <- mkErrorExpr
; extractMatchResult match_result error_expr }
where