HsToken for HsPar, ParPat, HsCmdPar (#19523)

This patch is a first step towards a simpler design for exact printing.

34 files changed, 254 insertions, 152 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index a25f90d0b0..89292b59c3 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -278,7 +278,7 @@ type instance XNegApp        GhcPs = EpAnn [AddEpAnn]
 type instance XNegApp        GhcRn = NoExtField
 type instance XNegApp        GhcTc = NoExtField
 
-type instance XPar           (GhcPass _) = EpAnn AnnParen
+type instance XPar           (GhcPass _) = EpAnnCO
 
 type instance XExplicitTuple GhcPs = EpAnn [AddEpAnn]
 type instance XExplicitTuple GhcRn = NoExtField
@@ -496,7 +496,7 @@ ppr_expr (HsIPVar _ v)       = ppr v
 ppr_expr (HsOverLabel _ l)   = char '#' <> ppr l
 ppr_expr (HsLit _ lit)       = ppr lit
 ppr_expr (HsOverLit _ lit)   = ppr lit
-ppr_expr (HsPar _ e)         = parens (ppr_lexpr e)
+ppr_expr (HsPar _ _ e _)     = parens (ppr_lexpr e)
 
 ppr_expr (HsPragE _ prag e) = sep [ppr prag, ppr_lexpr e]
 
@@ -810,19 +810,23 @@ hsExprNeedsParens prec = go
     go_x_rn (HsExpanded a _) = hsExprNeedsParens prec a
 
 
+-- | Parenthesize an expression without token information
+gHsPar :: LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
+gHsPar e = HsPar noAnn noHsTok e noHsTok
+
 -- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,
 -- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
 parenthesizeHsExpr :: IsPass p => PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
 parenthesizeHsExpr p le@(L loc e)
-  | hsExprNeedsParens p e = L loc (HsPar noAnn le)
+  | hsExprNeedsParens p e = L loc (gHsPar le)
   | otherwise             = le
 
 stripParensLHsExpr :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-stripParensLHsExpr (L _ (HsPar _ e)) = stripParensLHsExpr e
+stripParensLHsExpr (L _ (HsPar _ _ e _)) = stripParensLHsExpr e
 stripParensLHsExpr e = e
 
 stripParensHsExpr :: HsExpr (GhcPass p) -> HsExpr (GhcPass p)
-stripParensHsExpr (HsPar _ (L _ e)) = stripParensHsExpr e
+stripParensHsExpr (HsPar _ _ (L _ e) _) = stripParensHsExpr e
 stripParensHsExpr e = e
 
 isAtomicHsExpr :: forall p. IsPass p => HsExpr (GhcPass p) -> Bool
@@ -1044,7 +1048,7 @@ type instance XCmdArrForm GhcTc = NoExtField
 
 type instance XCmdApp     (GhcPass _) = EpAnnCO
 type instance XCmdLam     (GhcPass _) = NoExtField
-type instance XCmdPar     (GhcPass _) = EpAnn AnnParen
+type instance XCmdPar     (GhcPass _) = EpAnnCO
 
 type instance XCmdCase    GhcPs = EpAnn EpAnnHsCase
 type instance XCmdCase    GhcRn = NoExtField
@@ -1116,7 +1120,7 @@ ppr_lcmd c = ppr_cmd (unLoc c)
 
 ppr_cmd :: forall p. (OutputableBndrId p
                      ) => HsCmd (GhcPass p) -> SDoc
-ppr_cmd (HsCmdPar _ c) = parens (ppr_lcmd c)
+ppr_cmd (HsCmdPar _ _ c _) = parens (ppr_lcmd c)
 
 ppr_cmd (HsCmdApp _ c e)
   = let (fun, args) = collect_args c [e] in
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index e28bcddbf1..0a43cb8aa6 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -229,3 +229,8 @@ pprIfRn pp = case ghcPass @p of GhcRn -> pp
 pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
 pprIfTc pp = case ghcPass @p of GhcTc -> pp
                                 _     -> empty
+
+type instance Anno (HsToken tok) = EpAnnCO
+
+noHsTok :: GenLocated (EpAnn a) (HsToken tok)
+noHsTok = L noAnn HsTok
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 239c57418b..68d76909a2 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -39,7 +39,7 @@ module GHC.Hs.Pat (
         isSimplePat,
         looksLazyPatBind,
         isBangedLPat,
-        patNeedsParens, parenthesizePat,
+        gParPat, patNeedsParens, parenthesizePat,
         isIrrefutableHsPat,
 
         collectEvVarsPat, collectEvVarsPats,
@@ -103,7 +103,7 @@ type instance XAsPat   GhcPs = EpAnn [AddEpAnn] -- For '@'
 type instance XAsPat   GhcRn = NoExtField
 type instance XAsPat   GhcTc = NoExtField
 
-type instance XParPat  (GhcPass _) = EpAnn AnnParen
+type instance XParPat (GhcPass _) = EpAnnCO
 
 type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!'
 type instance XBangPat GhcRn = NoExtField
@@ -285,7 +285,7 @@ pprPat (BangPat _ pat)          = char '!' <> pprParendLPat appPrec pat
 pprPat (AsPat _ name pat)       = hcat [pprPrefixOcc (unLoc name), char '@',
                                         pprParendLPat appPrec pat]
 pprPat (ViewPat _ expr pat)     = hcat [pprLExpr expr, text " -> ", ppr pat]
-pprPat (ParPat _ pat)           = parens (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
@@ -420,7 +420,7 @@ isBangedLPat :: LPat (GhcPass p) -> Bool
 isBangedLPat = isBangedPat . unLoc
 
 isBangedPat :: Pat (GhcPass p) -> Bool
-isBangedPat (ParPat _ p) = isBangedLPat p
+isBangedPat (ParPat _ _ p _) = isBangedLPat p
 isBangedPat (BangPat {}) = True
 isBangedPat _            = False
 
@@ -441,8 +441,8 @@ looksLazyLPat :: LPat (GhcPass p) -> Bool
 looksLazyLPat = looksLazyPat . unLoc
 
 looksLazyPat :: Pat (GhcPass p) -> Bool
-looksLazyPat (ParPat _ p)  = looksLazyLPat p
-looksLazyPat (AsPat _ _ p) = looksLazyLPat p
+looksLazyPat (ParPat _ _ p _)  = looksLazyLPat p
+looksLazyPat (AsPat _ _ p)     = looksLazyLPat p
 looksLazyPat (BangPat {})  = False
 looksLazyPat (VarPat {})   = False
 looksLazyPat (WildPat {})  = False
@@ -508,7 +508,7 @@ isIrrefutableHsPat' is_strict = goL
       = isIrrefutableHsPat' False p'
       | otherwise          = True
     go (BangPat _ pat)     = goL pat
-    go (ParPat _ pat)      = goL pat
+    go (ParPat _ _ pat _)  = goL pat
     go (AsPat _ _ pat)     = goL pat
     go (ViewPat _ _ pat)   = goL pat
     go (SigPat _ pat _)    = goL pat
@@ -553,7 +553,7 @@ isIrrefutableHsPat' is_strict = goL
 -- - x (variable)
 isSimplePat :: LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
 isSimplePat p = case unLoc p of
-  ParPat _ x -> isSimplePat x
+  ParPat _ _ x _ -> isSimplePat x
   SigPat _ x _ -> isSimplePat x
   LazyPat _ x -> isSimplePat x
   BangPat _ x -> isSimplePat x
@@ -628,6 +628,11 @@ conPatNeedsParens p = go
     go (InfixCon {})       = p >= opPrec -- type args should be empty in this case
     go (RecCon {})         = False
 
+
+-- | Parenthesize a pattern without token information
+gParPat :: LPat (GhcPass pass) -> Pat (GhcPass pass)
+gParPat p = ParPat noAnn noHsTok p noHsTok
+
 -- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
 -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
 parenthesizePat :: IsPass p
@@ -635,7 +640,7 @@ parenthesizePat :: IsPass p
                 -> LPat (GhcPass p)
                 -> LPat (GhcPass p)
 parenthesizePat p lpat@(L loc pat)
-  | patNeedsParens p pat = L loc (ParPat noAnn lpat)
+  | patNeedsParens p pat = L loc (gParPat lpat)
   | otherwise            = lpat
 
 {-
@@ -654,7 +659,7 @@ collectEvVarsPat pat =
   case pat of
     LazyPat _ p      -> collectEvVarsLPat p
     AsPat _ _ p      -> collectEvVarsLPat p
-    ParPat  _ p      -> collectEvVarsLPat p
+    ParPat  _ _ p _  -> collectEvVarsLPat p
     BangPat _ p      -> collectEvVarsLPat p
     ListPat _ ps     -> unionManyBags $ map collectEvVarsLPat ps
     TuplePat _ ps _  -> unionManyBags $ map collectEvVarsLPat ps
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 4f9e5c83bc..5c6a53a8a7 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -168,7 +168,7 @@ just attach 'noSrcSpan' to everything.
 
 -- | @e => (e)@
 mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsPar e = L (getLoc e) (HsPar noAnn e)
+mkHsPar e = L (getLoc e) (gHsPar e)
 
 mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
                         ~ SrcSpanAnnA,
@@ -284,17 +284,13 @@ nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
 -- | Wrap in parens if @'hsExprNeedsParens' appPrec@ says it needs them
 -- So @f x@ becomes @(f x)@, but @3@ stays as @3@.
 mkLHsPar :: IsPass id => LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkLHsPar le@(L loc e)
-  | hsExprNeedsParens appPrec e = L loc (HsPar noAnn le)
-  | otherwise                   = le
+mkLHsPar = parenthesizeHsExpr appPrec
 
 mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
-mkParPat lp@(L loc p)
-  | patNeedsParens appPrec p = L loc (ParPat noAnn lp)
-  | otherwise                = lp
+mkParPat = parenthesizePat appPrec
 
 nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
-nlParPat p = noLocA (ParPat noAnn p)
+nlParPat p = noLocA (gParPat p)
 
 -------------------------------
 -- These are the bits of syntax that contain rebindable names
@@ -594,7 +590,7 @@ nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs
 
 -- AZ:Is this used?
 nlHsLam match = noLocA (HsLam noExtField (mkMatchGroup Generated (noLocA [match])))
-nlHsPar e     = noLocA (HsPar noAnn e)
+nlHsPar e     = noLocA (gHsPar e)
 
 -- nlHsIf should generate if-expressions which are NOT subject to
 -- RebindableSyntax, so the first field of HsIf is False. (#12080)
@@ -795,7 +791,7 @@ mkLHsWrap co_fn (L loc e) = L loc (mkHsWrap co_fn e)
 mkHsWrap :: HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
 mkHsWrap co_fn e | isIdHsWrapper co_fn   = e
 mkHsWrap co_fn (XExpr (WrapExpr (HsWrap co_fn' e))) = mkHsWrap (co_fn <.> co_fn') e
-mkHsWrap co_fn (HsPar x (L l e))                = HsPar x (L l (mkHsWrap co_fn e))
+mkHsWrap co_fn (HsPar x lpar (L l e) rpar)      = HsPar x lpar (L l (mkHsWrap co_fn e)) rpar
 mkHsWrap co_fn e                                = XExpr (WrapExpr $ HsWrap co_fn e)
 
 mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b
@@ -925,13 +921,8 @@ mkMatch :: forall p. IsPass p
 mkMatch ctxt pats expr binds
   = noLocA (Match { m_ext   = noAnn
                   , m_ctxt  = ctxt
-                  , m_pats  = map paren pats
+                  , m_pats  = map mkParPat pats
                   , m_grhss = GRHSs noExtField (unguardedRHS noAnn noSrcSpan expr) binds })
-  where
-    paren :: LPat (GhcPass p) -> LPat (GhcPass p)
-    paren lp@(L l p)
-      | patNeedsParens appPrec p = L l (ParPat noAnn lp)
-      | otherwise                = lp
 
 {-
 ************************************************************************
@@ -1209,7 +1200,7 @@ collect_pat flag pat bndrs = case pat of
   BangPat _ pat         -> collect_lpat flag pat bndrs
   AsPat _ a pat         -> unXRec @p a : collect_lpat flag pat bndrs
   ViewPat _ _ pat       -> collect_lpat flag pat bndrs
-  ParPat _ pat          -> collect_lpat flag pat bndrs
+  ParPat _ _ pat _      -> collect_lpat flag pat bndrs
   ListPat _ pats        -> foldr (collect_lpat flag) bndrs pats
   TuplePat _ pats _     -> foldr (collect_lpat flag) bndrs pats
   SumPat _ pat _ _      -> collect_lpat flag pat bndrs
@@ -1584,7 +1575,7 @@ lPatImplicits = hs_lpat
     hs_pat (BangPat _ pat)      = hs_lpat pat
     hs_pat (AsPat _ _ pat)      = hs_lpat pat
     hs_pat (ViewPat _ _ pat)    = hs_lpat pat
-    hs_pat (ParPat _ pat)       = hs_lpat pat
+    hs_pat (ParPat _ _ pat _)   = hs_lpat pat
     hs_pat (ListPat _ pats)     = hs_lpats pats
     hs_pat (TuplePat _ pats _)  = hs_lpats pats
 
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 0f7f261341..9183a4f8ed 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -447,7 +447,7 @@ dsCmd ids local_vars stack_ty res_ty
         env_ids
   = dsCmdLam ids local_vars stack_ty res_ty pats body env_ids
 
-dsCmd ids local_vars stack_ty res_ty (HsCmdPar _ cmd) env_ids
+dsCmd ids local_vars stack_ty res_ty (HsCmdPar _ _ cmd _) env_ids
   = dsLCmd ids local_vars stack_ty res_ty cmd env_ids
 
 -- D, xs |- e :: Bool
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index fbb14ce28f..d876ad39f4 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -543,8 +543,9 @@ addTickHsExpr (NegApp x e neg) =
         liftM2 (NegApp x)
                 (addTickLHsExpr e)
                 (addTickSyntaxExpr hpcSrcSpan neg)
-addTickHsExpr (HsPar x e) =
-        liftM (HsPar x) (addTickLHsExprEvalInner e)
+addTickHsExpr (HsPar x lpar e rpar) = do
+        e' <- addTickLHsExprEvalInner e
+        return (HsPar x lpar e' rpar)
 addTickHsExpr (SectionL x e1 e2) =
         liftM2 (SectionL x)
                 (addTickLHsExpr e1)
@@ -869,7 +870,9 @@ addTickHsCmd (OpApp e1 c2 fix c3) =
                 (return fix)
                 (addTickLHsCmd c3)
 -}
-addTickHsCmd (HsCmdPar x e) = liftM (HsCmdPar x) (addTickLHsCmd e)
+addTickHsCmd (HsCmdPar x lpar e rpar) = do
+        e' <- addTickLHsCmd e
+        return (HsCmdPar x lpar e' rpar)
 addTickHsCmd (HsCmdCase x e mgs) =
         liftM2 (HsCmdCase x)
                 (addTickLHsExpr e)
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index e89ab4868b..0735ed9000 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -270,7 +270,7 @@ dsExpr (HsRecSel _ (FieldOcc id _))    = dsHsVar id
 dsExpr (HsUnboundVar (HER ref _ _) _)  = dsEvTerm =<< readMutVar ref
         -- See Note [Holes] in GHC.Tc.Types.Constraint
 
-dsExpr (HsPar _ e)            = dsLExpr e
+dsExpr (HsPar _ _ e _)        = dsLExpr e
 dsExpr (ExprWithTySig _ e _)  = dsLExpr e
 
 dsExpr (HsIPVar {})           = panic "dsExpr: HsIPVar"
@@ -1235,7 +1235,7 @@ dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
 dsHsWrapped orig_hs_expr
   = go idHsWrapper orig_hs_expr
   where
-    go wrap (HsPar _ (L _ hs_e))
+    go wrap (HsPar _ _ (L _ hs_e) _)
        = go wrap hs_e
     go wrap1 (XExpr (WrapExpr (HsWrap wrap2 hs_e)))
        = go (wrap1 <.> wrap2) hs_e
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index f8ba578775..33ffc1e998 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -421,7 +421,7 @@ tidy1 :: Id                  -- The Id being scrutinised
 -- It eliminates many pattern forms (as-patterns, variable patterns,
 -- list patterns, etc) and returns any created bindings in the wrapper.
 
-tidy1 v o (ParPat _ pat)      = tidy1 v o (unLoc pat)
+tidy1 v o (ParPat _ _ pat _)  = tidy1 v o (unLoc pat)
 tidy1 v o (SigPat _ pat _)    = tidy1 v o (unLoc pat)
 tidy1 _ _ (WildPat ty)        = return (idDsWrapper, WildPat ty)
 tidy1 v o (BangPat _ (L l p)) = tidy_bang_pat v o l p
@@ -517,7 +517,7 @@ tidy_bang_pat :: Id -> Origin -> SrcSpanAnnA -> Pat GhcTc
               -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
-tidy_bang_pat v o _ (ParPat _ (L l p)) = tidy_bang_pat v o l p
+tidy_bang_pat v o _ (ParPat _ _ (L l p) _) = tidy_bang_pat v o l p
 tidy_bang_pat v o _ (SigPat _ (L l p) _) = tidy_bang_pat v o l p
 
 -- Push the bang-pattern inwards, in the hope that
@@ -1052,8 +1052,8 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2
     exp :: HsExpr GhcTc -> HsExpr GhcTc -> Bool
     -- real comparison is on HsExpr's
     -- strip parens
-    exp (HsPar _ (L _ e)) e'   = exp e e'
-    exp e (HsPar _ (L _ e'))   = exp e e'
+    exp (HsPar _ _ (L _ e) _) e' = exp e e'
+    exp e (HsPar _ _ (L _ e') _) = exp e e'
     -- because the expressions do not necessarily have the same type,
     -- we have to compare the wrappers
     exp (XExpr (WrapExpr (HsWrap h e))) (XExpr (WrapExpr (HsWrap  h' e'))) =
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 245b289ffd..b2f7043f45 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -447,7 +447,7 @@ getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Type)
 -- ^ See if the expression is an 'Integral' literal.
 getLHsIntegralLit (L _ e) = go e
   where
-    go (HsPar _ e)            = getLHsIntegralLit e
+    go (HsPar _ _ e _)        = getLHsIntegralLit e
     go (HsOverLit _ over_lit) = getIntegralLit over_lit
     go (HsLit _ lit)          = getSimpleIntegralLit lit
 
@@ -478,7 +478,7 @@ getSimpleIntegralLit _ = Nothing
 
 -- | Extract the Char if the expression is a Char literal.
 getLHsCharLit :: LHsExpr GhcTc -> Maybe Char
-getLHsCharLit (L _ (HsPar _ e))            = getLHsCharLit e
+getLHsCharLit (L _ (HsPar _ _ e _))        = getLHsCharLit e
 getLHsCharLit (L _ (HsTick _ _ e))         = getLHsCharLit e
 getLHsCharLit (L _ (HsBinTick _ _ _ e))    = getLHsCharLit e
 getLHsCharLit (L _ (HsLit _ (HsChar _ c))) = Just c
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index c835832702..fa32d391d2 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -108,7 +108,7 @@ desugarPat :: Id -> Pat GhcTc -> DsM [PmGrd]
 desugarPat x pat = case pat of
   WildPat  _ty -> pure []
   VarPat _ y   -> pure (mkPmLetVar (unLoc y) x)
-  ParPat _ p   -> desugarLPat x p
+  ParPat _ _ p _ -> desugarLPat x p
   LazyPat _ _  -> pure [] -- like a wildcard
   BangPat _ p@(L l p') ->
     -- Add the bang in front of the list, because it will happen before any
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 21e70cf53c..3a70bc18d6 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -1511,7 +1511,7 @@ repE (NegApp _ x _)      = do
                               a         <- repLE x
                               negateVar <- lookupOcc negateName >>= repVar
                               negateVar `repApp` a
-repE (HsPar _ x)            = repLE x
+repE (HsPar _ _ x _)        = repLE x
 repE (SectionL _ x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b }
 repE (SectionR _ x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b }
 repE (HsCase _ e (MG { mg_alts = (L _ ms) }))
@@ -2041,7 +2041,7 @@ repP (LazyPat _ p)      = do { p1 <- repLP p; repPtilde p1 }
 repP (BangPat _ p)      = do { p1 <- repLP p; repPbang p1 }
 repP (AsPat _ x p)      = do { x' <- lookupNBinder x; p1 <- repLP p
                              ; repPaspat x' p1 }
-repP (ParPat _ p)       = repLP p
+repP (ParPat _ _ p _)      = repLP p
 repP (ListPat Nothing ps)  = do { qs <- repLPs ps; repPlist qs }
 repP (ListPat (Just (SyntaxExprRn e)) ps) = do { p <- repP (ListPat Nothing ps)
                                                ; e' <- repE e
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index bc4787bbfb..49b21e2111 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -134,7 +134,7 @@ selectMatchVar :: Mult -> Pat GhcTc -> DsM Id
 -- Postcondition: the returned Id has an Internal Name
 selectMatchVar w (BangPat _ pat) = selectMatchVar w (unLoc pat)
 selectMatchVar w (LazyPat _ pat) = selectMatchVar w (unLoc pat)
-selectMatchVar w (ParPat _ pat)  = selectMatchVar w (unLoc pat)
+selectMatchVar w (ParPat _ _ pat _) = selectMatchVar w (unLoc pat)
 selectMatchVar _w (VarPat _ var)  = return (localiseId (unLoc var))
                                   -- Note [Localise pattern binders]
                                   --
@@ -784,7 +784,7 @@ mkSelectorBinds ticks pat val_expr
 
 strip_bangs :: LPat (GhcPass p) -> LPat (GhcPass p)
 -- Remove outermost bangs and parens
-strip_bangs (L _ (ParPat _ p))  = strip_bangs p
+strip_bangs (L _ (ParPat _ _ p _))  = strip_bangs p
 strip_bangs (L _ (BangPat _ p)) = strip_bangs p
 strip_bangs lp                  = lp
 
@@ -792,7 +792,7 @@ is_flat_prod_lpat :: LPat GhcTc -> Bool
 is_flat_prod_lpat = is_flat_prod_pat . unLoc
 
 is_flat_prod_pat :: Pat GhcTc -> Bool
-is_flat_prod_pat (ParPat _ p)          = is_flat_prod_lpat p
+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 (ConPat { pat_con  = L _ pcon
                          , pat_args = ps})
@@ -807,7 +807,7 @@ is_triv_lpat = is_triv_pat . unLoc
 is_triv_pat :: Pat (GhcPass p) -> Bool
 is_triv_pat (VarPat {})  = True
 is_triv_pat (WildPat{})  = True
-is_triv_pat (ParPat _ p) = is_triv_lpat p
+is_triv_pat (ParPat _ _ p _) = is_triv_lpat p
 is_triv_pat _            = False
 
 
@@ -1057,7 +1057,7 @@ decideBangHood dflags lpat
   where
     go lp@(L l p)
       = case p of
-           ParPat x p    -> L l (ParPat x (go p))
+           ParPat x lpar p rpar -> L l (ParPat x lpar (go p) rpar)
            LazyPat _ lp' -> lp'
            BangPat _ _   -> lp
            _             -> L l (BangPat noExtField lp)
@@ -1089,5 +1089,5 @@ isTrueLHsExpr (L _ (HsBinTick _ ixT _ e))
                      this_mod <- getModule
                      return (Tick (HpcTick this_mod ixT) e))
 
-isTrueLHsExpr (L _ (HsPar _ e))   = isTrueLHsExpr e
-isTrueLHsExpr _                   = Nothing
+isTrueLHsExpr (L _ (HsPar _ _ e _)) = isTrueLHsExpr e
+isTrueLHsExpr _                     = Nothing
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index c9cbd4b723..94da21083f 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -962,7 +962,7 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
                     lname
         , toHie $ PS rsp scope pscope pat
         ]
-      ParPat _ pat ->
+      ParPat _ _ pat _ ->
         [ toHie $ PS rsp scope pscope pat
         ]
       BangPat _ pat ->
@@ -1112,7 +1112,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
       NegApp _ a _ ->
         [ toHie a
         ]
-      HsPar _ a ->
+      HsPar _ _ a _ ->
         [ toHie a
         ]
       SectionL _ a b ->
@@ -1415,7 +1415,7 @@ instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where
       HsCmdLam _ mg ->
         [ toHie mg
         ]
-      HsCmdPar _ a ->
+      HsCmdPar _ _ a _ ->
         [ toHie a
         ]
       HsCmdCase _ expr alts ->
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 1848b6b1df..c89079ca70 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -2880,7 +2880,7 @@ aexp2   :: { ECP }
         -- but the less cluttered version fell out of having texps.
         | '(' texp ')'                  { ECP $
                                            unECP $2 >>= \ $2 ->
-                                           mkHsParPV (comb2 $1 $>) $2 (AnnParen AnnParens (glAA $1) (glAA $3)) }
+                                           mkHsParPV (comb2 $1 $>) (hsTok $1) $2 (hsTok $3) }
         | '(' tup_exprs ')'             { ECP $
                                            $2 >>= \ $2 ->
                                            mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2
@@ -4343,6 +4343,9 @@ listAsAnchor :: [LocatedAn t a] -> Anchor
 listAsAnchor [] = spanAsAnchor noSrcSpan
 listAsAnchor (L l _:_) = spanAsAnchor (locA l)
 
+hsTok :: Located Token -> LHsToken tok GhcPs
+hsTok (L l _) = L (EpAnn (Anchor (realSrcSpan l) UnchangedAnchor) NoEpAnns emptyComments) HsTok
+
 -- -------------------------------------
 
 addTrailingCommaFBind :: MonadP m => Fbind b -> SrcSpan -> m (Fbind b)
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 8cd5105e42..261967be85 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DataKinds #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
@@ -1142,11 +1143,10 @@ checkAPat loc e0 = do
            , pat_args = InfixCon l r
            }
 
-   PatBuilderPar e an@(AnnParen pt o c) -> do
-     (L l p) <- checkLPat e
-     let aa = [AddEpAnn ai o, AddEpAnn ac c]
-         (ai,ac) = parenTypeKws pt
-     return (ParPat (EpAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an emptyComments) (L l p))
+   PatBuilderPar lpar e rpar -> do
+     p <- checkLPat e
+     return (ParPat (EpAnn (spanAsAnchor (locA loc)) NoEpAnns emptyComments) lpar p rpar)
+
    _           -> patFail (locA loc) (ppr e0)
 
 placeHolderPunRhs :: DisambECP b => PV (LocatedA b)
@@ -1287,7 +1287,7 @@ isFunLhs e = go e [] []
    go (L _ (PatBuilderVar (L loc f))) es ann
        | not (isRdrDataCon f)        = return (Just (L loc f, Prefix, es, ann))
    go (L _ (PatBuilderApp f e)) es       ann = go f (e:es) ann
-   go (L l (PatBuilderPar e _an)) es@(_:_) ann
+   go (L l (PatBuilderPar _ e _)) es@(_:_) ann
                                       = go e es (ann ++ mkParensEpAnn (locA l))
    go (L loc (PatBuilderOpApp l (L loc' op) r (EpAnn loca anns cs))) es ann
         | not (isRdrDataCon op)         -- We have found the function!
@@ -1460,7 +1460,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
     AnnList ->
     PV (LocatedA b)
   -- | Disambiguate "( ... )" (parentheses)
-  mkHsParPV :: SrcSpan -> LocatedA b -> AnnParen -> PV (LocatedA b)
+  mkHsParPV :: SrcSpan -> LHsToken "(" GhcPs -> LocatedA b -> LHsToken ")" GhcPs -> PV (LocatedA b)
   -- | Disambiguate a variable "f" or a data constructor "MkF".
   mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
   -- | Disambiguate a monomorphic literal
@@ -1591,9 +1591,9 @@ instance DisambECP (HsCmd GhcPs) where
     cs <- getCommentsFor l
     return $ L (noAnnSrcSpan l) (HsCmdDo (EpAnn (spanAsAnchor l) anns cs) stmts)
   mkHsDoPV l (Just m)    _ _ = addFatalError $ PsError (PsErrQualifiedDoInCmd m) [] l
-  mkHsParPV l c ann = do
+  mkHsParPV l lpar c rpar = do
     cs <- getCommentsFor l
-    return $ L (noAnnSrcSpan l) (HsCmdPar (EpAnn (spanAsAnchor l) ann cs) c)
+    return $ L (noAnnSrcSpan l) (HsCmdPar (EpAnn (spanAsAnchor l) NoEpAnns cs) lpar c rpar)
   mkHsVarPV (L l v) = cmdFail (locA l) (ppr v)
   mkHsLitPV (L l a) = cmdFail l (ppr a)
   mkHsOverLitPV (L l a) = cmdFail l (ppr a)
@@ -1678,9 +1678,9 @@ instance DisambECP (HsExpr GhcPs) where
   mkHsDoPV l mod stmts anns = do
     cs <- getCommentsFor l
     return $ L (noAnnSrcSpan l) (HsDo (EpAnn (spanAsAnchor l) anns cs) (DoExpr mod) stmts)
-  mkHsParPV l e ann = do
+  mkHsParPV l lpar e rpar = do
     cs <- getCommentsFor l
-    return $ L (noAnnSrcSpan l) (HsPar (EpAnn (spanAsAnchor l) ann cs) e)
+    return $ L (noAnnSrcSpan l) (HsPar (EpAnn (spanAsAnchor l) NoEpAnns cs) lpar e rpar)
   mkHsVarPV v@(L l _) = return $ L (na2la l) (HsVar noExtField v)
   mkHsLitPV (L l a) = do
     cs <- getCommentsFor l
@@ -1755,7 +1755,7 @@ instance DisambECP (PatBuilder GhcPs) where
     return $ L l (PatBuilderAppType p (mkHsPatSigType anns t))
   mkHsIfPV l _ _ _ _ _ _ = addFatalError $ PsError PsErrIfTheElseInPat [] l
   mkHsDoPV l _ _ _       = addFatalError $ PsError PsErrDoNotationInPat [] l
-  mkHsParPV l p an       = return $ L (noAnnSrcSpan l) (PatBuilderPar p an)
+  mkHsParPV l lpar p rpar   = return $ L (noAnnSrcSpan l) (PatBuilderPar lpar p rpar)
   mkHsVarPV v@(getLoc -> l) = return $ L (na2la l) (PatBuilderVar v)
   mkHsLitPV lit@(L l a) = do
     checkUnboxedStringLitPat lit
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index b42d04f881..36abbe5125 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
 
 module GHC.Parser.Types
    ( SumOrTuple(..)
@@ -52,7 +53,7 @@ pprSumOrTuple boxity = \case
 -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
 data PatBuilder p
   = PatBuilderPat (Pat p)
-  | PatBuilderPar (LocatedA (PatBuilder p)) AnnParen
+  | PatBuilderPar (LHsToken "(" p) (LocatedA (PatBuilder p)) (LHsToken ")" p)
   | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
   | PatBuilderAppType (LocatedA (PatBuilder p)) (HsPatSigType GhcPs)
   | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
@@ -62,7 +63,7 @@ data PatBuilder p
 
 instance Outputable (PatBuilder GhcPs) where
   ppr (PatBuilderPat p) = ppr p
-  ppr (PatBuilderPar (L _ p) _) = parens (ppr p)
+  ppr (PatBuilderPar _ (L _ p) _) = parens (ppr p)
   ppr (PatBuilderApp (L _ p1) (L _ p2)) = ppr p1 <+> ppr p2
   ppr (PatBuilderAppType (L _ p) t) = ppr p <+> text "@" <> ppr t
   ppr (PatBuilderOpApp (L _ p1) op (L _ p2) _) = ppr p1 <+> ppr op <+> ppr p2
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index dce75ba1f2..564eabb601 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -333,17 +333,17 @@ rnExpr (HsSpliceE _ splice) = rnSpliceExpr splice
 ---------------------------------------------
 --      Sections
 -- See Note [Parsing sections] in GHC.Parser
-rnExpr (HsPar x (L loc (section@(SectionL {}))))
+rnExpr (HsPar x lpar (L loc (section@(SectionL {}))) rpar)
   = do  { (section', fvs) <- rnSection section
-        ; return (HsPar x (L loc section'), fvs) }
+        ; return (HsPar x lpar (L loc section') rpar, fvs) }
 
-rnExpr (HsPar x (L loc (section@(SectionR {}))))
+rnExpr (HsPar x lpar (L loc (section@(SectionR {}))) rpar)
   = do  { (section', fvs) <- rnSection section
-        ; return (HsPar x (L loc section'), fvs) }
+        ; return (HsPar x lpar (L loc section') rpar, fvs) }
 
-rnExpr (HsPar x e)
+rnExpr (HsPar x lpar e rpar)
   = do  { (e', fvs_e) <- rnLExpr e
-        ; return (HsPar x e', fvs_e) }
+        ; return (HsPar x lpar e' rpar, fvs_e) }
 
 rnExpr expr@(SectionL {})
   = do  { addErr (sectionErr expr); rnSection expr }
@@ -783,9 +783,9 @@ rnCmd (HsCmdLam _ matches)
   = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLCmd matches
        ; return (HsCmdLam noExtField matches', fvMatch) }
 
-rnCmd (HsCmdPar x e)
+rnCmd (HsCmdPar x lpar e rpar)
   = do  { (e', fvs_e) <- rnLCmd e
-        ; return (HsCmdPar x e', fvs_e) }
+        ; return (HsCmdPar x lpar e' rpar, fvs_e) }
 
 rnCmd (HsCmdCase _ expr matches)
   = do { (new_expr, e_fvs) <- rnLExpr expr
@@ -835,7 +835,7 @@ methodNamesCmd (HsCmdArrApp _ _arrow _arg HsHigherOrderApp _rtl)
   = unitFV appAName
 methodNamesCmd (HsCmdArrForm {}) = emptyFVs
 
-methodNamesCmd (HsCmdPar _ c) = methodNamesLCmd c
+methodNamesCmd (HsCmdPar _ _ c _) = methodNamesLCmd c
 
 methodNamesCmd (HsCmdIf _ _ _ c1 c2)
   = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
@@ -2145,7 +2145,7 @@ isStrictPattern lpat =
     VarPat{}        -> False
     LazyPat{}       -> False
     AsPat _ _ p     -> isStrictPattern p
-    ParPat _ p      -> isStrictPattern p
+    ParPat _ _ p _  -> isStrictPattern p
     ViewPat _ _ p   -> isStrictPattern p
     SigPat _ p _    -> isStrictPattern p
     BangPat{}       -> True
@@ -2279,13 +2279,13 @@ needJoin _monad_names stmts = (True, stmts)
 isReturnApp :: MonadNames
             -> LHsExpr GhcRn
             -> Maybe (LHsExpr GhcRn, Bool)
-isReturnApp monad_names (L _ (HsPar _ expr)) = isReturnApp monad_names expr
+isReturnApp monad_names (L _ (HsPar _ _ expr _)) = isReturnApp monad_names expr
 isReturnApp monad_names (L _ e) = case e of
   OpApp _ l op r | is_return l, is_dollar op -> Just (r, True)
   HsApp _ f arg  | is_return f               -> Just (arg, False)
   _otherwise -> Nothing
  where
-  is_var f (L _ (HsPar _ e)) = is_var f e
+  is_var f (L _ (HsPar _ _ e _)) = is_var f e
   is_var f (L _ (HsAppType _ e _)) = is_var f e
   is_var f (L _ (HsVar _ (L _ r))) = f r
        -- TODO: I don't know how to get this right for rebindable syntax
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 5e0723d4cb..7a63d73fee 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -400,8 +400,9 @@ rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
 
 rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
 rnPatAndThen _  (WildPat _)   = return (WildPat noExtField)
-rnPatAndThen mk (ParPat x pat)  = do { pat' <- rnLPatAndThen mk pat
-                                     ; return (ParPat x pat') }
+rnPatAndThen mk (ParPat x lpar pat rpar) =
+  do { pat' <- rnLPatAndThen mk pat
+     ; return (ParPat x lpar pat' rpar) }
 rnPatAndThen mk (LazyPat _ pat) = do { pat' <- rnLPatAndThen mk pat
                                      ; return (LazyPat noExtField pat') }
 rnPatAndThen mk (BangPat _ pat) = do { pat' <- rnLPatAndThen mk pat
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index d8bead6645..ab17333c0e 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -450,11 +450,11 @@ rnSpliceExpr splice
                 runRnSplice UntypedExpSplice runMetaE ppr rn_splice
            ; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
              -- See Note [Delaying modFinalizers in untyped splices].
-           ; return ( HsPar noAnn $ HsSpliceE noAnn
-                            . HsSpliced noExtField (ThModFinalizers mod_finalizers)
-                            . HsSplicedExpr <$>
-                            lexpr3
-                    , fvs)
+           ; let e =  HsSpliceE noAnn
+                    . HsSpliced noExtField (ThModFinalizers mod_finalizers)
+                    . HsSplicedExpr
+                        <$> lexpr3
+           ; return (gHsPar e, fvs)
            }
 
 {- Note [Running splices in the Renamer]
@@ -694,12 +694,11 @@ rnSplicePat splice
            ; (pat, mod_finalizers) <-
                 runRnSplice UntypedPatSplice runMetaP ppr rn_splice
              -- See Note [Delaying modFinalizers in untyped splices].
-           ; return ( Left $ ParPat noAnn $ ((SplicePat noExtField)
-                              . HsSpliced noExtField (ThModFinalizers mod_finalizers)
-                              . HsSplicedPat)  `mapLoc`
-                              pat
-                    , emptyFVs
-                    ) }
+           ; let p =  SplicePat noExtField
+                    . HsSpliced noExtField (ThModFinalizers mod_finalizers)
+                    . HsSplicedPat
+                        <$> pat
+           ; return (Left $ gParPat p, emptyFVs) }
               -- Wrap the result of the quasi-quoter in parens so that we don't
               -- lose the outermost location set by runQuasiQuote (#7918)
 
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 7ab31322c9..d6bf3ae129 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -145,9 +145,9 @@ tcCmd env (L loc cmd) res_ty
         ; return (L loc cmd') }
 
 tc_cmd :: CmdEnv -> HsCmd GhcRn  -> CmdType -> TcM (HsCmd GhcTc)
-tc_cmd env (HsCmdPar x cmd) res_ty
+tc_cmd env (HsCmdPar x lpar cmd rpar) res_ty
   = do  { cmd' <- tcCmd env cmd res_ty
-        ; return (HsCmdPar x cmd') }
+        ; return (HsCmdPar x lpar cmd' rpar) }
 
 tc_cmd env (HsCmdLet x binds (L body_loc body)) res_ty
   = do  { (binds', body') <- tcLocalBinds binds         $
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 94a36def48..992c00428e 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -221,9 +221,9 @@ tcExpr e@(HsLit x lit) res_ty
   = do { let lit_ty = hsLitType lit
        ; tcWrapResult e (HsLit x (convertLit lit)) lit_ty res_ty }
 
-tcExpr (HsPar x expr) res_ty
+tcExpr (HsPar x lpar expr rpar) res_ty
   = do { expr' <- tcMonoExprNC expr res_ty
-       ; return (HsPar x expr') }
+       ; return (HsPar x lpar expr' rpar) }
 
 tcExpr (HsPragE x prag expr) res_ty
   = do { expr' <- tcMonoExpr expr res_ty
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index d018332e80..dd46120ea5 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -243,7 +243,7 @@ splitHsApps :: HsExpr GhcRn
 -- See Note [splitHsApps]
 splitHsApps e = go e (top_ctxt 0 e) []
   where
-    top_ctxt n (HsPar _ fun)               = top_lctxt n fun
+    top_ctxt n (HsPar _ _ fun _)           = top_lctxt n fun
     top_ctxt n (HsPragE _ _ fun)           = top_lctxt n fun
     top_ctxt n (HsAppType _ fun _)         = top_lctxt (n+1) fun
     top_ctxt n (HsApp _ fun _)             = top_lctxt (n+1) fun
@@ -254,7 +254,7 @@ splitHsApps e = go e (top_ctxt 0 e) []
 
     go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn]
        -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
-    go (HsPar _     (L l fun))    ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt)   : args)
+    go (HsPar _ _ (L l fun) _)    ctxt args = go fun (set l ctxt) (EWrap (EPar ctxt)   : args)
     go (HsPragE _ p (L l fun))    ctxt args = go fun (set l ctxt) (EPrag      ctxt p   : args)
     go (HsAppType _ (L l fun) ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt ty  : args)
     go (HsApp _ (L l fun) arg)    ctxt args = go fun (dec l ctxt) (mkEValArg  ctxt arg : args)
@@ -292,7 +292,7 @@ rebuildHsApps fun ctxt (arg : args)
       EPrag ctxt' p
         -> rebuildHsApps (HsPragE noExtField p lfun) ctxt' args
       EWrap (EPar ctxt')
-        -> rebuildHsApps (HsPar noAnn lfun) ctxt' args
+        -> rebuildHsApps (gHsPar lfun) ctxt' args
       EWrap (EExpand orig)
         -> rebuildHsApps (XExpr (ExpansionExpr (HsExpanded orig fun))) ctxt args
       EWrap (EHsWrap wrap)
@@ -469,7 +469,7 @@ tcInferRecSelId (FieldOcc sel_name lbl)
 -- outermost constructor ignoring parentheses.
 obviousSig :: HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
 obviousSig (ExprWithTySig _ _ ty) = Just ty
-obviousSig (HsPar _ p)            = obviousSig (unLoc p)
+obviousSig (HsPar _ _ p _)        = obviousSig (unLoc p)
 obviousSig (HsPragE _ _ p)        = obviousSig (unLoc p)
 obviousSig _                      = Nothing
 
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 536baa278f..b401b4db60 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -363,9 +363,9 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
         ; pat_ty <- readExpType (scaledThing pat_ty)
         ; return (mkHsWrapPat (wrap <.> mult_wrap) (VarPat x (L l id)) pat_ty, res) }
 
-  ParPat x pat -> do
+  ParPat x lpar pat rpar -> do
         { (pat', res) <- tc_lpat pat_ty penv pat thing_inside
-        ; return (ParPat x pat', res) }
+        ; return (ParPat x lpar pat' rpar, res) }
 
   BangPat x pat -> do
         { (pat', res) <- tc_lpat pat_ty penv pat thing_inside
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index d659b4e8d9..5f511d539c 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -1023,7 +1023,7 @@ tcPatToExpr name args pat = go pat
         = return $ HsVar noExtField (L l var)
         | otherwise
         = Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym")
-    go1 (ParPat _ pat)          = fmap (HsPar noAnn) $ go pat
+    go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat
     go1 p@(ListPat reb pats)
       | Nothing <- reb = do { exprs <- mapM go pats
                             ; return $ ExplicitList noExtField exprs }
@@ -1201,7 +1201,7 @@ tcCollectEx pat = go pat
     go1 :: Pat GhcTc -> ([TyVar], [EvVar])
     go1 (LazyPat _ p)      = go p
     go1 (AsPat _ _ p)      = go p
-    go1 (ParPat _ p)       = go p
+    go1 (ParPat _ _ p _)   = go p
     go1 (BangPat _ p)      = go p
     go1 (ListPat _ ps)     = mergeMany . map go $ ps
     go1 (TuplePat _ ps _)  = mergeMany . map go $ ps
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 44ade07fcb..6a67a33e5b 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -509,7 +509,7 @@ exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1
 exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1
 exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
 exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
-exprCtOrigin (HsPar _ e)          = lexprCtOrigin e
+exprCtOrigin (HsPar _ _ e _)      = lexprCtOrigin e
 exprCtOrigin (HsProjection _ _)   = SectionOrigin
 exprCtOrigin (SectionL _ _ _)     = SectionOrigin
 exprCtOrigin (SectionR _ _ _)     = SectionOrigin
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index a11fe41f6a..9207e1805f 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -112,7 +112,7 @@ hsLPatType :: LPat GhcTc -> Type
 hsLPatType (L _ p) = hsPatType p
 
 hsPatType :: Pat GhcTc -> Type
-hsPatType (ParPat _ pat)                = hsLPatType pat
+hsPatType (ParPat _ _ pat _)            = hsLPatType pat
 hsPatType (WildPat ty)                  = ty
 hsPatType (VarPat _ lvar)               = idType (unLoc lvar)
 hsPatType (BangPat _ pat)               = hsLPatType pat
@@ -875,9 +875,9 @@ zonkExpr env (NegApp x expr op)
        new_expr <- zonkLExpr env' expr
        return (NegApp x new_expr new_op)
 
-zonkExpr env (HsPar x e)
+zonkExpr env (HsPar x lpar e rpar)
   = do new_e <- zonkLExpr env e
-       return (HsPar x new_e)
+       return (HsPar x lpar new_e rpar)
 
 zonkExpr env (SectionL x expr op)
   = do new_expr <- zonkLExpr env expr
@@ -1081,9 +1081,9 @@ zonkCmd env (HsCmdLam x matches)
   = do new_matches <- zonkMatchGroup env zonkLCmd matches
        return (HsCmdLam x new_matches)
 
-zonkCmd env (HsCmdPar x c)
+zonkCmd env (HsCmdPar x lpar c rpar)
   = do new_c <- zonkLCmd env c
-       return (HsCmdPar x new_c)
+       return (HsCmdPar x lpar new_c rpar)
 
 zonkCmd env (HsCmdCase x expr ms)
   = do new_expr <- zonkLExpr env expr
@@ -1412,9 +1412,9 @@ zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
 zonkPat env pat = wrapLocSndMA (zonk_pat env) pat
 
 zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
-zonk_pat env (ParPat x p)
+zonk_pat env (ParPat x lpar p rpar)
   = do  { (env', p') <- zonkPat env p
-        ; return (env', ParPat x p') }
+        ; return (env', ParPat x lpar p' rpar) }
 
 zonk_pat env (WildPat ty)
   = do  { ty' <- zonkTcTypeToTypeX env ty
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index f2f9695109..7aa9b73eb2 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -933,7 +933,7 @@ cvtl e = wrapLA (cvt e)
         go cvt_lit mk_expr is_compound_lit = do
           l' <- cvt_lit l
           let e' = mk_expr l'
-          return $ if is_compound_lit l' then HsPar noAnn (noLocA e') else e'
+          return $ if is_compound_lit l' then gHsPar (noLocA e') else e'
     cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
                                    ; return $ HsApp noComments (mkLHsPar x')
                                                           (mkLHsPar y')}
@@ -998,7 +998,7 @@ cvtl e = wrapLA (cvt e)
          ; y' <- cvtl y
          ; let px = parenthesizeHsExpr opPrec x'
                py = parenthesizeHsExpr opPrec y'
-         ; wrapParLA (HsPar noAnn)
+         ; wrapParLA gHsPar
            $ OpApp noAnn px s' py }
            -- Parenthesise both arguments and result,
            -- to ensure this operator application does
@@ -1006,17 +1006,17 @@ cvtl e = wrapLA (cvt e)
            -- See Note [Operator association]
     cvt (InfixE Nothing  s (Just y)) = ensureValidOpExp s $
                                        do { s' <- cvtl s; y' <- cvtl y
-                                          ; wrapParLA (HsPar noAnn) $
+                                          ; wrapParLA gHsPar $
                                                           SectionR noComments s' y' }
                                             -- See Note [Sections in HsSyn] in GHC.Hs.Expr
     cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $
                                        do { x' <- cvtl x; s' <- cvtl s
-                                          ; wrapParLA (HsPar noAnn) $
+                                          ; wrapParLA gHsPar $
                                                           SectionL noComments x' s' }
 
     cvt (InfixE Nothing  s Nothing ) = ensureValidOpExp s $
                                        do { s' <- cvtl s
-                                          ; return $ HsPar noAnn s' }
+                                          ; return $ gHsPar s' }
                                        -- Can I indicate this is an infix thing?
                                        -- Note [Dropping constructors]
 
@@ -1027,7 +1027,7 @@ cvtl e = wrapLA (cvt e)
                                             _ -> mkLHsPar x'
                               ; cvtOpApp x'' s y } --  Note [Converting UInfix]
 
-    cvt (ParensE e)      = do { e' <- cvtl e; return $ HsPar noAnn e' }
+    cvt (ParensE e)      = do { e' <- cvtl e; return $ gHsPar e' }
     cvt (SigE e t)       = do { e' <- cvtl e; t' <- cvtSigType t
                               ; let pe = parenthesizeHsExpr sigPrec e'
                               ; return $ ExprWithTySig noAnn pe (mkHsWildCardBndrs t') }
@@ -1208,7 +1208,7 @@ cvtMatch :: HsMatchContext GhcPs
 cvtMatch ctxt (TH.Match p body decs)
   = do  { p' <- cvtPat p
         ; let lp = case p' of
-                     (L loc SigPat{}) -> L loc (ParPat noAnn p') -- #14875
+                     (L loc SigPat{}) -> L loc (gParPat p') -- #14875
                      _                -> p'
         ; g' <- cvtGuard body
         ; decs' <- cvtLocalDecs (text "a where clause") decs
@@ -1322,7 +1322,7 @@ cvtp (ConP s ts ps)    = do { s' <- cNameN s
                                 }
                             }
 cvtp (InfixP p1 s p2)  = do { s' <- cNameN s; p1' <- cvtPat p1; p2' <- cvtPat p2
-                            ; wrapParLA (ParPat noAnn) $
+                            ; wrapParLA gParPat $
                               ConPat
                                 { pat_con_ext = noAnn
                                 , pat_con = s'
@@ -1336,7 +1336,7 @@ cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Co
 cvtp (ParensP p)       = do { p' <- cvtPat p;
                             ; case unLoc p' of  -- may be wrapped ConPatIn
                                 ParPat {} -> return $ unLoc p'
-                                _         -> return $ ParPat noAnn p' }
+                                _         -> return $ gParPat p' }
 cvtp (TildeP p)        = do { p' <- cvtPat p; return $ LazyPat noAnn p' }
 cvtp (BangP p)         = do { p' <- cvtPat p; return $ BangPat noAnn p' }
 cvtp (TH.AsP s p)      = do { s' <- vNameN s; p' <- cvtPat p
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 6f5150a1b4..b4d7b24dea 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -404,7 +404,9 @@ data HsExpr p
 
   -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
   | HsPar       (XPar p)
+               !(LHsToken "(" p)
                 (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
+               !(LHsToken ")" p)
 
   | SectionL    (XSectionL p)
                 (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
@@ -928,7 +930,9 @@ data HsCmd id
        -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
 
   | HsCmdPar    (XCmdPar id)
+               !(LHsToken "(" id)
                 (LHsCmd id)                     -- parenthesised command
+               !(LHsToken ")" id)
     -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
     --             'GHC.Parser.Annotation.AnnClose' @')'@
 
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index f414968a6e..2f9b9d7583 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveDataTypeable      #-}
 {-# LANGUAGE EmptyCase               #-}
 {-# LANGUAGE EmptyDataDeriving       #-}
+{-# LANGUAGE StandaloneDeriving      #-}
 {-# LANGUAGE FlexibleContexts        #-}
 {-# LANGUAGE FlexibleInstances       #-}
 {-# LANGUAGE GADTs                   #-}
@@ -22,6 +23,7 @@ module Language.Haskell.Syntax.Extension where
 
 import GHC.Prelude
 
+import GHC.TypeLits (Symbol, KnownSymbol)
 import Data.Data hiding ( Fixity )
 import Data.Kind (Type)
 import GHC.Utils.Outputable
@@ -693,3 +695,14 @@ type family NoGhcTc (p :: Type)
 -- =====================================================================
 -- End of Type family definitions
 -- =====================================================================
+
+
+
+-- =====================================================================
+-- Token information
+
+type LHsToken tok p = XRec p (HsToken tok)
+
+data HsToken (tok :: Symbol) = HsTok
+
+deriving instance KnownSymbol tok => Data (HsToken tok)
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index c7829d833c..75dc7ddd00 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                       -- in module Language.Haskell.Syntax.Extension
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-
 (c) The University of Glasgow 2006
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
@@ -74,7 +75,9 @@ data Pat p
     -- For details on above see note [exact print annotations] in GHC.Parser.Annotation
 
   | ParPat      (XParPat p)
+               !(LHsToken "(" p)
                 (LPat p)                -- ^ Parenthesised pattern
+               !(LHsToken ")" p)
                                         -- See Note [Parens in HsSyn] in GHC.Hs.Expr
     -- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
     --                                    'GHC.Parser.Annotation.AnnClose' @')'@
diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
index 5302fd7e7b..f8c11891ba 100644
--- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
@@ -108,6 +108,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -136,7 +139,10 @@
                   []))
                 (HsStringPrim
                  (NoSourceText)
-                 "T")))))))))
+                 "T")))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
         (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsLit
@@ -262,6 +268,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -290,7 +299,10 @@
                   []))
                 (HsStringPrim
                  (NoSourceText)
-                 "'MkT")))))))))
+                 "'MkT")))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
         (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsLit
@@ -416,6 +428,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -444,7 +459,10 @@
                   []))
                 (HsStringPrim
                  (NoSourceText)
-                 "Peano")))))))))
+                 "Peano")))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
         (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsLit
@@ -570,6 +588,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -598,7 +619,10 @@
                   []))
                 (HsStringPrim
                  (NoSourceText)
-                 "'Zero")))))))))
+                 "'Zero")))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
         (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsLit
@@ -724,6 +748,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -752,7 +779,10 @@
                   []))
                 (HsStringPrim
                  (NoSourceText)
-                 "'Succ")))))))))
+                 "'Succ")))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
         (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsLit
@@ -1160,6 +1190,9 @@
        (HsPar
         (EpAnnNotUsed)
         (L
+         (EpAnnNotUsed)
+         (HsTok))
+        (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsApp
           (EpAnn
@@ -1205,6 +1238,9 @@
            (HsPar
             (EpAnnNotUsed)
             (L
+             (EpAnnNotUsed)
+             (HsTok))
+            (L
              (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
              (HsApp
               (EpAnn
@@ -1250,6 +1286,9 @@
                (HsPar
                 (EpAnnNotUsed)
                 (L
+                 (EpAnnNotUsed)
+                 (HsTok))
+                (L
                  (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
                  (HsApp
                   (EpAnn
@@ -1303,7 +1342,16 @@
                        (ConLikeTc
                         ({abstract:ConLike})
                         []
-                        []))))))))))))))))))))))
+                        []))))))))
+                (L
+                 (EpAnnNotUsed)
+                 (HsTok))))))
+            (L
+             (EpAnnNotUsed)
+             (HsTok))))))
+        (L
+         (EpAnnNotUsed)
+         (HsTok))))))))
  ,(L
    (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
    (VarBind
@@ -1394,6 +1442,9 @@
          (HsPar
           (EpAnnNotUsed)
           (L
+           (EpAnnNotUsed)
+           (HsTok))
+          (L
            (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
            (HsApp
             (EpAnn
@@ -1422,12 +1473,18 @@
                 []))
               (HsStringPrim
                (NoSourceText)
-               "main")))))))))
+               "main")))))
+          (L
+           (EpAnnNotUsed)
+           (HsTok))))))
       (L
        (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
        (HsPar
         (EpAnnNotUsed)
         (L
+         (EpAnnNotUsed)
+         (HsTok))
+        (L
          (SrcSpanAnn (EpAnnNotUsed) { <no location info> })
          (HsApp
           (EpAnn
@@ -1456,7 +1513,10 @@
               []))
             (HsStringPrim
              (NoSourceText)
-             "DumpTypecheckedAst")))))))))))
+             "DumpTypecheckedAst")))))
+        (L
+         (EpAnnNotUsed)
+         (HsTok))))))))
  ,(L
    (SrcSpanAnn (EpAnnNotUsed) { DumpTypecheckedAst.hs:19:1-23 })
    (AbsBinds
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 9341c7ec1c..3a8cd8d95f 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -54,7 +54,7 @@ typecheckPlugin [name, "typecheck"] _ tc
 typecheckPlugin _ _ tc = return tc
 
 metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
-metaPlugin' [name, "meta"] (L l (HsPar x (L _ (XExpr (WrapExpr (HsWrap w (HsApp noExt (L _ (HsVar _ (L _ id))) e)))))))
+metaPlugin' [name, "meta"] (L l (HsPar _ _ (L _ (XExpr (WrapExpr (HsWrap w (HsApp noExt (L _ (HsVar _ (L _ id))) e))))) _))
   | occNameString (getOccName id) == name
   = return (L l (XExpr (WrapExpr (HsWrap w (unLoc e)))))
 -- The test should always match this first case. If the desugaring changes
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index b4e53efeb6..8786e03fd8 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -9,6 +9,8 @@
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE ViewPatterns         #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
 
 module ExactPrint
   (
@@ -31,6 +33,7 @@ import GHC.Utils.Outputable hiding ( (<>) )
 import GHC.Unit.Module.Warnings
 import GHC.Utils.Misc
 import GHC.Utils.Panic
+import GHC.TypeLits
 
 import Control.Monad.Identity
 import Control.Monad.RWS
@@ -585,6 +588,13 @@ markKw (AddEpAnn kw ss) = markKwA kw ss
 markKwA :: AnnKeywordId -> EpaLocation -> EPP ()
 markKwA kw aa = printStringAtAA aa (keywordToString (G kw))
 
+markToken :: forall tok. KnownSymbol tok => LHsToken tok GhcPs -> EPP ()
+markToken (L EpAnnNotUsed _) = return ()
+markToken (L (EpAnn (Anchor a a_op) _ _) _) = printStringAtAA aa (symbolVal (Proxy @tok))
+  where aa = case a_op of
+               UnchangedAnchor -> EpaSpan a
+               MovedAnchor dp  -> EpaDelta dp
+
 -- ---------------------------------------------------------------------
 
 markAnnList :: Bool -> EpAnn AnnList -> EPP () -> EPP ()
@@ -1791,7 +1801,7 @@ instance ExactPrint (HsExpr GhcPs) where
   getAnnotationEntry (HsAppType _ _ _)            = NoEntryVal
   getAnnotationEntry (OpApp an _ _ _)             = fromAnn an
   getAnnotationEntry (NegApp an _ _)              = fromAnn an
-  getAnnotationEntry (HsPar an _)                 = fromAnn an
+  getAnnotationEntry (HsPar an _ _ _)             = fromAnn an
   getAnnotationEntry (SectionL an _ _)            = fromAnn an
   getAnnotationEntry (SectionR an _ _)            = fromAnn an
   getAnnotationEntry (ExplicitTuple an _ _)       = fromAnn an
@@ -1876,11 +1886,11 @@ instance ExactPrint (HsExpr GhcPs) where
     markEpAnn an AnnMinus
     markAnnotated e
 
-  exact (HsPar an e) = do
-    markOpeningParen an
+  exact (HsPar _an lpar e rpar) = do
+    markToken lpar
     markAnnotated e
     debugM $ "HsPar closing paren"
-    markClosingParen an
+    markToken rpar
     debugM $ "HsPar done"
 
   -- exact (SectionL an expr op) = do
@@ -2289,7 +2299,7 @@ instance ExactPrint (HsCmd GhcPs) where
   getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an
   getAnnotationEntry (HsCmdApp an _ _ )         = fromAnn an
   getAnnotationEntry (HsCmdLam {})              = NoEntryVal
-  getAnnotationEntry (HsCmdPar an _)            = fromAnn an
+  getAnnotationEntry (HsCmdPar an _ _ _)        = fromAnn an
   getAnnotationEntry (HsCmdCase an _ _)         = fromAnn an
   getAnnotationEntry (HsCmdLamCase an _)        = fromAnn an
   getAnnotationEntry (HsCmdIf an _ _ _ _)       = fromAnn an
@@ -2371,10 +2381,10 @@ instance ExactPrint (HsCmd GhcPs) where
 --   markAST l (GHC.HsCmdLam _ match) = do
 --     setContext (Set.singleton LambdaExpr) $ do markMatchGroup l match
 
-  exact (HsCmdPar an e) = do
-    markOpeningParen an
+  exact (HsCmdPar _an lpar e rpar) = do
+    markToken lpar
     markAnnotated e
-    markClosingParen an
+    markToken rpar
 
   exact (HsCmdCase an e alts) = do
     markAnnKw an hsCaseAnnCase AnnCase
@@ -3618,7 +3628,7 @@ instance ExactPrint (Pat GhcPs) where
   getAnnotationEntry (VarPat _ _)             = NoEntryVal
   getAnnotationEntry (LazyPat an _)           = fromAnn an
   getAnnotationEntry (AsPat an _ _)           = fromAnn an
-  getAnnotationEntry (ParPat an _)            = fromAnn an
+  getAnnotationEntry (ParPat an _ _ _)        = fromAnn an
   getAnnotationEntry (BangPat an _)           = fromAnn an
   getAnnotationEntry (ListPat an _)           = fromAnn an
   getAnnotationEntry (TuplePat an _ _)        = fromAnn an
@@ -3647,10 +3657,10 @@ instance ExactPrint (Pat GhcPs) where
     markAnnotated n
     markEpAnn an AnnAt
     markAnnotated pat
-  exact (ParPat an pat) = do
-    markAnnKw an ap_open AnnOpenP
+  exact (ParPat _an lpar pat rpar) = do
+    markToken lpar
     markAnnotated pat
-    markAnnKw an ap_close AnnCloseP
+    markToken rpar
 
   exact (BangPat an pat) = do
     markEpAnn an AnnBang
diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs
index 044af3c784..0e40a14d39 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -1135,11 +1135,11 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
         return (L ll (HsLet x' binds' ex'))
 
   -- TODO: does this make sense? Especially as no hsDecls for HsPar
-  replaceDecls (L l (HsPar x e)) newDecls
+  replaceDecls (L l (HsPar x lpar e rpar)) newDecls
     = do
         logTr "replaceDecls HsPar"
         e' <- replaceDecls e newDecls
-        return (L l (HsPar x e'))
+        return (L l (HsPar x lpar e' rpar))
   replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old
 
 -- ---------------------------------------------------------------------