Trees That Grow refactor for `ConPat` and `CoPat`

- `ConPat{In,Out}` -> `ConPat`

- `CoPat` -> `XPat (CoPat ..)`

Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`.
After this change, moving the type family instances out of `GHC.HS.*` is
sufficient to break the cycle.

Add XCollectPat class to decide how binders are collected from XXPat based on the pass.

Previously we did this with IsPass, but that doesn't work for Haddock's
DocNameI, and the constraint doesn't express what actual distinction is being
made. Perhaps a class for collecting binders more generally is in order, but we
haven't attempted this yet.

Pure refactor of code around ConPat

 - InPat/OutPat synonyms removed

 - rename several identifiers

 - redundant constraints removed

 - move extension field in ConPat to be first

 - make ConPat use record syntax more consistently

Fix T6145 (ConPatIn became ConPat)

Add comments from SPJ.

Add comment about haddock's use of CollectPass.

Updates haddock submodule.

29 files changed, 584 insertions, 331 deletions

diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 0d67899b4c..db7a46805c 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -358,6 +358,9 @@ deriving instance Data (Pat GhcPs)
 deriving instance Data (Pat GhcRn)
 deriving instance Data (Pat GhcTc)
 
+deriving instance Data CoPat
+deriving instance Data ConPatTc
+
 deriving instance Data ListPatTc
 
 -- deriving instance (DataIdLR p p, Data body) => Data (HsRecFields p body)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 2b5c871ab1..c92967db81 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
@@ -23,8 +24,11 @@
 {-# LANGUAGE LambdaCase #-}
 
 module GHC.Hs.Pat (
-        Pat(..), InPat, OutPat, LPat,
+        Pat(..), LPat,
+        ConPatTc (..),
+        CoPat (..),
         ListPatTc(..),
+        ConLikeP,
 
         HsConPatDetails, hsConPatArgs,
         HsRecFields(..), HsRecField'(..), LHsRecField',
@@ -59,7 +63,6 @@ import GHC.Tc.Types.Evidence
 import GHC.Types.Basic
 -- others:
 import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
-import GHC.Driver.Session ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )
 import GHC.Builtin.Types
 import GHC.Types.Var
 import GHC.Types.Name.Reader ( RdrName )
@@ -71,12 +74,10 @@ import GHC.Core.Type
 import GHC.Types.SrcLoc
 import Bag -- collect ev vars from pats
 import Maybes
+import GHC.Types.Name (Name)
 -- libraries:
 import Data.Data hiding (TyCon,Fixity)
 
-type InPat p  = LPat p        -- No 'Out' constructors
-type OutPat p = LPat p        -- No 'In' constructors
-
 type LPat p = XRec p Pat
 
 -- | Pattern
@@ -173,30 +174,12 @@ data Pat p
     -- For details on above see note [Api annotations] in GHC.Parser.Annotation
 
         ------------ Constructor patterns ---------------
-  | ConPatIn    (Located (IdP p))
-                (HsConPatDetails p)
-    -- ^ Constructor Pattern In
-
-  | ConPatOut {
-        pat_con     :: Located ConLike,
-        pat_arg_tys :: [Type],          -- The universal arg types, 1-1 with the universal
-                                        -- tyvars of the constructor/pattern synonym
-                                        --   Use (conLikeResTy pat_con pat_arg_tys) to get
-                                        --   the type of the pattern
-
-        pat_tvs   :: [TyVar],           -- Existentially bound type variables
-                                        -- in correctly-scoped order e.g. [k:*, x:k]
-        pat_dicts :: [EvVar],           -- Ditto *coercion variables* and *dictionaries*
-                                        -- One reason for putting coercion variable here, I think,
-                                        --      is to ensure their kinds are zonked
-
-        pat_binds :: TcEvBinds,         -- Bindings involving those dictionaries
-        pat_args  :: HsConPatDetails p,
-        pat_wrap  :: HsWrapper          -- Extra wrapper to pass to the matcher
-                                        -- Only relevant for pattern-synonyms;
-                                        --   ignored for data cons
+  | ConPat {
+        pat_con_ext :: XConPat p,
+        pat_con     :: Located (ConLikeP p),
+        pat_args    :: HsConPatDetails p
     }
-    -- ^ Constructor Pattern Out
+    -- ^ Constructor Pattern
 
         ------------ View patterns ---------------
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
@@ -262,17 +245,6 @@ data Pat p
 
     -- ^ Pattern with a type signature
 
-        ------------ Pattern coercions (translation only) ---------------
-  | 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
-                Type                -- Type of whole pattern, t1
-        -- 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)
@@ -306,6 +278,10 @@ type instance XTuplePat GhcPs = NoExtField
 type instance XTuplePat GhcRn = NoExtField
 type instance XTuplePat GhcTc = [Type]
 
+type instance XConPat GhcPs = NoExtField
+type instance XConPat GhcRn = NoExtField
+type instance XConPat GhcTc = ConPatTc
+
 type instance XSumPat GhcPs = NoExtField
 type instance XSumPat GhcRn = NoExtField
 type instance XSumPat GhcTc = [Type]
@@ -329,9 +305,16 @@ type instance XSigPat GhcPs = NoExtField
 type instance XSigPat GhcRn = NoExtField
 type instance XSigPat GhcTc = Type
 
-type instance XCoPat  (GhcPass _) = NoExtField
+type instance XXPat GhcPs = NoExtCon
+type instance XXPat GhcRn = NoExtCon
+type instance XXPat GhcTc = CoPat
+  -- After typechecking, we add one extra constructor: CoPat
 
-type instance XXPat   (GhcPass _) = NoExtCon
+type family ConLikeP x
+
+type instance ConLikeP GhcPs = RdrName -- IdP GhcPs
+type instance ConLikeP GhcRn = Name -- IdP GhcRn
+type instance ConLikeP GhcTc = ConLike
 
 -- ---------------------------------------------------------------------
 
@@ -344,6 +327,52 @@ hsConPatArgs (PrefixCon ps)   = ps
 hsConPatArgs (RecCon fs)      = map (hsRecFieldArg . unLoc) (rec_flds fs)
 hsConPatArgs (InfixCon p1 p2) = [p1,p2]
 
+-- | This is the extension field for ConPat, added after typechecking
+-- It adds quite a few extra fields, to support elaboration of pattern matching.
+data ConPatTc
+  = ConPatTc
+    { -- | The universal arg types  1-1 with the universal
+      -- tyvars of the constructor/pattern synonym
+      -- Use (conLikeResTy pat_con cpt_arg_tys) to get
+      -- the type of the pattern
+      cpt_arg_tys :: [Type]
+
+    , -- | Existentially bound type variables
+      -- in correctly-scoped order e.g. [k:*  x:k]
+      cpt_tvs   :: [TyVar]
+
+    , -- | Ditto *coercion variables* and *dictionaries*
+      -- One reason for putting coercion variable here  I think
+      --      is to ensure their kinds are zonked
+      cpt_dicts :: [EvVar]
+
+    , -- | Bindings involving those dictionaries
+      cpt_binds :: TcEvBinds
+
+    , -- ^ Extra wrapper to pass to the matcher
+      -- Only relevant for pattern-synonyms;
+      --   ignored for data cons
+      cpt_wrap  :: HsWrapper
+    }
+
+-- | Coercion Pattern (translation only)
+--
+-- During desugaring a (CoPat co pat) turns into a cast with 'co' on the
+-- scrutinee, followed by a match on 'pat'.
+data CoPat
+  = CoPat
+    { -- | Coercion Pattern
+      -- If co :: t1 ~ t2, p :: t2,
+      -- then (CoPat co p) :: t1
+      co_cpt_wrap :: HsWrapper
+
+    , -- | Why not LPat?  Ans: existing locn will do
+      co_pat_inner :: Pat GhcTc
+
+    , -- | Type of whole pattern, t1
+      co_pat_ty :: Type
+    }
+
 -- | Haskell Record Fields
 --
 -- HsRecFields is used only for patterns and expressions (not data type
@@ -498,16 +527,23 @@ pprParendLPat :: (OutputableBndrId p)
               => PprPrec -> LPat (GhcPass p) -> SDoc
 pprParendLPat p = pprParendPat p . unLoc
 
-pprParendPat :: (OutputableBndrId p)
-             => PprPrec -> Pat (GhcPass p) -> SDoc
-pprParendPat p pat = sdocOption sdocPrintTypecheckerElaboration $ \print_tc_elab ->
-                     if need_parens print_tc_elab pat
-                     then parens (pprPat pat)
-                     else  pprPat pat
+pprParendPat :: forall p. OutputableBndrId p
+             => PprPrec
+             -> Pat (GhcPass p)
+             -> SDoc
+pprParendPat p pat = sdocOption sdocPrintTypecheckerElaboration $ \ print_tc_elab ->
+    if need_parens print_tc_elab pat
+    then parens (pprPat pat)
+    else pprPat pat
   where
     need_parens print_tc_elab pat
-      | CoPat {} <- pat = print_tc_elab
-      | otherwise       = patNeedsParens p pat
+      | GhcTc <- ghcPass @p
+      , XPat ext <- pat
+      , CoPat {} <- ext
+      = print_tc_elab
+
+      | otherwise
+      = patNeedsParens p pat
       -- For a CoPat we need parens if we are going to show it, which
       -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)
       -- But otherwise the CoPat is discarded, so it
@@ -527,12 +563,6 @@ 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 _)       = pprIfTc @p $
-                                  sdocWithDynFlags $ \ dflags ->
-                                  if gopt Opt_PrintTypecheckerElaboration dflags
-                                  then hang (text "CoPat" <+> parens (ppr co))
-                                          2 (pprParendPat appPrec pat)
-                                  else pprPat pat
 pprPat (SigPat _ pat ty)        = ppr pat <+> dcolon <+> ppr_ty
   where ppr_ty = case ghcPass @p of
                    GhcPs -> ppr ty
@@ -548,22 +578,37 @@ pprPat (TuplePat _ pats bx)
   | otherwise
   = 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 })
-  = sdocOption sdocPrintTypecheckerElaboration $ \case
-      False -> pprUserCon (unLoc con) details
-      True  -> -- Tiresome; in GHC.Tc.Gen.Bind.tcRhs we print out a
-               -- typechecked Pat in an error message,
-               -- and we want to make sure it prints nicely
-               ppr con
-                  <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
-                                 , pprIfTc @p $ ppr binds ])
-                  <+> pprConArgs details
-
+pprPat (ConPat { pat_con = con
+               , pat_args = details
+               , pat_con_ext = ext
+               }
+       )
+  = case ghcPass @p of
+      GhcPs -> pprUserCon (unLoc con) details
+      GhcRn -> pprUserCon (unLoc con) details
+      GhcTc -> sdocOption sdocPrintTypecheckerElaboration $ \case
+        False -> pprUserCon (unLoc con) details
+        True  ->
+          -- Tiresome; in TcBinds.tcRhs we print out a typechecked Pat in an
+          -- error message, and we want to make sure it prints nicely
+          ppr con
+            <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
+                           , ppr binds ])
+            <+> pprConArgs details
+        where ConPatTc { cpt_tvs = tvs
+                       , cpt_dicts = dicts
+                       , cpt_binds = binds
+                       } = ext
+pprPat (XPat ext) = case ghcPass @p of
+#if __GLASGOW_HASKELL__ < 811
+  GhcPs -> noExtCon ext
+  GhcRn -> noExtCon ext
+#endif
+  GhcTc -> pprHsWrapper co $ \parens ->
+      if parens
+      then pprParendPat appPrec pat
+      else pprPat pat
+    where CoPat co pat _ = ext
 
 pprUserCon :: (OutputableBndr con, OutputableBndrId p)
            => con -> HsConPatDetails (GhcPass p) -> SDoc
@@ -602,21 +647,24 @@ instance (Outputable p, Outputable arg)
 -}
 
 mkPrefixConPat :: DataCon ->
-                  [OutPat (GhcPass p)] -> [Type] -> OutPat (GhcPass p)
+                  [LPat GhcTc] -> [Type] -> LPat GhcTc
 -- Make a vanilla Prefix constructor pattern
 mkPrefixConPat dc pats tys
-  = noLoc $ ConPatOut { pat_con = noLoc (RealDataCon dc)
-                      , pat_tvs = []
-                      , pat_dicts = []
-                      , pat_binds = emptyTcEvBinds
-                      , pat_args = PrefixCon pats
-                      , pat_arg_tys = tys
-                      , pat_wrap = idHsWrapper }
-
-mkNilPat :: Type -> OutPat (GhcPass p)
+  = noLoc $ ConPat { pat_con = noLoc (RealDataCon dc)
+                   , pat_args = PrefixCon pats
+                   , pat_con_ext = ConPatTc
+                     { cpt_tvs = []
+                     , cpt_dicts = []
+                     , cpt_binds = emptyTcEvBinds
+                     , cpt_arg_tys = tys
+                     , cpt_wrap = idHsWrapper
+                     }
+                   }
+
+mkNilPat :: Type -> LPat GhcTc
 mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
 
-mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
+mkCharLitPat :: SourceText -> Char -> LPat GhcTc
 mkCharLitPat src c = mkPrefixConPat charDataCon
                           [noLoc $ LitPat noExtField (HsCharPrim src c)] []
 
@@ -684,7 +732,7 @@ looksLazyPat (VarPat {})   = False
 looksLazyPat (WildPat {})  = False
 looksLazyPat _             = True
 
-isIrrefutableHsPat :: (OutputableBndrId p) => LPat (GhcPass p) -> Bool
+isIrrefutableHsPat :: forall p. (OutputableBndrId p) => LPat (GhcPass p) -> Bool
 -- (isIrrefutableHsPat p) is true if matching against p cannot fail,
 -- in the sense of falling through to the next pattern.
 --      (NB: this is not quite the same as the (silly) defn
@@ -700,13 +748,14 @@ isIrrefutableHsPat :: (OutputableBndrId p) => LPat (GhcPass p) -> Bool
 isIrrefutableHsPat
   = goL
   where
+    goL :: LPat (GhcPass p) -> Bool
     goL = go . unLoc
 
+    go :: Pat (GhcPass p) -> Bool
     go (WildPat {})        = True
     go (VarPat {})         = True
     go (LazyPat {})        = True
     go (BangPat _ pat)     = goL pat
-    go (CoPat _ _ pat _)   = go  pat
     go (ParPat _ pat)      = goL pat
     go (AsPat _ _ pat)     = goL pat
     go (ViewPat _ _ pat)   = goL pat
@@ -716,18 +765,19 @@ isIrrefutableHsPat
                     -- See Note [Unboxed sum patterns aren't irrefutable]
     go (ListPat {})        = False
 
-    go (ConPatIn {})       = False     -- Conservative
-    go (ConPatOut
-        { pat_con  = L _ (RealDataCon con)
+    go (ConPat
+        { pat_con  = con
         , pat_args = details })
-                           =
-      isJust (tyConSingleDataCon_maybe (dataConTyCon con))
-      -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
-      -- the latter is false of existentials. See #4439
-      && all goL (hsConPatArgs details)
-    go (ConPatOut
-        { pat_con = L _ (PatSynCon _pat) })
-                           = False -- Conservative
+                           = case ghcPass @p of
+       GhcPs -> False -- Conservative
+       GhcRn -> False -- Conservative
+       GhcTc -> case con of
+         L _ (PatSynCon _pat)  -> False -- Conservative
+         L _ (RealDataCon con) ->
+           isJust (tyConSingleDataCon_maybe (dataConTyCon con))
+           -- NB: tyConSingleDataCon_maybe, *not* isProductTyCon, because
+           -- the latter is false of existentials. See #4439
+           && all goL (hsConPatArgs details)
     go (LitPat {})         = False
     go (NPat {})           = False
     go (NPlusKPat {})      = False
@@ -736,6 +786,14 @@ isIrrefutableHsPat
     -- since we cannot know until the splice is evaluated.
     go (SplicePat {})      = False
 
+    go (XPat ext)          = case ghcPass @p of
+#if __GLASGOW_HASKELL__ < 811
+      GhcPs -> noExtCon ext
+      GhcRn -> noExtCon ext
+#endif
+      GhcTc -> go pat
+        where CoPat _ pat _ = ext
+
 -- | Is the pattern any of combination of:
 --
 -- - (pat)
@@ -777,16 +835,21 @@ is the only thing that could possibly be matched!
 
 -- | @'patNeedsParens' p pat@ returns 'True' if the pattern @pat@ needs
 -- parentheses under precedence @p@.
-patNeedsParens :: PprPrec -> Pat p -> Bool
+patNeedsParens :: forall p. IsPass p => PprPrec -> Pat (GhcPass p) -> Bool
 patNeedsParens p = go
   where
+    go :: Pat (GhcPass p) -> Bool
     go (NPlusKPat {})    = p > opPrec
     go (SplicePat {})    = False
-    go (ConPatIn _ ds)   = conPatNeedsParens p ds
-    go cp@(ConPatOut {}) = conPatNeedsParens p (pat_args cp)
+    go (ConPat { pat_args = ds})
+                         = conPatNeedsParens p ds
     go (SigPat {})       = p >= sigPrec
     go (ViewPat {})      = True
-    go (CoPat _ _ p _)   = go p
+    go (XPat ext)        = case ghcPass @p of
+      GhcPs -> noExtCon ext
+      GhcRn -> noExtCon ext
+      GhcTc -> go inner
+        where CoPat _ inner _ = ext
     go (WildPat {})      = False
     go (VarPat {})       = False
     go (LazyPat {})      = False
@@ -798,7 +861,6 @@ patNeedsParens p = go
     go (ListPat {})      = False
     go (LitPat _ l)      = hsLitNeedsParens p l
     go (NPat _ lol _ _)  = hsOverLitNeedsParens p (unLoc lol)
-    go (XPat {})         = True -- conservative default
 
 -- | @'conPatNeedsParens' p cp@ returns 'True' if the constructor patterns @cp@
 -- needs parentheses under precedence @p@.
@@ -811,7 +873,10 @@ conPatNeedsParens p = go
 
 -- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
 -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
-parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
+parenthesizePat :: IsPass p
+                => PprPrec
+                -> LPat (GhcPass p)
+                -> LPat (GhcPass p)
 parenthesizePat p lpat@(L loc pat)
   | patNeedsParens p pat = L loc (ParPat noExtField lpat)
   | otherwise            = lpat
@@ -837,12 +902,16 @@ collectEvVarsPat pat =
     ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
     SumPat _ p _ _   -> collectEvVarsLPat p
-    ConPatOut {pat_dicts = dicts, pat_args  = args}
+    ConPat
+      { pat_args  = args
+      , pat_con_ext = ConPatTc
+        { cpt_dicts = dicts
+        }
+      }
                      -> unionBags (listToBag dicts)
                                    $ unionManyBags
                                    $ map collectEvVarsLPat
                                    $ hsConPatArgs args
     SigPat  _ p _    -> collectEvVarsLPat p
-    CoPat _ _ p _    -> collectEvVarsPat  p
-    ConPatIn _  _    -> panic "foldMapPatBag: ConPatIn"
+    XPat (CoPat _ p _) -> collectEvVarsPat  p
     _other_pat       -> emptyBag
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 0b3300719e..75ef5b06bf 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -24,6 +24,9 @@ just attach noSrcSpan to everything.
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -89,6 +92,7 @@ module GHC.Hs.Utils(
   collectPatBinders, collectPatsBinders,
   collectLStmtsBinders, collectStmtsBinders,
   collectLStmtBinders, collectStmtBinders,
+  CollectPass(..),
 
   hsLTyClDeclBinders, hsTyClForeignBinders,
   hsPatSynSelectors, getPatSynBinds,
@@ -135,6 +139,7 @@ import GHC.Settings.Constants
 import Data.Either
 import Data.Function
 import Data.List
+import Data.Proxy
 
 {-
 ************************************************************************
@@ -196,8 +201,11 @@ mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct)
 mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
 mkHsAppTypes = foldl' mkHsAppType
 
-mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
-  [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
+mkHsLam :: IsPass p
+        => (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField)
+        => [LPat (GhcPass p)]
+        -> LHsExpr (GhcPass p)
+        -> LHsExpr (GhcPass p)
 mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches))
   where
     matches = mkMatchGroup Generated
@@ -230,7 +238,7 @@ mkLHsPar le@(L loc e)
   | hsExprNeedsParens appPrec e = L loc (HsPar noExtField le)
   | otherwise                   = le
 
-mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
+mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
 mkParPat lp@(L loc p)
   | patNeedsParens appPrec p = L loc (ParPat noExtField lp)
   | otherwise                = lp
@@ -435,25 +443,42 @@ nlConVarPatName :: Name -> [Name] -> LPat GhcRn
 nlConVarPatName con vars = nlConPatName con (map nlVarPat vars)
 
 nlInfixConPat :: RdrName -> LPat GhcPs -> LPat GhcPs -> LPat GhcPs
-nlInfixConPat con l r = noLoc (ConPatIn (noLoc con)
-                              (InfixCon (parenthesizePat opPrec l)
-                                        (parenthesizePat opPrec r)))
+nlInfixConPat con l r = noLoc $ ConPat
+  { pat_con = noLoc con
+  , pat_args = InfixCon (parenthesizePat opPrec l)
+                        (parenthesizePat opPrec r)
+  , pat_con_ext = noExtField
+  }
 
 nlConPat :: RdrName -> [LPat GhcPs] -> LPat GhcPs
-nlConPat con pats =
-  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))
+nlConPat con pats = noLoc $ ConPat
+  { pat_con_ext = noExtField
+  , pat_con = noLoc con
+  , pat_args = PrefixCon (map (parenthesizePat appPrec) pats)
+  }
 
 nlConPatName :: Name -> [LPat GhcRn] -> LPat GhcRn
-nlConPatName con pats =
-  noLoc (ConPatIn (noLoc con) (PrefixCon (map (parenthesizePat appPrec) pats)))
-
-nlNullaryConPat :: IdP (GhcPass p) -> LPat (GhcPass p)
-nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
+nlConPatName con pats = noLoc $ ConPat
+  { pat_con_ext = noExtField
+  , pat_con = noLoc con
+  , pat_args = PrefixCon (map (parenthesizePat appPrec) pats)
+  }
+
+nlNullaryConPat :: RdrName -> LPat GhcPs
+nlNullaryConPat con = noLoc $ ConPat
+  { pat_con_ext = noExtField
+  , pat_con = noLoc con
+  , pat_args = PrefixCon []
+  }
 
 nlWildConPat :: DataCon -> LPat GhcPs
-nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
-                         (PrefixCon (replicate (dataConSourceArity con)
-                                             nlWildPat)))
+nlWildConPat con = noLoc $ ConPat
+  { pat_con_ext = noExtField
+  , pat_con = noLoc $ getRdrName con
+  , pat_args = PrefixCon $
+     replicate (dataConSourceArity con)
+               nlWildPat
+  }
 
 -- | Wildcard pattern - after parsing
 nlWildPat :: LPat GhcPs
@@ -800,11 +825,11 @@ mkLHsCmdWrap w (L loc c) = L loc (mkHsCmdWrap w c)
 
 mkHsWrapPat :: HsWrapper -> Pat GhcTc -> Type -> Pat GhcTc
 mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
-                       | otherwise           = CoPat noExtField co_fn p ty
+                       | otherwise           = XPat $ CoPat co_fn p ty
 
 mkHsWrapPatCo :: TcCoercionN -> Pat GhcTc -> Type -> Pat GhcTc
 mkHsWrapPatCo co pat ty | isTcReflCo co = pat
-                        | otherwise    = CoPat noExtField (mkWpCastN co) pat ty
+                        | otherwise     = XPat $ CoPat (mkWpCastN co) pat ty
 
 mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
 mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
@@ -879,8 +904,10 @@ mkPrefixFunRhs n = FunRhs { mc_fun = n
                           , mc_strictness = NoSrcStrict }
 
 ------------
-mkMatch :: HsMatchContext (NoGhcTc (GhcPass p))
-        -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p)
+mkMatch :: forall p. IsPass p
+        => HsMatchContext (NoGhcTc (GhcPass p))
+        -> [LPat (GhcPass p)]
+        -> LHsExpr (GhcPass p)
         -> Located (HsLocalBinds (GhcPass p))
         -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
 mkMatch ctxt pats expr lbinds
@@ -889,6 +916,7 @@ mkMatch ctxt pats expr lbinds
                  , m_pats  = map paren pats
                  , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })
   where
+    paren :: Located (Pat (GhcPass p)) -> Located (Pat (GhcPass p))
     paren lp@(L l p)
       | patNeedsParens appPrec p = L l (ParPat noExtField lp)
       | otherwise                = lp
@@ -978,49 +1006,69 @@ isBangedHsBind (PatBind {pat_lhs = pat})
 isBangedHsBind _
   = False
 
-collectLocalBinders :: HsLocalBindsLR (GhcPass idL) (GhcPass idR)
+collectLocalBinders :: CollectPass (GhcPass idL)
+                    => HsLocalBindsLR (GhcPass idL) (GhcPass idR)
                     -> [IdP (GhcPass idL)]
 collectLocalBinders (HsValBinds _ binds) = collectHsIdBinders binds
                                          -- No pattern synonyms here
 collectLocalBinders (HsIPBinds {})      = []
 collectLocalBinders (EmptyLocalBinds _) = []
 
-collectHsIdBinders, collectHsValBinders
-  :: HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
+collectHsIdBinders :: CollectPass (GhcPass idL)
+                   => HsValBindsLR (GhcPass idL) (GhcPass idR)
+                   -> [IdP (GhcPass idL)]
 -- ^ Collect 'Id' binders only, or 'Id's + pattern synonyms, respectively
 collectHsIdBinders  = collect_hs_val_binders True
+
+collectHsValBinders :: CollectPass (GhcPass idL)
+                    => HsValBindsLR (GhcPass idL) (GhcPass idR)
+                    -> [IdP (GhcPass idL)]
 collectHsValBinders = collect_hs_val_binders False
 
-collectHsBindBinders :: XRec pass Pat ~ Located (Pat pass) =>
-                        HsBindLR pass idR -> [IdP pass]
+collectHsBindBinders :: CollectPass p
+                     => HsBindLR p idR
+                     -> [IdP p]
 -- ^ Collect both 'Id's and pattern-synonym binders
 collectHsBindBinders b = collect_bind False b []
 
-collectHsBindsBinders :: LHsBindsLR (GhcPass p) idR -> [IdP (GhcPass p)]
+collectHsBindsBinders :: CollectPass p
+                      => LHsBindsLR p idR
+                      -> [IdP p]
 collectHsBindsBinders binds = collect_binds False binds []
 
-collectHsBindListBinders :: [LHsBindLR (GhcPass p) idR] -> [IdP (GhcPass p)]
+collectHsBindListBinders :: CollectPass p
+                         => [LHsBindLR p idR]
+                         -> [IdP p]
 -- ^ Same as 'collectHsBindsBinders', but works over a list of bindings
 collectHsBindListBinders = foldr (collect_bind False . unLoc) []
 
-collect_hs_val_binders :: Bool -> HsValBindsLR (GhcPass idL) (GhcPass idR)
+collect_hs_val_binders :: CollectPass (GhcPass idL)
+                       => Bool
+                       -> HsValBindsLR (GhcPass idL) (GhcPass idR)
                        -> [IdP (GhcPass idL)]
 collect_hs_val_binders ps (ValBinds _ binds _) = collect_binds ps binds []
 collect_hs_val_binders ps (XValBindsLR (NValBinds binds _))
   = collect_out_binds ps binds
 
-collect_out_binds :: Bool -> [(RecFlag, LHsBinds (GhcPass p))] ->
-                     [IdP (GhcPass p)]
+collect_out_binds :: CollectPass p
+                  => Bool
+                  -> [(RecFlag, LHsBinds p)]
+                  -> [IdP p]
 collect_out_binds ps = foldr (collect_binds ps . snd) []
 
-collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
-                 [IdP (GhcPass p)] -> [IdP (GhcPass p)]
+collect_binds :: CollectPass p
+              => Bool
+              -> LHsBindsLR p idR
+              -> [IdP p]
+              -> [IdP p]
 -- ^ Collect 'Id's, or 'Id's + pattern synonyms, depending on boolean flag
 collect_binds ps binds acc = foldr (collect_bind ps . unLoc) acc binds
 
-collect_bind :: XRec pass Pat ~ Located (Pat pass) =>
-                Bool -> HsBindLR pass idR ->
-                [IdP pass] -> [IdP pass]
+collect_bind :: CollectPass p
+             => Bool
+             -> HsBindLR p idR
+             -> [IdP p]
+             -> [IdP p]
 collect_bind _ (PatBind { pat_lhs = p })           acc = collect_lpat p acc
 collect_bind _ (FunBind { fun_id = L _ f })        acc = f : acc
 collect_bind _ (VarBind { var_id = f })            acc = f : acc
@@ -1044,19 +1092,23 @@ collectMethodBinders binds = foldr (get . unLoc) [] binds
        -- Someone else complains about non-FunBinds
 
 ----------------- Statements --------------------------
-collectLStmtsBinders :: [LStmtLR (GhcPass idL) (GhcPass idR) body]
+collectLStmtsBinders :: (CollectPass (GhcPass idL))
+                     => [LStmtLR (GhcPass idL) (GhcPass idR) body]
                      -> [IdP (GhcPass idL)]
 collectLStmtsBinders = concatMap collectLStmtBinders
 
-collectStmtsBinders :: [StmtLR (GhcPass idL) (GhcPass idR) body]
+collectStmtsBinders :: (CollectPass (GhcPass idL))
+                    => [StmtLR (GhcPass idL) (GhcPass idR) body]
                     -> [IdP (GhcPass idL)]
 collectStmtsBinders = concatMap collectStmtBinders
 
-collectLStmtBinders :: LStmtLR (GhcPass idL) (GhcPass idR) body
+collectLStmtBinders :: (CollectPass (GhcPass idL))
+                    => LStmtLR (GhcPass idL) (GhcPass idR) body
                     -> [IdP (GhcPass idL)]
 collectLStmtBinders = collectStmtBinders . unLoc
 
-collectStmtBinders :: StmtLR (GhcPass idL) (GhcPass idR) body
+collectStmtBinders :: (CollectPass (GhcPass idL))
+                   => StmtLR (GhcPass idL) (GhcPass idR) body
                    -> [IdP (GhcPass idL)]
   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 collectStmtBinders (BindStmt _ pat _)      = collectPatBinders pat
@@ -1071,47 +1123,65 @@ collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
  where
   collectArgBinders (_, ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders pat
   collectArgBinders (_, ApplicativeArgMany { bv_pattern = pat }) = collectPatBinders pat
+  collectArgBinders (_, XApplicativeArg {}) = []
 
 
 ----------------- Patterns --------------------------
-collectPatBinders :: LPat (GhcPass p) -> [IdP (GhcPass p)]
+collectPatBinders :: CollectPass p => LPat p -> [IdP p]
 collectPatBinders pat = collect_lpat pat []
 
-collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
+collectPatsBinders :: CollectPass p => [LPat p] -> [IdP p]
 collectPatsBinders pats = foldr collect_lpat [] pats
 
 -------------
-collect_lpat :: XRec pass Pat ~ Located (Pat pass) =>
-                LPat pass -> [IdP pass] -> [IdP pass]
-collect_lpat p bndrs
-  = go (unLoc p)
-  where
-    go (VarPat _ var)             = unLoc var : bndrs
-    go (WildPat _)                = bndrs
-    go (LazyPat _ pat)            = collect_lpat pat bndrs
-    go (BangPat _ pat)            = collect_lpat pat bndrs
-    go (AsPat _ a pat)            = unLoc a : collect_lpat pat bndrs
-    go (ViewPat _ _ pat)          = collect_lpat pat bndrs
-    go (ParPat _ pat)             = collect_lpat pat bndrs
-
-    go (ListPat _ pats)           = foldr collect_lpat bndrs pats
-    go (TuplePat _ pats _)        = foldr collect_lpat bndrs pats
-    go (SumPat _ pat _ _)         = collect_lpat pat bndrs
-
-    go (ConPatIn _ ps)            = foldr collect_lpat bndrs (hsConPatArgs ps)
-    go (ConPatOut {pat_args=ps})  = foldr collect_lpat bndrs (hsConPatArgs ps)
-        -- See Note [Dictionary binders in ConPatOut]
-    go (LitPat _ _)               = bndrs
-    go (NPat {})                  = bndrs
-    go (NPlusKPat _ n _ _ _ _)    = unLoc n : bndrs
-
-    go (SigPat _ pat _)           = collect_lpat pat bndrs
-
-    go (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
-                                  = go pat
-    go (SplicePat _ _)            = bndrs
-    go (CoPat _ _ pat _)          = go pat
-    go (XPat {})                  = bndrs
+collect_lpat :: forall pass. (CollectPass pass)
+             => LPat pass -> [IdP pass] -> [IdP pass]
+collect_lpat p bndrs = collect_pat (unLoc p) bndrs
+
+collect_pat :: forall p. CollectPass p
+            => Pat p
+            -> [IdP p]
+            -> [IdP p]
+collect_pat pat bndrs = case pat of
+  (VarPat _ var)          -> unLoc var : bndrs
+  (WildPat _)             -> bndrs
+  (LazyPat _ pat)         -> collect_lpat pat bndrs
+  (BangPat _ pat)         -> collect_lpat pat bndrs
+  (AsPat _ a pat)         -> unLoc a : collect_lpat pat bndrs
+  (ViewPat _ _ pat)       -> collect_lpat pat bndrs
+  (ParPat _ pat)          -> collect_lpat pat bndrs
+  (ListPat _ pats)        -> foldr collect_lpat bndrs pats
+  (TuplePat _ pats _)     -> foldr collect_lpat bndrs pats
+  (SumPat _ pat _ _)      -> collect_lpat pat bndrs
+  (ConPat {pat_args=ps})  -> foldr collect_lpat bndrs (hsConPatArgs ps)
+  -- See Note [Dictionary binders in ConPatOut]
+  (LitPat _ _)            -> bndrs
+  (NPat {})               -> bndrs
+  (NPlusKPat _ n _ _ _ _) -> unLoc n : bndrs
+  (SigPat _ pat _)        -> collect_lpat pat bndrs
+  (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
+                          -> collect_pat pat bndrs
+  (SplicePat _ _)         -> bndrs
+  (XPat ext)              -> collectXXPat (Proxy @p) ext bndrs
+
+-- | This class specifies how to collect variable identifiers from extension patterns in the given pass.
+-- Consumers of the GHC API that define their own passes should feel free to implement instances in order
+-- to make use of functions which depend on it.
+--
+-- In particular, Haddock already makes use of this, with an instance for its 'DocNameI' pass so that
+-- it can reuse the code in GHC for collecting binders.
+class (XRec p Pat ~ Located (Pat p)) => CollectPass p where
+  collectXXPat :: Proxy p -> XXPat p -> [IdP p] -> [IdP p]
+
+instance CollectPass (GhcPass 'Parsed) where
+  collectXXPat _ ext = noExtCon ext
+
+instance CollectPass (GhcPass 'Renamed) where
+  collectXXPat _ ext = noExtCon ext
+
+instance CollectPass (GhcPass 'Typechecked) where
+  collectXXPat _ (CoPat _ pat _) = collect_pat pat
+
 
 {-
 Note [Dictionary binders in ConPatOut] See also same Note in GHC.HsToCore.Arrows
@@ -1393,10 +1463,8 @@ lPatImplicits = hs_lpat
     hs_pat (TuplePat _ pats _)  = hs_lpats pats
 
     hs_pat (SigPat _ pat _)     = hs_lpat pat
-    hs_pat (CoPat _ _ pat _)    = hs_pat pat
 
-    hs_pat (ConPatIn n ps)           = details n ps
-    hs_pat (ConPatOut {pat_con=con, pat_args=ps}) = details (fmap conLikeName con) ps
+    hs_pat (ConPat {pat_con=con, pat_args=ps}) = details con ps
 
     hs_pat _ = []
 
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 3139610902..e3ac5a046b 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -1191,7 +1191,7 @@ Note [Dictionary binders in ConPatOut] See also same Note in GHC.Hs.Utils
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The following functions to collect value variables from patterns are
 copied from GHC.Hs.Utils, with one change: we also collect the dictionary
-bindings (pat_binds) from ConPatOut.  We need them for cases like
+bindings (cpt_binds) from ConPatOut.  We need them for cases like
 
 h :: Arrow a => Int -> a (Int,Int) Int
 h x = proc (y,z) -> case compare x y of
@@ -1231,8 +1231,8 @@ collectl (L _ pat) bndrs
     go (TuplePat _ pats _)        = foldr collectl bndrs pats
     go (SumPat _ pat _ _)         = collectl pat bndrs
 
-    go (ConPatIn _ ps)            = foldr collectl bndrs (hsConPatArgs ps)
-    go (ConPatOut {pat_args=ps, pat_binds=ds}) =
+    go (ConPat { pat_args = ps
+               , pat_con_ext = ConPatTc { cpt_binds = ds }}) =
                                     collectEvBinders ds
                                     ++ foldr collectl bndrs (hsConPatArgs ps)
     go (LitPat _ _)               = bndrs
@@ -1240,7 +1240,7 @@ collectl (L _ pat) bndrs
     go (NPlusKPat _ (L _ n) _ _ _ _) = n : bndrs
 
     go (SigPat _ pat _)           = collectl pat bndrs
-    go (CoPat _ _ pat _)          = collectl (noLoc pat) bndrs
+    go (XPat (CoPat _ pat _))     = collectl (noLoc pat) bndrs
     go (ViewPat _ _ pat)          = collectl pat bndrs
     go p@(SplicePat {})           = pprPanic "collectl/go" (ppr p)
 
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 48a8ef6f20..30cf626d6d 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -117,7 +117,9 @@ user-written. This lets us relate Names (from ClsInsts) to comments
 (associated with InstDecls and DerivDecls).
 -}
 
-getMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]
+getMainDeclBinder :: (CollectPass (GhcPass p))
+                  => HsDecl (GhcPass p)
+                  -> [IdP (GhcPass p)]
 getMainDeclBinder (TyClD _ d) = [tcdName d]
 getMainDeclBinder (ValD _ d) =
   case collectHsBindBinders d of
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 5bd2326e62..8e4313f80d 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -697,13 +697,16 @@ dsExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
 
                  req_wrap = dict_req_wrap <.> mkWpTyApps in_inst_tys
 
-                 pat = noLoc $ ConPatOut { pat_con = noLoc con
-                                         , pat_tvs = ex_tvs
-                                         , pat_dicts = eqs_vars ++ theta_vars
-                                         , pat_binds = emptyTcEvBinds
-                                         , pat_args = PrefixCon $ map nlVarPat arg_ids
-                                         , pat_arg_tys = in_inst_tys
-                                         , pat_wrap = req_wrap }
+                 pat = noLoc $ ConPat { pat_con = noLoc con
+                                      , pat_args = PrefixCon $ map nlVarPat arg_ids
+                                      , pat_con_ext = ConPatTc
+                                        { cpt_tvs = ex_tvs
+                                        , cpt_dicts = eqs_vars ++ theta_vars
+                                        , cpt_binds = emptyTcEvBinds
+                                        , cpt_arg_tys = in_inst_tys
+                                        , cpt_wrap = req_wrap
+                                        }
+                                      }
            ; return (mkSimpleMatch RecUpd [pat] wrapped_rhs) }
 
 {- Note [Scrutinee in Record updates]
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 368576cf30..9db596fb52 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -266,7 +266,7 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
 deListComp (ApplicativeStmt {} : _) _ =
   panic "deListComp ApplicativeStmt"
 
-deBindComp :: OutPat GhcTc
+deBindComp :: LPat GhcTc
            -> CoreExpr
            -> [ExprStmt GhcTc]
            -> CoreExpr
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 2e62fa9856..b9e053c005 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -268,7 +268,7 @@ matchBangs (var :| vars) ty eqns
 matchCoercion :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
 -- Apply the coercion to the match variable and then match that
 matchCoercion (var :| vars) ty (eqns@(eqn1 :| _))
-  = do  { let CoPat _ co pat _ = firstPat eqn1
+  = do  { let XPat (CoPat co pat _) = firstPat eqn1
         ; let pat_ty' = hsPatType pat
         ; var' <- newUniqueId var pat_ty'
         ; match_result <- match (var':vars) ty $ NEL.toList $
@@ -314,7 +314,7 @@ decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats }))
 decomposeFirstPat _ _ = panic "decomposeFirstPat"
 
 getCoPat, getBangPat, getViewPat, getOLPat :: Pat GhcTc -> Pat GhcTc
-getCoPat (CoPat _ _ pat _)   = pat
+getCoPat (XPat (CoPat _ pat _)) = pat
 getCoPat _                   = panic "getCoPat"
 getBangPat (BangPat _ pat  ) = unLoc pat
 getBangPat _                 = panic "getBangPat"
@@ -513,8 +513,8 @@ tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p
 -- it may disappear next time
 tidy_bang_pat v o l (AsPat x v' p)
   = tidy1 v o (AsPat x v' (L l (BangPat noExtField p)))
-tidy_bang_pat v o l (CoPat x w p t)
-  = tidy1 v o (CoPat x w (BangPat noExtField (L l p)) t)
+tidy_bang_pat v o l (XPat (CoPat w p t))
+  = tidy1 v o (XPat $ CoPat w (BangPat noExtField (L l p)) t)
 
 -- Discard bang around strict pattern
 tidy_bang_pat v o _ p@(LitPat {})    = tidy1 v o p
@@ -523,9 +523,12 @@ tidy_bang_pat v o _ p@(TuplePat {})  = tidy1 v o p
 tidy_bang_pat v o _ p@(SumPat {})    = tidy1 v o p
 
 -- Data/newtype constructors
-tidy_bang_pat v o l p@(ConPatOut { pat_con = L _ (RealDataCon dc)
-                                 , pat_args = args
-                                 , pat_arg_tys = arg_tys })
+tidy_bang_pat v o l p@(ConPat { pat_con = L _ (RealDataCon dc)
+                              , pat_args = args
+                              , pat_con_ext = ConPatTc
+                                { cpt_arg_tys = arg_tys
+                                }
+                              })
   -- Newtypes: push bang inwards (#9844)
   =
     if isNewTyCon (dataConTyCon dc)
@@ -1119,8 +1122,9 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys
 
 patGroup :: Platform -> Pat GhcTc -> PatGroup
-patGroup _ (ConPatOut { pat_con = L _ con
-                      , pat_arg_tys = tys })
+patGroup _ (ConPat { pat_con = L _ con
+                   , pat_con_ext = ConPatTc { cpt_arg_tys = tys }
+                   })
  | RealDataCon dcon <- con              = PgCon dcon
  | PatSynCon psyn <- con                = PgSyn psyn tys
 patGroup _ (WildPat {})                 = PgAny
@@ -1137,7 +1141,7 @@ patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) =
   case oval of
    HsIntegral i -> PgNpK (il_value i)
    _ -> pprPanic "patGroup NPlusKPat" (ppr oval)
-patGroup _ (CoPat _ _ p _)              = PgCo  (hsPatType p)
+patGroup _ (XPat (CoPat _ p _))         = PgCo  (hsPatType p)
                                                     -- Type of innelexp pattern
 patGroup _ (ViewPat _ expr p)           = PgView expr (hsPatType (unLoc p))
 patGroup _ (ListPat (ListPatTc _ (Just _)) _) = PgOverloadedList
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index f9c3e021d4..c7022d6b1d 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -145,9 +145,16 @@ matchOneConLike vars ty (eqn1 :| eqns)   -- All eqns for a single constructor
                      ; return $ foldr1 (.) wraps <$> match_result
                      }
 
-              shift (_, eqn@(EqnInfo { eqn_pats = ConPatOut{ pat_tvs = tvs, pat_dicts = ds,
-                                                             pat_binds = bind, pat_args = args
-                                                  } : pats }))
+              shift (_, eqn@(EqnInfo
+                             { eqn_pats = ConPat
+                               { pat_args = args
+                               , pat_con_ext = ConPatTc
+                                 { cpt_tvs = tvs
+                                 , cpt_dicts = ds
+                                 , cpt_binds = bind
+                                 }
+                               } : pats
+                             }))
                 = do ds_bind <- dsTcEvBinds bind
                      return ( wrapBinds (tvs `zip` tvs1)
                             . wrapBinds (ds  `zip` dicts1)
@@ -173,10 +180,15 @@ matchOneConLike vars ty (eqn1 :| eqns)   -- All eqns for a single constructor
                               alt_wrapper = wrapper1,
                               alt_result = foldr1 combineMatchResults match_results } }
   where
-    ConPatOut { pat_con = L _ con1
-              , pat_arg_tys = arg_tys, pat_wrap = wrapper1,
-                pat_tvs = tvs1, pat_dicts = dicts1, pat_args = args1 }
-              = firstPat eqn1
+    ConPat { pat_con = L _ con1
+           , pat_args = args1
+           , pat_con_ext = ConPatTc
+             { cpt_arg_tys = arg_tys
+             , cpt_wrap = wrapper1
+             , cpt_tvs = tvs1
+             , cpt_dicts = dicts1
+             }
+           } = firstPat eqn1
     fields1 = map flSelector (conLikeFieldLabels con1)
 
     ex_tvs = conLikeExTyCoVars con1
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 7fd431c434..6c8ac7f046 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -443,7 +443,7 @@ translatePat fam_insts x pat = case pat of
   -- See Note [Translate CoPats]
   -- Generally the translation is
   -- pat |> co   ===>   let y = x |> co, pat <- y  where y is a match var of pat
-  CoPat _ wrapper p _ty
+  XPat (CoPat wrapper p _ty)
     | isIdHsWrapper wrapper                   -> translatePat fam_insts x p
     | WpCast co <-  wrapper, isReflexiveCo co -> translatePat fam_insts x p
     | otherwise -> do
@@ -498,11 +498,14 @@ translatePat fam_insts x pat = case pat of
     --
     -- See #14547, especially comment#9 and comment#10.
 
-  ConPatOut { pat_con     = L _ con
-            , pat_arg_tys = arg_tys
-            , pat_tvs     = ex_tvs
-            , pat_dicts   = dicts
-            , pat_args    = ps } -> do
+  ConPat { pat_con     = L _ con
+         , pat_args    = ps
+         , pat_con_ext = ConPatTc
+           { cpt_arg_tys = arg_tys
+           , cpt_tvs     = ex_tvs
+           , cpt_dicts   = dicts
+           }
+         } -> do
     translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps
 
   NPat ty (L _ olit) mb_neg _ -> do
@@ -544,7 +547,6 @@ translatePat fam_insts x pat = case pat of
 
   -- --------------------------------------------------------------------------
   -- Not supposed to happen
-  ConPatIn  {} -> panic "Check.translatePat: ConPatIn"
   SplicePat {} -> panic "Check.translatePat: SplicePat"
 
 -- | 'translatePat', but also select and return a new match var.
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index c96eaf4e10..b49bd9d66b 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1914,7 +1914,7 @@ repP (TuplePat _ ps boxed)
   | otherwise           = do { qs <- repLPs ps; repPunboxedTup qs }
 repP (SumPat _ p alt arity) = do { p1 <- repLP p
                                  ; repPunboxedSum p1 alt arity }
-repP (ConPatIn dc details)
+repP (ConPat NoExtField dc details)
  = do { con_str <- lookupLOcc dc
       ; case details of
          PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index d208fb73da..01f2a5c776 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -716,14 +716,14 @@ strip_bangs (L _ (ParPat _ p))  = strip_bangs p
 strip_bangs (L _ (BangPat _ p)) = strip_bangs p
 strip_bangs lp                  = lp
 
-is_flat_prod_lpat :: LPat (GhcPass p) -> Bool
+is_flat_prod_lpat :: LPat GhcTc -> Bool
 is_flat_prod_lpat = is_flat_prod_pat . unLoc
 
-is_flat_prod_pat :: Pat (GhcPass p) -> Bool
+is_flat_prod_pat :: Pat GhcTc -> Bool
 is_flat_prod_pat (ParPat _ p)          = is_flat_prod_lpat p
 is_flat_prod_pat (TuplePat _ ps Boxed) = all is_triv_lpat ps
-is_flat_prod_pat (ConPatOut { pat_con  = L _ pcon
-                            , pat_args = ps})
+is_flat_prod_pat (ConPat { pat_con  = L _ pcon
+                         , pat_args = ps})
   | RealDataCon con <- pcon
   , isProductTyCon (dataConTyCon con)
   = all is_triv_lpat (hsConPatArgs ps)
@@ -753,7 +753,7 @@ mkLHsPatTup [lpat] = lpat
 mkLHsPatTup lpats  = L (getLoc (head lpats)) $
                      mkVanillaTuplePat lpats Boxed
 
-mkVanillaTuplePat :: [OutPat GhcTc] -> Boxity -> Pat GhcTc
+mkVanillaTuplePat :: [LPat GhcTc] -> Boxity -> Pat GhcTc
 -- A vanilla tuple pattern simply gets its type from its sub-patterns
 mkVanillaTuplePat pats box = TuplePat (map hsLPatType pats) pats box
 
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index c3b144dbfa..15edfd7bb6 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -765,6 +765,7 @@ instance ( ToHie (HsMatchContext a)
   toHie _ = pure []
 
 instance ( a ~ GhcPass p
+         , IsPass p
          , ToHie (Context (Located (IdP a)))
          , ToHie (RContext (HsRecFields a (PScoped (LPat a))))
          , ToHie (LHsExpr a)
@@ -807,12 +808,11 @@ instance ( a ~ GhcPass p
       SumPat _ pat _ _ ->
         [ toHie $ PS rsp scope pscope pat
         ]
-      ConPatIn c dets ->
-        [ toHie $ C Use c
-        , toHie $ contextify dets
-        ]
-      ConPatOut {pat_con = con, pat_args = dets}->
-        [ toHie $ C Use $ fmap conLikeName con
+      ConPat {pat_con = con, pat_args = dets}->
+        [ case ghcPass @p of
+            GhcPs -> toHie $ C Use $ con
+            GhcRn -> toHie $ C Use $ con
+            GhcTc -> toHie $ C Use $ fmap conLikeName con
         , toHie $ contextify dets
         ]
       ViewPat _ expr pat ->
@@ -836,8 +836,15 @@ instance ( a ~ GhcPass p
                        (protectSig @a cscope sig)
               -- See Note [Scoping Rules for SigPat]
         ]
-      CoPat _ _ _ _ ->
-        []
+      XPat e -> case ghcPass @p of
+#if __GLASGOW_HASKELL__ < 811
+        GhcPs -> noExtCon e
+        GhcRn -> noExtCon e
+#endif
+        GhcTc -> []
+          where
+            -- Make sure we get an error if this changes
+            _noWarn@(CoPat _ _ _) = e
     where
       contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args
       contextify (InfixCon a b) = InfixCon a' b'
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 7ce2f4fb9a..b135478584 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -603,7 +603,7 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
        ; return $ mkMatchGroup FromSource matches }
   where
     fromDecl (L loc decl@(ValD _ (PatBind _
-                         pat@(L _ (ConPatIn ln@(L _ name) details))
+                         pat@(L _ (ConPat NoExtField ln@(L _ name) details))
                                rhs _))) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr loc decl
@@ -1077,7 +1077,11 @@ checkLPat e@(L l _) = checkPat l e []
 checkPat :: SrcSpan -> Located (PatBuilder GhcPs) -> [LPat GhcPs]
          -> PV (LPat GhcPs)
 checkPat loc (L l e@(PatBuilderVar (L _ c))) args
-  | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
+  | isRdrDataCon c = return . L loc $ ConPat
+      { pat_con_ext = noExtField
+      , pat_con = L l c
+      , pat_args = PrefixCon args
+      }
   | not (null args) && patIsRec c =
       localPV_msg (\_ -> text "Perhaps you intended to use RecursiveDo") $
       patFail l (ppr e)
@@ -1114,7 +1118,11 @@ checkAPat loc e0 = do
      | isRdrDataCon c -> do
          l <- checkLPat l
          r <- checkLPat r
-         return (ConPatIn (L cl c) (InfixCon l r))
+         return $ ConPat
+           { pat_con_ext = noExtField
+           , pat_con = L cl c
+           , pat_args = InfixCon l r
+           }
 
    PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExtField))
    _           -> patFail loc (ppr e0)
@@ -2065,7 +2073,11 @@ mkPatRec ::
 mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd)
   | isRdrDataCon (unLoc c)
   = do fs <- mapM checkPatField fs
-       return (PatBuilderPat (ConPatIn c (RecCon (HsRecFields fs dd))))
+       return $ PatBuilderPat $ ConPat
+         { pat_con_ext = noExtField
+         , pat_con = c
+         , pat_args = RecCon (HsRecFields fs dd)
+         }
 mkPatRec p _ =
   addFatalError (getLoc p) $ text "Not a record constructor:" <+> ppr p
 
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 6142718ceb..9c52087448 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -12,6 +12,7 @@ free variables.
 
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -1823,13 +1824,12 @@ isStrictPattern lpat =
     ListPat{}       -> True
     TuplePat{}      -> True
     SumPat{}        -> True
-    ConPatIn{}      -> True
-    ConPatOut{}     -> True
+    ConPat{}        -> True
     LitPat{}        -> True
     NPat{}          -> True
     NPlusKPat{}     -> True
     SplicePat{}     -> True
-    CoPat{}         -> panic "isStrictPattern: CoPat"
+    XPat{}          -> panic "isStrictPattern: XPat"
 
 {-
 Note [ApplicativeDo and refutable patterns]
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index a91a672dfb..822f6f9cb9 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -1221,28 +1221,47 @@ mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
 mkConOpPatRn :: Located Name -> Fixity -> LPat GhcRn -> LPat GhcRn
              -> RnM (Pat GhcRn)
 
-mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
+mkConOpPatRn op2 fix2 p1@(L loc (ConPat NoExtField op1 (InfixCon p11 p12))) p2
   = do  { fix1 <- lookupFixityRn (unLoc op1)
         ; let (nofix_error, associate_right) = compareFixity fix1 fix2
 
         ; if nofix_error then do
                 { precParseErr (NormalOp (unLoc op1),fix1)
                                (NormalOp (unLoc op2),fix2)
-                ; return (ConPatIn op2 (InfixCon p1 p2)) }
+                ; return $ ConPat
+                    { pat_con_ext = noExtField
+                    , pat_con = op2
+                    , pat_args = InfixCon p1 p2
+                    }
+                }
 
           else if associate_right then do
                 { new_p <- mkConOpPatRn op2 fix2 p12 p2
-                ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) }
+                ; return $ ConPat
+                    { pat_con_ext = noExtField
+                    , pat_con = op1
+                    , pat_args = InfixCon p11 (L loc new_p)
+                    }
+                }
                 -- XXX loc right?
-          else return (ConPatIn op2 (InfixCon p1 p2)) }
+          else return $ ConPat
+                 { pat_con_ext = noExtField
+                 , pat_con = op2
+                 , pat_args = InfixCon p1 p2
+                 }
+        }
 
 mkConOpPatRn op _ p1 p2                         -- Default case, no rearrangment
   = ASSERT( not_op_pat (unLoc p2) )
-    return (ConPatIn op (InfixCon p1 p2))
+    return $ ConPat
+      { pat_con_ext = noExtField
+      , pat_con = op
+      , pat_args = InfixCon p1 p2
+      }
 
 not_op_pat :: Pat GhcRn -> Bool
-not_op_pat (ConPatIn _ (InfixCon _ _)) = False
-not_op_pat _                           = True
+not_op_pat (ConPat NoExtField _ (InfixCon _ _)) = False
+not_op_pat _                                    = True
 
 --------------------------------------
 checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
@@ -1270,7 +1289,7 @@ checkPrecMatch op (MG { mg_alts = (L _ ms) })
         -- second eqn.
 
 checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
-checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
+checkPrec op (ConPat NoExtField op1 (InfixCon _ _)) right = do
     op_fix@(Fixity _ op_prec  op_dir) <- lookupFixityRn op
     op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
     let
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index d8f55ccc1f..8e6747550e 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -468,14 +468,14 @@ rnPatAndThen mk p@(ViewPat x expr pat)
        -- ; return (ViewPat expr' pat' ty) }
        ; return (ViewPat x expr' pat') }
 
-rnPatAndThen mk (ConPatIn con stuff)
+rnPatAndThen mk (ConPat NoExtField con args)
    -- rnConPatAndThen takes care of reconstructing the pattern
    -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.
   = case unLoc con == nameRdrName (dataConName nilDataCon) of
       True    -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists
                     ; if ol_flag then rnPatAndThen mk (ListPat noExtField [])
-                                 else rnConPatAndThen mk con stuff}
-      False   -> rnConPatAndThen mk con stuff
+                                 else rnConPatAndThen mk con args}
+      False   -> rnConPatAndThen mk con args
 
 rnPatAndThen mk (ListPat _ pats)
   = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists
@@ -505,9 +505,6 @@ rnPatAndThen mk (SplicePat _ splice)
            Left  not_yet_renamed -> rnPatAndThen mk not_yet_renamed
            Right already_renamed -> return already_renamed }
 
-rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
-
-
 --------------------
 rnConPatAndThen :: NameMaker
                 -> Located RdrName    -- the constructor
@@ -517,7 +514,12 @@ rnConPatAndThen :: NameMaker
 rnConPatAndThen mk con (PrefixCon pats)
   = do  { con' <- lookupConCps con
         ; pats' <- rnLPatsAndThen mk pats
-        ; return (ConPatIn con' (PrefixCon pats')) }
+        ; return $ ConPat
+            { pat_con_ext = noExtField
+            , pat_con = con'
+            , pat_args = PrefixCon pats'
+            }
+        }
 
 rnConPatAndThen mk con (InfixCon pat1 pat2)
   = do  { con' <- lookupConCps con
@@ -529,7 +531,12 @@ rnConPatAndThen mk con (InfixCon pat1 pat2)
 rnConPatAndThen mk con (RecCon rpats)
   = do  { con' <- lookupConCps con
         ; rpats' <- rnHsRecPatsAndThen mk con' rpats
-        ; return (ConPatIn con' (RecCon rpats')) }
+        ; return $ ConPat
+            { pat_con_ext = noExtField
+            , pat_con = con'
+            , pat_args = RecCon rpats'
+            }
+        }
 
 checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [Name] -> CpsRn ()
 checkUnusedRecordWildcardCps loc dotdot_names =
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 5156bb0aa1..ad103ca7c8 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -532,9 +532,13 @@ unliftedCompare lt_op eq_op a_expr b_expr lt eq gt
 
 nlConWildPat :: DataCon -> LPat GhcPs
 -- The pattern (K {})
-nlConWildPat con = noLoc (ConPatIn (noLoc (getRdrName con))
-                                   (RecCon (HsRecFields { rec_flds = []
-                                                        , rec_dotdot = Nothing })))
+nlConWildPat con = noLoc $ ConPat
+  { pat_con_ext = noExtField
+  , pat_con = noLoc $ getRdrName con
+  , pat_args = RecCon $ HsRecFields
+      { rec_flds = []
+      , rec_dotdot = Nothing }
+  }
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 94e90acd24..69c5e67197 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -81,9 +81,9 @@ Note that
 ************************************************************************
 -}
 
-tcProc :: InPat GhcRn -> LHsCmdTop GhcRn        -- proc pat -> expr
+tcProc :: LPat GhcRn -> LHsCmdTop GhcRn         -- proc pat -> expr
        -> ExpRhoType                            -- Expected type of whole proc expression
-       -> TcM (OutPat GhcTcId, LHsCmdTop GhcTcId, TcCoercion)
+       -> TcM (LPat GhcTc, LHsCmdTop GhcTcId, TcCoercion)
 
 tcProc pat cmd exp_ty
   = newArrowScope $
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index a8a8d027f0..44fd594849 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -506,8 +506,8 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
       tcPolyBinds sig_fn prag_fn Recursive rec_tc closed binds
 
 recursivePatSynErr ::
-     OutputableBndrId p =>
-     SrcSpan -- ^ The location of the first pattern synonym binding
+     (OutputableBndrId p, CollectPass (GhcPass p))
+  => SrcSpan -- ^ The location of the first pattern synonym binding
              --   (for error reporting)
   -> LHsBinds (GhcPass p)
   -> TcM a
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 2ae1f1cfb9..0456677cc7 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -521,7 +521,7 @@ tc_pat penv (SumPat _ pat alt arity ) pat_ty thing_inside
 
 ------------------------
 -- Data constructors
-tc_pat penv (ConPatIn con arg_pats) pat_ty thing_inside
+tc_pat penv (ConPat NoExtField con arg_pats) pat_ty thing_inside
   = tcConPat penv con pat_ty arg_pats thing_inside
 
 ------------------------
@@ -872,12 +872,15 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty
                     -- (see Note [Arrows and patterns])
                     (arg_pats', res) <- tcConArgs (RealDataCon data_con) arg_tys'
                                                   arg_pats penv thing_inside
-                  ; let res_pat = ConPatOut { pat_con = header,
-                                              pat_tvs = [], pat_dicts = [],
-                                              pat_binds = emptyTcEvBinds,
-                                              pat_args = arg_pats',
-                                              pat_arg_tys = ctxt_res_tys,
-                                              pat_wrap = idHsWrapper }
+                  ; let res_pat = ConPat { pat_con = header
+                                         , pat_args = arg_pats'
+                                         , pat_con_ext = ConPatTc
+                                           { cpt_tvs = [], cpt_dicts = []
+                                           , cpt_binds = emptyTcEvBinds
+                                           , cpt_arg_tys = ctxt_res_tys
+                                           , cpt_wrap = idHsWrapper
+                                           }
+                                         }
 
                   ; return (mkHsWrapPat wrap res_pat pat_ty, res) }
 
@@ -906,13 +909,17 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty
              <- checkConstraints skol_info ex_tvs' given $
                 tcConArgs (RealDataCon data_con) arg_tys' arg_pats penv thing_inside
 
-        ; let res_pat = ConPatOut { pat_con   = header,
-                                    pat_tvs   = ex_tvs',
-                                    pat_dicts = given,
-                                    pat_binds = ev_binds,
-                                    pat_args  = arg_pats',
-                                    pat_arg_tys = ctxt_res_tys,
-                                    pat_wrap  = idHsWrapper }
+        ; let res_pat = ConPat
+                { pat_con   = header
+                , pat_args  = arg_pats'
+                , pat_con_ext = ConPatTc
+                  { cpt_tvs   = ex_tvs'
+                  , cpt_dicts = given
+                  , cpt_binds = ev_binds
+                  , cpt_arg_tys = ctxt_res_tys
+                  , cpt_wrap  = idHsWrapper
+                  }
+                }
         ; return (mkHsWrapPat wrap res_pat pat_ty, res)
         } }
 
@@ -957,13 +964,16 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
                 tcConArgs (PatSynCon pat_syn) arg_tys' arg_pats penv thing_inside
 
         ; traceTc "checkConstraints }" (ppr ev_binds)
-        ; let res_pat = ConPatOut { pat_con   = L con_span $ PatSynCon pat_syn,
-                                    pat_tvs   = ex_tvs',
-                                    pat_dicts = prov_dicts',
-                                    pat_binds = ev_binds,
-                                    pat_args  = arg_pats',
-                                    pat_arg_tys = mkTyVarTys univ_tvs',
-                                    pat_wrap  = req_wrap }
+        ; let res_pat = ConPat { pat_con   = L con_span $ PatSynCon pat_syn
+                               , pat_args  = arg_pats'
+                               , pat_con_ext = ConPatTc
+                                 { cpt_tvs   = ex_tvs'
+                                 , cpt_dicts = prov_dicts'
+                                 , cpt_binds = ev_binds
+                                 , cpt_arg_tys = mkTyVarTys univ_tvs'
+                                 , cpt_wrap  = req_wrap
+                                 }
+                               }
         ; pat_ty <- readExpType pat_ty
         ; return (mkHsWrapPat wrap res_pat pat_ty, res) }
 
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 07d1453a5c..e69990cb63 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -2178,9 +2178,9 @@ tcDefaultAssocDecl fam_tc
            , text "pats"    <+> ppr pats
            , text "rhs_ty"  <+> ppr rhs_ty
            ])
-       ; pat_tvs <- zipWithM (extract_tv ppr_eqn) pats pats_vis
-       ; check_all_distinct_tvs ppr_eqn $ zip pat_tvs pats_vis
-       ; let subst = zipTvSubst pat_tvs (mkTyVarTys fam_tvs)
+       ; cpt_tvs <- zipWithM (extract_tv ppr_eqn) pats pats_vis
+       ; check_all_distinct_tvs ppr_eqn $ zip cpt_tvs pats_vis
+       ; let subst = zipTvSubst cpt_tvs (mkTyVarTys fam_tvs)
        ; pure $ Just (substTyUnchecked subst rhs_ty, loc)
            -- We also perform other checks for well-formedness and validity
            -- later, in checkValidClass
@@ -2217,8 +2217,8 @@ tcDefaultAssocDecl fam_tc
                             -- visibilities (the latter are only used for error
                             -- message purposes)
       -> TcM ()
-    check_all_distinct_tvs ppr_eqn pat_tvs_vis =
-      let dups = findDupsEq ((==) `on` fst) pat_tvs_vis in
+    check_all_distinct_tvs ppr_eqn cpt_tvs_vis =
+      let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in
       traverse_
         (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $
                pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 797ff2f594..37ba4e3329 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -940,7 +940,7 @@ tcPatToExpr name args pat = go pat
     go (L loc p) = L loc <$> go1 p
 
     go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
-    go1 (ConPatIn con info)
+    go1 (ConPat NoExtField con info)
       = case info of
           PrefixCon ps  -> mkPrefixConExpr con ps
           InfixCon l r  -> mkPrefixConExpr con [l,r]
@@ -973,8 +973,6 @@ tcPatToExpr name args pat = go pat
                                     = return $ unLoc $ foldl' nlHsApp (noLoc neg)
                                                        [noLoc (HsOverLit noExtField n)]
         | otherwise                 = return $ HsOverLit noExtField n
-    go1 (ConPatOut{})               = panic "ConPatOut in output of renamer"
-    go1 (CoPat{})                   = panic "CoPat in output of renamer"
     go1 (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
                                     = go1 pat
     go1 (SplicePat _ (HsSpliced{})) = panic "Invalid splice variety"
@@ -1124,10 +1122,11 @@ tcCollectEx pat = go pat
     go1 (TuplePat _ ps _)  = mergeMany . map go $ ps
     go1 (SumPat _ p _ _)   = go p
     go1 (ViewPat _ _ p)    = go p
-    go1 con@ConPatOut{}    = merge (pat_tvs con, pat_dicts con) $
+    go1 con@ConPat{ pat_con_ext = con' }
+                           = merge (cpt_tvs con', cpt_dicts con') $
                               goConDetails $ pat_args con
     go1 (SigPat _ p _)     = go p
-    go1 (CoPat _ _ p _)    = go1 p
+    go1 (XPat (CoPat _ p _)) = go1 p
     go1 (NPlusKPat _ n k _ geq subtract)
       = pprPanic "TODO: NPlusKPat" $ ppr n $$ ppr k $$ ppr geq $$ ppr subtract
     go1 _                   = empty
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index d12e7efce4..5ee3620db1 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -895,7 +895,7 @@ mkOneRecordSelector all_cons idDetails fl
     mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname)
                                  [L loc (mk_sel_pat con)]
                                  (L loc (HsVar noExtField (L loc field_var)))
-    mk_sel_pat con = ConPatIn (L loc (getName con)) (RecCon rec_fields)
+    mk_sel_pat con = ConPat NoExtField (L loc (getName con)) (RecCon rec_fields)
     rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
     rec_field  = noLoc (HsRecField
                         { hsRecFieldLbl
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 00f11c09ae..09caf5fefa 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -114,14 +114,16 @@ hsPatType (ListPat (ListPatTc _ (Just (ty,_))) _) = ty
 hsPatType (TuplePat tys _ bx)           = mkTupleTy1 bx tys
                   -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
 hsPatType (SumPat tys _ _ _ )           = mkSumTy tys
-hsPatType (ConPatOut { pat_con = lcon
-                     , pat_arg_tys = tys })
+hsPatType (ConPat { pat_con = lcon
+                  , pat_con_ext = ConPatTc
+                    { cpt_arg_tys = tys
+                    }
+                  })
                                         = conLikeResTy (unLoc lcon) tys
 hsPatType (SigPat ty _ _)               = ty
 hsPatType (NPat ty _ _ _)               = ty
 hsPatType (NPlusKPat ty _ _ _ _ _)      = ty
-hsPatType (CoPat _ _ _ ty)              = ty
-hsPatType ConPatIn{}                    = panic "hsPatType: ConPatIn"
+hsPatType (XPat (CoPat _ _ ty))         = ty
 hsPatType SplicePat{}                   = panic "hsPatType: SplicePat"
 
 hsLitType :: HsLit (GhcPass p) -> TcType
@@ -1296,7 +1298,7 @@ mapIPNameTc f (Right x) = do r <- f x
 ************************************************************************
 -}
 
-zonkPat :: ZonkEnv -> OutPat GhcTcId -> TcM (ZonkEnv, OutPat GhcTc)
+zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
 -- Extend the environment as we go, because it's possible for one
 -- pattern to bind something that is used in another (inside or
 -- to the right)
@@ -1358,13 +1360,16 @@ zonk_pat env (SumPat tys pat alt arity )
         ; (env', pat') <- zonkPat env pat
         ; return (env', SumPat tys' pat' alt arity) }
 
-zonk_pat env p@(ConPatOut { pat_arg_tys = tys
-                          , pat_tvs = tyvars
-                          , pat_dicts = evs
-                          , pat_binds = binds
-                          , pat_args = args
-                          , pat_wrap = wrapper
-                          , pat_con = L _ con })
+zonk_pat env p@(ConPat { pat_con = L _ con
+                       , pat_args = args
+                       , pat_con_ext = p'@(ConPatTc
+                         { cpt_tvs = tyvars
+                         , cpt_dicts = evs
+                         , cpt_binds = binds
+                         , cpt_wrap = wrapper
+                         , cpt_arg_tys = tys
+                         })
+                       })
   = ASSERT( all isImmutableTyVar tyvars )
     do  { new_tys <- mapM (zonkTcTypeToTypeX env) tys
 
@@ -1384,12 +1389,19 @@ zonk_pat env p@(ConPatOut { pat_arg_tys = tys
         ; (env2, new_binds) <- zonkTcEvBinds env1 binds
         ; (env3, new_wrapper) <- zonkCoFn env2 wrapper
         ; (env', new_args) <- zonkConStuff env3 args
-        ; return (env', p { pat_arg_tys = new_tys,
-                            pat_tvs = new_tyvars,
-                            pat_dicts = new_evs,
-                            pat_binds = new_binds,
-                            pat_args = new_args,
-                            pat_wrap = new_wrapper}) }
+        ; pure ( env'
+               , p
+                 { pat_args = new_args
+                 , pat_con_ext = p'
+                   { cpt_arg_tys = new_tys
+                   , cpt_tvs = new_tyvars
+                   , cpt_dicts = new_evs
+                   , cpt_binds = new_binds
+                   , cpt_wrap = new_wrapper
+                   }
+                 }
+               )
+        }
   where
     doc = text "In the type of an element of an unboxed tuple pattern:" $$ ppr p
 
@@ -1420,19 +1432,20 @@ zonk_pat env (NPlusKPat ty (L loc n) (L l lit1) lit2 e1 e2)
         ; return (extendIdZonkEnv env2 n',
                   NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') }
 
-zonk_pat env (CoPat x co_fn pat ty)
+zonk_pat env (XPat (CoPat co_fn pat ty))
   = do { (env', co_fn') <- zonkCoFn env co_fn
        ; (env'', pat') <- zonkPat env' (noLoc pat)
        ; ty' <- zonkTcTypeToTypeX env'' ty
-       ; return (env'', CoPat x co_fn' (unLoc pat') ty') }
+       ; return (env'', XPat $ CoPat co_fn' (unLoc pat') ty')
+       }
 
 zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat)
 
 ---------------------------
 zonkConStuff :: ZonkEnv
-             -> HsConDetails (OutPat GhcTcId) (HsRecFields id (OutPat GhcTcId))
+             -> HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc))
              -> TcM (ZonkEnv,
-                    HsConDetails (OutPat GhcTc) (HsRecFields id (OutPat GhcTc)))
+                    HsConDetails (LPat GhcTc) (HsRecFields id (LPat GhcTc)))
 zonkConStuff env (PrefixCon pats)
   = do  { (env', pats') <- zonkPats env pats
         ; return (env', PrefixCon pats') }
@@ -1451,7 +1464,7 @@ zonkConStuff env (RecCon (HsRecFields rpats dd))
         -- Field selectors have declared types; hence no zonking
 
 ---------------------------
-zonkPats :: ZonkEnv -> [OutPat GhcTcId] -> TcM (ZonkEnv, [OutPat GhcTc])
+zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc])
 zonkPats env []         = return (env, [])
 zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
                              ; (env', pats') <- zonkPats env1 pats
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 6e44a6c399..c72d4cd357 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -2155,8 +2155,8 @@ checkFamPatBinders fam_tc qtvs pats rhs
               , ppr (mkTyConApp fam_tc pats)
               , text "qtvs:" <+> ppr qtvs
               , text "rhs_tvs:" <+> ppr (fvVarSet rhs_fvs)
-              , text "pat_tvs:" <+> ppr pat_tvs
-              , text "inj_pat_tvs:" <+> ppr inj_pat_tvs ]
+              , text "cpt_tvs:" <+> ppr cpt_tvs
+              , text "inj_cpt_tvs:" <+> ppr inj_cpt_tvs ]
 
          -- Check for implicitly-bound tyvars, mentioned on the
          -- RHS but not bound on the LHS
@@ -2176,23 +2176,23 @@ checkFamPatBinders fam_tc qtvs pats rhs
                             (text "used in")
        }
   where
-    pat_tvs     = tyCoVarsOfTypes pats
-    inj_pat_tvs = fvVarSet $ injectiveVarsOfTypes False pats
+    cpt_tvs     = tyCoVarsOfTypes pats
+    inj_cpt_tvs = fvVarSet $ injectiveVarsOfTypes False pats
       -- The type variables that are in injective positions.
       -- See Note [Dodgy binding sites in type family instances]
       -- NB: The False above is irrelevant, as we never have type families in
       -- patterns.
       --
       -- NB: It's OK to use the nondeterministic `fvVarSet` function here,
-      -- since the order of `inj_pat_tvs` is never revealed in an error
+      -- since the order of `inj_cpt_tvs` is never revealed in an error
       -- message.
     rhs_fvs     = tyCoFVsOfType rhs
-    used_tvs    = pat_tvs `unionVarSet` fvVarSet rhs_fvs
+    used_tvs    = cpt_tvs `unionVarSet` fvVarSet rhs_fvs
     bad_qtvs    = filterOut (`elemVarSet` used_tvs) qtvs
                   -- Bound but not used at all
-    bad_rhs_tvs = filterOut (`elemVarSet` inj_pat_tvs) (fvVarList rhs_fvs)
+    bad_rhs_tvs = filterOut (`elemVarSet` inj_cpt_tvs) (fvVarList rhs_fvs)
                   -- Used on RHS but not bound on LHS
-    dodgy_tvs   = pat_tvs `minusVarSet` inj_pat_tvs
+    dodgy_tvs   = cpt_tvs `minusVarSet` inj_cpt_tvs
 
     check_tvs tvs what what2
       = unless (null tvs) $ addErrAt (getSrcSpan (head tvs)) $
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 7b5e4ce219..622ab13403 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1268,12 +1268,22 @@ cvtp (UnboxedSumP p alt arity)
                             ; return $ SumPat noExtField p' alt arity }
 cvtp (ConP s ps)       = do { s' <- cNameL s; ps' <- cvtPats ps
                             ; let pps = map (parenthesizePat appPrec) ps'
-                            ; return $ ConPatIn s' (PrefixCon pps) }
+                            ; return $ ConPat
+                                { pat_con_ext = noExtField
+                                , pat_con = s'
+                                , pat_args = PrefixCon pps
+                                }
+                            }
 cvtp (InfixP p1 s p2)  = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
                             ; wrapParL (ParPat noExtField) $
-                              ConPatIn s' $
-                              InfixCon (parenthesizePat opPrec p1')
-                                       (parenthesizePat opPrec p2') }
+                              ConPat
+                                { pat_con_ext = NoExtField
+                                , pat_con = s'
+                                , pat_args = InfixCon
+                                    (parenthesizePat opPrec p1')
+                                    (parenthesizePat opPrec p2')
+                                }
+                            }
                             -- See Note [Operator association]
 cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Converting UInfix]
 cvtp (ParensP p)       = do { p' <- cvtPat p;
@@ -1286,8 +1296,12 @@ cvtp (TH.AsP s p)      = do { s' <- vNameL s; p' <- cvtPat p
                             ; return $ AsPat noExtField s' p' }
 cvtp TH.WildP          = return $ WildPat noExtField
 cvtp (RecP c fs)       = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
-                            ; return $ ConPatIn c'
-                                     $ Hs.RecCon (HsRecFields fs' Nothing) }
+                            ; return $ ConPat
+                                { pat_con_ext = noExtField
+                                , pat_con = c'
+                                , pat_args = Hs.RecCon $ HsRecFields fs' Nothing
+                                }
+                            }
 cvtp (ListP ps)        = do { ps' <- cvtPats ps
                             ; return
                                    $ ListPat noExtField ps'}
@@ -1317,7 +1331,12 @@ cvtOpAppP x op1 (UInfixP y op2 z)
 cvtOpAppP x op y
   = do { op' <- cNameL op
        ; y' <- cvtPat y
-       ; return (ConPatIn op' (InfixCon x y')) }
+       ; return $ ConPat
+          { pat_con_ext = noExtField
+          , pat_con = op'
+          , pat_args = InfixCon x y'
+          }
+       }
 
 -----------------------------------------------------------
 --      Types and type variables
diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs
index 3a0d4ff0fb..56538e11d6 100644
--- a/testsuite/tests/ghc-api/T6145.hs
+++ b/testsuite/tests/ghc-api/T6145.hs
@@ -39,7 +39,7 @@ main = do
         = not (isEmptyBag (filterBag isDataCon bs))
       isDataCon (L l (f@FunBind {}))
         | (MG _ (L _ (m:_)) _) <- fun_matches f,
-          ((L _ (c@ConPatOut{})):_)<-hsLMatchPats m,
+          ((L _ (c@ConPat{})):_)<-hsLMatchPats m,
           (L l _)<-pat_con c
         = isGoodSrcSpan l       -- Check that the source location is a good one
       isDataCon _
diff --git a/utils/haddock b/utils/haddock
-Subproject 20bf93490b37c0410d85a0ad4d38f9ddc225358
+Subproject da4e2bd788b6231494d6ac56a8e88bcfa4be51f