summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2020-08-10 17:58:17 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-08-13 03:44:52 -0400
commit55dec4dc6e8f8430810d212c73e78ffbb92e0a48 (patch)
tree2880ec2360764311c30afdba74ace624ef642cb1 /compiler/GHC/Hs
parent7831fe05021caa90d4696ca91ae2b31a82e65b3d (diff)
downloadhaskell-55dec4dc6e8f8430810d212c73e78ffbb92e0a48.tar.gz
PmCheck: Better long-distance info for where bindings (#18533)
Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Expr.hs2
-rw-r--r--compiler/GHC/Hs/Pat.hs2
2 files changed, 4 insertions, 0 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index d08e2079b0..806ee1d3a7 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -1243,7 +1243,9 @@ ppr_infix_expr (HsConLikeOut _ c) = Just (pprInfixOcc (conLikeName c))
ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f)
ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)
ppr_infix_expr (XExpr x) = case (ghcPass @p, x) of
+#if __GLASGOW_HASKELL__ <= 810
(GhcPs, _) -> Nothing
+#endif
(GhcRn, HsExpanded a _) -> ppr_infix_expr a
(GhcTc, WrapExpr (HsWrap _ e)) -> ppr_infix_expr e
(GhcTc, ExpansionExpr (HsExpanded a _)) -> ppr_infix_expr a
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 59873ac600..1bf9715d18 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -845,8 +845,10 @@ patNeedsParens p = go
go (SigPat {}) = p >= sigPrec
go (ViewPat {}) = True
go (XPat ext) = case ghcPass @p of
+#if __GLASGOW_HASKELL__ <= 810
GhcPs -> noExtCon ext
GhcRn -> noExtCon ext
+#endif
GhcTc -> go inner
where CoPat _ inner _ = ext
go (WildPat {}) = False