summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Gen/Pat.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Gen/Pat.hs')
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs25
1 files changed, 10 insertions, 15 deletions
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index be5a243dec..10c862f8f6 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -450,7 +450,8 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
-- (pat_ty -> inf_res_sigma)
expr_wrap = expr_wrap2' <.> expr_wrap1 <.> mult_wrap
doc = text "When checking the view pattern function:" <+> (ppr expr)
- ; return (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res)}
+
+ ; return $ (ViewPat pat_ty (mkLHsWrap expr_wrap expr') pat', res) }
{- Note [View patterns and polymorphism]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -487,25 +488,16 @@ Fortunately that's what matchExpectedFunTySigma returns anyway.
------------------------
-- Lists, tuples, arrays
- ListPat Nothing pats -> do
+
+ -- Necessarily a built-in list pattern, not an overloaded list pattern.
+ -- See Note [Desugaring overloaded list patterns].
+ ListPat _ pats -> do
{ (coi, elt_ty) <- matchExpectedPatTy matchExpectedListTy penv (scaledThing pat_ty)
; (pats', res) <- tcMultiple (tc_lpat (pat_ty `scaledSet` mkCheckExpType elt_ty))
penv pats thing_inside
; pat_ty <- readExpType (scaledThing pat_ty)
; return (mkHsWrapPat coi
- (ListPat (ListPatTc elt_ty Nothing) pats') pat_ty, res)
-}
-
- ListPat (Just e) pats -> do
- { tau_pat_ty <- expTypeToType (scaledThing pat_ty)
- ; ((pats', res, elt_ty), e')
- <- tcSyntaxOpGen ListOrigin e [SynType (mkCheckExpType tau_pat_ty)]
- SynList $
- \ [elt_ty] _ ->
- do { (pats', res) <- tcMultiple (tc_lpat (pat_ty `scaledSet` mkCheckExpType elt_ty))
- penv pats thing_inside
- ; return (pats', res, elt_ty) }
- ; return (ListPat (ListPatTc elt_ty (Just (tau_pat_ty,e'))) pats', res)
+ (ListPat elt_ty pats') pat_ty, res)
}
TuplePat _ pats boxity -> do
@@ -697,6 +689,9 @@ AST is used for the subtraction operation.
; tc_pat pat_ty penv pat thing_inside }
_ -> panic "invalid splice in splice pat"
+ XPat (HsPatExpanded lpat rpat) -> do
+ { (rpat', res) <- tc_pat pat_ty penv rpat thing_inside
+ ; return (XPat $ ExpansionPat lpat rpat', res) }
{-
Note [Hopping the LIE in lazy patterns]