WIP on combining Step 1 and 3 of Trees That Grow

See https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow

Trees that grow extension points are added for
- ValBinds
- HsPat
- HsLit
- HsOverLit
- HsType
- HsTyVarBndr
- HsAppType
- FieldOcc
- AmbiguousFieldOcc

Updates haddock submodule

Test Plan: ./validate

Reviewers: shayan-najd, simonpj, austin, goldfire, bgamari

Subscribers: goldfire, rwbarton, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D4147

1 files changed, 194 insertions, 109 deletions

diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index e05d8bbf68..e0904b89fc 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -15,9 +15,11 @@
                                       -- in module PlaceHolder
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 module HsPat (
         Pat(..), InPat, OutPat, LPat,
+        ListPatTc(..),
 
         HsConPatDetails, hsConPatArgs,
         HsRecFields(..), HsRecField'(..), LHsRecField',
@@ -49,6 +51,7 @@ import HsExtension
 import HsTypes
 import TcEvidence
 import BasicTypes
+import PlaceHolder
 -- others:
 import PprCore          ( {- instance OutputableBndr TyVar -} )
 import TysWiredIn
@@ -78,42 +81,47 @@ type LPat p = Located (Pat p)
 -- For details on above see note [Api annotations] in ApiAnnotation
 data Pat p
   =     ------------ Simple patterns ---------------
-    WildPat     (PostTc p Type)        -- ^ Wildcard Pattern
+    WildPat     (XWildPat p)        -- ^ Wildcard Pattern
         -- The sole reason for a type on a WildPat is to
         -- support hsPatType :: Pat Id -> Type
 
        -- AZ:TODO above comment needs to be updated
-  | VarPat      (Located (IdP p))  -- ^ Variable Pattern
+  | VarPat      (XVarPat p)
+                (Located (IdP p))  -- ^ Variable Pattern
 
                              -- See Note [Located RdrNames] in HsExpr
-  | LazyPat     (LPat p)                -- ^ Lazy Pattern
+  | LazyPat     (XLazyPat p)
+                (LPat p)                -- ^ Lazy Pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | AsPat       (Located (IdP p)) (LPat p)    -- ^ As pattern
+  | AsPat       (XAsPat p)
+                (Located (IdP p)) (LPat p)    -- ^ As pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | ParPat      (LPat p)                -- ^ Parenthesised pattern
+  | ParPat      (XParPat p)
+                (LPat p)                -- ^ Parenthesised pattern
                                         -- See Note [Parens in HsSyn] in HsExpr
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
     --                                    'ApiAnnotation.AnnClose' @')'@
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-  | BangPat     (LPat p)                -- ^ Bang pattern
+  | BangPat     (XBangPat p)
+                (LPat p)                -- ^ Bang pattern
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang'
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
         ------------ Lists, tuples, arrays ---------------
-  | ListPat     [LPat p]
-                (PostTc p Type)                      -- The type of the elements
-                (Maybe (PostTc p Type, SyntaxExpr p)) -- For rebindable syntax
-                   -- For OverloadedLists a Just (ty,fn) gives
-                   -- overall type of the pattern, and the toList
-                   -- function to convert the scrutinee to a list value
+  | ListPat     (XListPat p)
+                   -- See XListPat type instances below.
+                   --   For OverloadedLists a Just (ty,fn) gives
+                   --   overall type of the pattern, and the toList
+                   --   function to convert the scrutinee to a list value
+                [LPat p]
     -- ^ Syntactic List
     --
     -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
@@ -121,12 +129,13 @@ data Pat p
 
     -- For details on above see note [Api annotations] in ApiAnnotation
 
-  | TuplePat    [LPat p]         -- Tuple sub-patterns
+  | TuplePat    (XTuplePat p)
+                  -- after typechecking, holds the types of the tuple components
+                [LPat p]         -- Tuple sub-patterns
                 Boxity           -- UnitPat is TuplePat []
-                [PostTc p Type]  -- [] before typechecker, filled in afterwards
-                                 -- with the types of the tuple components
-        -- You might think that the PostTc p Type was redundant, because we can
-        -- get the pattern type by getting the types of the sub-patterns.
+        -- You might think that the post typechecking Type was redundant,
+        -- because we can get the pattern type by getting the types of the
+        -- sub-patterns.
         -- But it's essential
         --      data T a where
         --        T1 :: Int -> T Int
@@ -146,12 +155,12 @@ data Pat p
     --            'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
     --            'ApiAnnotation.AnnClose' @')'@ or  @'#)'@
 
-  | SumPat      (LPat p)           -- Sum sub-pattern
-                ConTag             -- Alternative (one-based)
-                Arity              -- Arity (INVARIANT: ≥ 2)
-                (PostTc p [Type])  -- PlaceHolder before typechecker, filled in
+  | SumPat      (XSumPat p)        -- PlaceHolder before typechecker, filled in
                                    -- afterwards with the types of the
                                    -- alternative
+                (LPat p)           -- Sum sub-pattern
+                ConTag             -- Alternative (one-based)
+                Arity              -- Arity (INVARIANT: ≥ 2)
     -- ^ Anonymous sum pattern
     --
     -- - 'ApiAnnotation.AnnKeywordId' :
@@ -159,8 +168,8 @@ data Pat p
     --            'ApiAnnotation.AnnClose' @'#)'@
 
     -- For details on above see note [Api annotations] in ApiAnnotation
-  | PArrPat     [LPat p]                -- Syntactic parallel array
-                (PostTc p Type)         -- The type of the elements
+  | PArrPat     (XPArrPat p)   -- After typechecking,  the type of the elements
+                [LPat p]       -- Syntactic parallel array
     -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
     --                                    'ApiAnnotation.AnnClose' @':]'@
 
@@ -195,11 +204,11 @@ data Pat p
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | ViewPat       (LHsExpr p)
+  | ViewPat       (XViewPat p)     -- The overall type of the pattern
+                                   -- (= the argument type of the view function)
+                                   -- for hsPatType.
+                  (LHsExpr p)
                   (LPat p)
-                  (PostTc p Type)   -- The overall type of the pattern
-                                    -- (= the argument type of the view function)
-                                    -- for hsPatType.
     -- ^ View Pattern
 
         ------------ Pattern splices ---------------
@@ -207,31 +216,34 @@ data Pat p
   --        'ApiAnnotation.AnnClose' @')'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | SplicePat       (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)
+  | SplicePat       (XSplicePat p)
+                    (HsSplice p)    -- ^ Splice Pattern (Includes quasi-quotes)
 
         ------------ Literal and n+k patterns ---------------
-  | LitPat          (HsLit p)           -- ^ Literal Pattern
+  | LitPat          (XLitPat p)
+                    (HsLit p)           -- ^ Literal Pattern
                                         -- Used for *non-overloaded* literal patterns:
                                         -- Int#, Char#, Int, Char, String, etc.
 
   | NPat                -- Natural Pattern
                         -- Used for all overloaded literals,
                         -- including overloaded strings with -XOverloadedStrings
+                    (XNPat p)            -- Overall type of pattern. Might be
+                                         -- different than the literal's type
+                                         -- if (==) or negate changes the type
                     (Located (HsOverLit p))     -- ALWAYS positive
                     (Maybe (SyntaxExpr p)) -- Just (Name of 'negate') for
                                            -- negative patterns, Nothing
                                            -- otherwise
                     (SyntaxExpr p)       -- Equality checker, of type t->t->Bool
-                    (PostTc p Type)      -- Overall type of pattern. Might be
-                                         -- different than the literal's type
-                                         -- if (==) or negate changes the type
 
   -- ^ Natural Pattern
   --
   -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnVal' @'+'@
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | NPlusKPat       (Located (IdP p))        -- n+k pattern
+  | NPlusKPat       (XNPlusKPat p)           -- Type of overall pattern
+                    (Located (IdP p))        -- n+k pattern
                     (Located (HsOverLit p))  -- It'll always be an HsIntegral
                     (HsOverLit p)       -- See Note [NPlusK patterns] in TcPat
                      -- NB: This could be (PostTc ...), but that induced a
@@ -239,24 +251,22 @@ data Pat p
 
                     (SyntaxExpr p)   -- (>=) function, of type t1->t2->Bool
                     (SyntaxExpr p)   -- Name of '-' (see RnEnv.lookupSyntaxName)
-                    (PostTc p Type)  -- Type of overall pattern
   -- ^ n+k pattern
 
         ------------ Pattern type signatures ---------------
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
 
   -- For details on above see note [Api annotations] in ApiAnnotation
-  | SigPatIn        (LPat p)                  -- Pattern with a type signature
-                    (LHsSigWcType p)          -- Signature can bind both
-                                              -- kind and type vars
-    -- ^ Pattern with a type signature
-
-  | SigPatOut       (LPat p)
-                    Type
+  | SigPat          (XSigPat p)          -- Before typechecker
+                                         --  Signature can bind both
+                                         --  kind and type vars
+                                         -- After typechecker: Type
+                    (LPat p)                -- Pattern with a type signature
     -- ^ Pattern with a type signature
 
         ------------ Pattern coercions (translation only) ---------------
-  | CoPat       HsWrapper           -- Coercion Pattern
+  | CoPat       (XCoPat p)
+                HsWrapper           -- Coercion Pattern
                                     -- If co :: t1 ~ t2, p :: t2,
                                     -- then (CoPat co p) :: t1
                 (Pat p)             -- Why not LPat?  Ans: existing locn will do
@@ -264,8 +274,74 @@ data Pat p
         -- During desugaring a (CoPat co pat) turns into a cast with 'co' on
         -- the scrutinee, followed by a match on 'pat'
     -- ^ Coercion Pattern
+
+  -- | Trees that Grow extension point for new constructors
+  | XPat
+      (XXPat p)
 deriving instance (DataId p) => Data (Pat p)
 
+-- | The typechecker-specific information for a 'ListPat'
+data ListPatTc =
+  ListPatTc     Type                      -- The type of the elements
+                (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
+                   -- For OverloadedLists a Just (ty,fn) gives
+                   -- overall type of the pattern, and the toList
+                   -- function to convert the scrutinee to a list value
+     deriving Data
+
+-- ---------------------------------------------------------------------
+
+type instance XWildPat GhcPs = PlaceHolder
+type instance XWildPat GhcRn = PlaceHolder
+type instance XWildPat GhcTc = Type
+
+type instance XVarPat  (GhcPass _) = PlaceHolder
+type instance XLazyPat (GhcPass _) = PlaceHolder
+type instance XAsPat   (GhcPass _) = PlaceHolder
+type instance XParPat  (GhcPass _) = PlaceHolder
+type instance XBangPat (GhcPass _) = PlaceHolder
+
+type instance XListPat GhcPs = PlaceHolder
+type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn) -- For rebindable syntax
+type instance XListPat GhcTc = ListPatTc
+
+type instance XTuplePat GhcPs = PlaceHolder
+type instance XTuplePat GhcRn = PlaceHolder
+type instance XTuplePat GhcTc = [Type]
+
+type instance XSumPat GhcPs = PlaceHolder
+type instance XSumPat GhcRn = PlaceHolder
+type instance XSumPat GhcTc = [Type]
+
+type instance XPArrPat GhcPs = PlaceHolder
+type instance XPArrPat GhcRn = PlaceHolder
+type instance XPArrPat GhcTc = Type
+
+type instance XViewPat GhcPs = PlaceHolder
+type instance XViewPat GhcRn = PlaceHolder
+type instance XViewPat GhcTc = Type
+
+type instance XSplicePat (GhcPass _) = PlaceHolder
+type instance XLitPat    (GhcPass _) = PlaceHolder
+
+type instance XNPat GhcPs = PlaceHolder
+type instance XNPat GhcRn = PlaceHolder
+type instance XNPat GhcTc = Type
+
+type instance XNPlusKPat GhcPs = PlaceHolder
+type instance XNPlusKPat GhcRn = PlaceHolder
+type instance XNPlusKPat GhcTc = Type
+
+type instance XSigPat GhcPs = (LHsSigWcType GhcPs)
+type instance XSigPat GhcRn = (LHsSigWcType GhcRn)
+type instance XSigPat GhcTc = Type
+
+type instance XCoPat  (GhcPass _) = PlaceHolder
+type instance XXPat   (GhcPass _) = PlaceHolder
+
+-- ---------------------------------------------------------------------
+
+
 -- | Haskell Constructor Pattern Details
 type HsConPatDetails p = HsConDetails (LPat p) (HsRecFields p (LPat p))
 
@@ -382,24 +458,24 @@ data HsRecField' id arg = HsRecField {
 --
 -- See also Note [Disambiguating record fields] in TcExpr.
 
-hsRecFields :: HsRecFields p arg -> [PostRn p (IdP p)]
+hsRecFields :: HsRecFields p arg -> [XFieldOcc p]
 hsRecFields rbinds = map (unLoc . hsRecFieldSel . unLoc) (rec_flds rbinds)
 
 -- Probably won't typecheck at once, things have changed :/
 hsRecFieldsArgs :: HsRecFields p arg -> [arg]
 hsRecFieldsArgs rbinds = map (hsRecFieldArg . unLoc) (rec_flds rbinds)
 
-hsRecFieldSel :: HsRecField pass arg -> Located (PostRn pass (IdP pass))
-hsRecFieldSel = fmap selectorFieldOcc . hsRecFieldLbl
+hsRecFieldSel :: HsRecField pass arg -> Located (XFieldOcc pass)
+hsRecFieldSel = fmap extFieldOcc . hsRecFieldLbl
 
 hsRecFieldId :: HsRecField GhcTc arg -> Located Id
 hsRecFieldId = hsRecFieldSel
 
-hsRecUpdFieldRdr :: HsRecUpdField p -> Located RdrName
+hsRecUpdFieldRdr :: HsRecUpdField (GhcPass p) -> Located RdrName
 hsRecUpdFieldRdr = fmap rdrNameAmbiguousFieldOcc . hsRecFieldLbl
 
 hsRecUpdFieldId :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Id
-hsRecUpdFieldId = fmap selectorFieldOcc . hsRecUpdFieldOcc
+hsRecUpdFieldId = fmap extFieldOcc . hsRecUpdFieldOcc
 
 hsRecUpdFieldOcc :: HsRecField' (AmbiguousFieldOcc GhcTc) arg -> LFieldOcc GhcTc
 hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
@@ -413,8 +489,8 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
 ************************************************************************
 -}
 
-instance (SourceTextX pass, OutputableBndrId pass)
-       => Outputable (Pat pass) where
+instance (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+       => Outputable (Pat (GhcPass p)) where
     ppr = pprPat
 
 pprPatBndr :: OutputableBndr name => name -> SDoc
@@ -426,10 +502,12 @@ pprPatBndr var                  -- Print with type info if -dppr-debug is on
     else
         pprPrefixOcc var
 
-pprParendLPat :: (SourceTextX pass, OutputableBndrId pass) => LPat pass -> SDoc
+pprParendLPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+              => LPat (GhcPass p) -> SDoc
 pprParendLPat (L _ p) = pprParendPat p
 
-pprParendPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> SDoc
+pprParendPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+             => Pat (GhcPass p) -> SDoc
 pprParendPat p = sdocWithDynFlags $ \ dflags ->
                  if need_parens dflags p
                  then parens (pprPat p)
@@ -443,29 +521,31 @@ pprParendPat p = sdocWithDynFlags $ \ dflags ->
       -- But otherwise the CoPat is discarded, so it
       -- is the pattern inside that matters.  Sigh.
 
-pprPat :: (SourceTextX pass, OutputableBndrId pass) => Pat pass -> SDoc
-pprPat (VarPat (L _ var))     = pprPatBndr var
+pprPat :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+       => Pat (GhcPass p) -> SDoc
+pprPat (VarPat _ (L _ var))   = pprPatBndr var
 pprPat (WildPat _)            = char '_'
-pprPat (LazyPat pat)          = char '~' <> pprParendLPat pat
-pprPat (BangPat pat)          = char '!' <> pprParendLPat pat
-pprPat (AsPat name pat)       = hcat [pprPrefixOcc (unLoc name), char '@', pprParendLPat pat]
-pprPat (ViewPat expr pat _)   = hcat [pprLExpr expr, text " -> ", ppr pat]
-pprPat (ParPat pat)           = parens (ppr pat)
-pprPat (LitPat s)             = ppr s
-pprPat (NPat l Nothing  _ _)  = ppr l
-pprPat (NPat l (Just _) _ _)  = char '-' <> ppr l
-pprPat (NPlusKPat n k _ _ _ _)= hcat [ppr n, char '+', ppr k]
-pprPat (SplicePat splice)     = pprSplice splice
-pprPat (CoPat co pat _)       = pprHsWrapper co (\parens -> if parens
+pprPat (LazyPat _ pat)        = char '~' <> pprParendLPat pat
+pprPat (BangPat _ pat)        = char '!' <> pprParendLPat pat
+pprPat (AsPat _ name pat)     = hcat [ pprPrefixOcc (unLoc name), char '@'
+                                     , pprParendLPat pat]
+pprPat (ViewPat _ expr pat)   = hcat [pprLExpr expr, text " -> ", ppr pat]
+pprPat (ParPat _ pat)         = parens (ppr pat)
+pprPat (LitPat _ s)           = ppr s
+pprPat (NPat _ l Nothing  _)  = ppr l
+pprPat (NPat _ l (Just _) _)  = char '-' <> ppr l
+pprPat (NPlusKPat _ n k _ _ _)= hcat [ppr n, char '+', ppr k]
+pprPat (SplicePat _ splice)   = pprSplice splice
+pprPat (CoPat _ co pat _)     = pprHsWrapper co (\parens -> if parens
                                                             then pprParendPat pat
                                                             else pprPat pat)
-pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
-pprPat (SigPatOut pat ty)     = ppr pat <+> dcolon <+> ppr ty
-pprPat (ListPat pats _ _)     = brackets (interpp'SP pats)
-pprPat (PArrPat pats _)       = paBrackets (interpp'SP pats)
-pprPat (TuplePat pats bx _)   = tupleParens (boxityTupleSort bx) (pprWithCommas ppr pats)
-pprPat (SumPat pat alt arity _) = sumParens (pprAlternative ppr pat alt arity)
-pprPat (ConPatIn con details) = pprUserCon (unLoc con) details
+pprPat (SigPat ty pat)        = ppr pat <+> dcolon <+> ppr ty
+pprPat (ListPat _ pats)       = brackets (interpp'SP pats)
+pprPat (PArrPat _ pats)       = paBrackets (interpp'SP pats)
+pprPat (TuplePat _ pats bx)
+  = tupleParens (boxityTupleSort bx) (pprWithCommas ppr pats)
+pprPat (SumPat _ pat alt arity) = sumParens (pprAlternative ppr pat alt arity)
+pprPat (ConPatIn con details)   = pprUserCon (unLoc con) details
 pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
                     pat_binds = binds, pat_args = details })
   = sdocWithDynFlags $ \dflags ->
@@ -478,14 +558,16 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts,
                          , ppr binds])
           <+> pprConArgs details
     else pprUserCon (unLoc con) details
+pprPat (XPat x)               = ppr x
 
-
-pprUserCon :: (SourceTextX p, OutputableBndr con, OutputableBndrId p)
-           => con -> HsConPatDetails p -> SDoc
+pprUserCon :: (SourceTextX (GhcPass p), OutputableBndr con,
+               OutputableBndrId (GhcPass p))
+           => con -> HsConPatDetails (GhcPass p) -> SDoc
 pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2
 pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details
 
-pprConArgs :: (SourceTextX p, OutputableBndrId p) => HsConPatDetails p -> SDoc
+pprConArgs :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
+           => HsConPatDetails (GhcPass p) -> SDoc
 pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats)
 pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2]
 pprConArgs (RecCon rpats)   = ppr rpats
@@ -524,9 +606,12 @@ mkPrefixConPat dc pats tys
 mkNilPat :: Type -> OutPat p
 mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
 
-mkCharLitPat :: (SourceTextX p) => SourceText -> Char -> OutPat p
+mkCharLitPat :: (SourceTextX (GhcPass p))
+             => SourceText -> Char -> OutPat (GhcPass p)
 mkCharLitPat src c = mkPrefixConPat charDataCon
-                          [noLoc $ LitPat (HsCharPrim (setSourceText src) c)] []
+                      [noLoc $ LitPat PlaceHolder
+                                      (HsCharPrim (setSourceText src) c)]
+                      []
 
 {-
 ************************************************************************
@@ -561,7 +646,7 @@ The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 -}
 
 isBangedLPat :: LPat p -> Bool
-isBangedLPat (L _ (ParPat p))   = isBangedLPat p
+isBangedLPat (L _ (ParPat _ p)) = isBangedLPat p
 isBangedLPat (L _ (BangPat {})) = True
 isBangedLPat _                  = False
 
@@ -579,8 +664,8 @@ looksLazyPatBind _
   = False
 
 looksLazyLPat :: LPat p -> Bool
-looksLazyLPat (L _ (ParPat p))             = looksLazyLPat p
-looksLazyLPat (L _ (AsPat _ p))            = looksLazyLPat p
+looksLazyLPat (L _ (ParPat _ p))           = looksLazyLPat p
+looksLazyLPat (L _ (AsPat _ _ p))          = looksLazyLPat p
 looksLazyLPat (L _ (BangPat {}))           = False
 looksLazyLPat (L _ (VarPat {}))            = False
 looksLazyLPat (L _ (WildPat {}))           = False
@@ -607,15 +692,14 @@ isIrrefutableHsPat pat
     go1 (WildPat {})        = True
     go1 (VarPat {})         = True
     go1 (LazyPat {})        = True
-    go1 (BangPat pat)       = go pat
-    go1 (CoPat _ pat _)     = go1 pat
-    go1 (ParPat pat)        = go pat
-    go1 (AsPat _ pat)       = go pat
-    go1 (ViewPat _ pat _)   = go pat
-    go1 (SigPatIn pat _)    = go pat
-    go1 (SigPatOut pat _)   = go pat
-    go1 (TuplePat pats _ _) = all go pats
-    go1 (SumPat _ _ _ _)    = False
+    go1 (BangPat _ pat)     = go pat
+    go1 (CoPat _ _ pat _)   = go1 pat
+    go1 (ParPat _ pat)      = go pat
+    go1 (AsPat _ _ pat)     = go pat
+    go1 (ViewPat _ _ pat)   = go pat
+    go1 (SigPat _ pat)      = go pat
+    go1 (TuplePat _ pats _) = all go pats
+    go1 (SumPat {})         = False
                     -- See Note [Unboxed sum patterns aren't irrefutable]
     go1 (ListPat {})        = False
     go1 (PArrPat {})        = False     -- ?
@@ -637,6 +721,8 @@ isIrrefutableHsPat pat
     -- since we cannot know until the splice is evaluated.
     go1 (SplicePat {})      = False
 
+    go1 (XPat {})           = False
+
 {- Note [Unboxed sum patterns aren't irrefutable]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Unlike unboxed tuples, unboxed sums are *not* irrefutable when used as
@@ -664,10 +750,9 @@ hsPatNeedsParens (NPlusKPat {})      = True
 hsPatNeedsParens (SplicePat {})      = False
 hsPatNeedsParens (ConPatIn _ ds)     = conPatNeedsParens ds
 hsPatNeedsParens p@(ConPatOut {})    = conPatNeedsParens (pat_args p)
-hsPatNeedsParens (SigPatIn {})       = True
-hsPatNeedsParens (SigPatOut {})      = True
+hsPatNeedsParens (SigPat {})         = True
 hsPatNeedsParens (ViewPat {})        = True
-hsPatNeedsParens (CoPat _ p _)       = hsPatNeedsParens p
+hsPatNeedsParens (CoPat _ _ p _)     = hsPatNeedsParens p
 hsPatNeedsParens (WildPat {})        = False
 hsPatNeedsParens (VarPat {})         = False
 hsPatNeedsParens (LazyPat {})        = False
@@ -680,6 +765,7 @@ hsPatNeedsParens (ListPat {})        = False
 hsPatNeedsParens (PArrPat {})        = False
 hsPatNeedsParens (LitPat {})         = False
 hsPatNeedsParens (NPat {})           = False
+hsPatNeedsParens (XPat {})           = True -- conservative default
 
 conPatNeedsParens :: HsConDetails a b -> Bool
 conPatNeedsParens (PrefixCon {}) = False
@@ -691,30 +777,29 @@ conPatNeedsParens (RecCon {})    = False
 -}
 
 -- May need to add more cases
-collectEvVarsPats :: [Pat p] -> Bag EvVar
+collectEvVarsPats :: [Pat GhcTc] -> Bag EvVar
 collectEvVarsPats = unionManyBags . map collectEvVarsPat
 
-collectEvVarsLPat :: LPat p -> Bag EvVar
+collectEvVarsLPat :: LPat GhcTc -> Bag EvVar
 collectEvVarsLPat (L _ pat) = collectEvVarsPat pat
 
-collectEvVarsPat :: Pat p -> Bag EvVar
+collectEvVarsPat :: Pat GhcTc -> Bag EvVar
 collectEvVarsPat pat =
   case pat of
-    LazyPat  p        -> collectEvVarsLPat p
-    AsPat _  p        -> collectEvVarsLPat p
-    ParPat   p        -> collectEvVarsLPat p
-    BangPat  p        -> collectEvVarsLPat p
-    ListPat  ps _ _   -> unionManyBags $ map collectEvVarsLPat ps
-    TuplePat ps _ _   -> unionManyBags $ map collectEvVarsLPat ps
-    SumPat p _ _ _    -> collectEvVarsLPat p
-    PArrPat  ps _     -> unionManyBags $ map collectEvVarsLPat ps
+    LazyPat _ p      -> collectEvVarsLPat p
+    AsPat _ _ p      -> collectEvVarsLPat p
+    ParPat  _ p      -> collectEvVarsLPat p
+    BangPat _ p      -> collectEvVarsLPat p
+    ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
+    TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
+    SumPat _ p _ _   -> collectEvVarsLPat p
+    PArrPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     ConPatOut {pat_dicts = dicts, pat_args  = args}
-                      -> unionBags (listToBag dicts)
+                     -> unionBags (listToBag dicts)
                                    $ unionManyBags
                                    $ map collectEvVarsLPat
                                    $ hsConPatArgs args
-    SigPatOut p _     -> collectEvVarsLPat p
-    CoPat _ p _       -> collectEvVarsPat  p
-    ConPatIn _  _     -> panic "foldMapPatBag: ConPatIn"
-    SigPatIn _ _      -> panic "foldMapPatBag: SigPatIn"
-    _other_pat        -> emptyBag
+    SigPat  _ p      -> collectEvVarsLPat p
+    CoPat _ _ p _    -> collectEvVarsPat  p
+    ConPatIn _  _    -> panic "foldMapPatBag: ConPatIn"
+    _other_pat       -> emptyBag