Use HsExpansion for overloaded list patterns

Fixes #14380, #19997

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]