From fe6d97dd202ed9fd84a146dd2cd2cea7fc91e825 Mon Sep 17 00:00:00 2001
From: Vladislav Zavialov <vlad.z.4096@gmail.com>
Date: Tue, 12 Dec 2023 20:38:49 +0300
Subject: [PATCH] EPA: Move tokens into GhcPs extension fields (#23447)
Summary of changes
* Remove Language.Haskell.Syntax.Concrete
* Move all tokens into GhcPs extension fields (LHsToken -> EpToken)
* Create new TTG extension fields as needed
* Drop the MultAnn wrapper
Updates the haddock submodule.
Co-authored-by: Alan Zimmerman <alan.zimm@gmail.com>
---
compiler/GHC/Driver/Backpack.hs | 2 +-
compiler/GHC/Hs.hs | 4 +-
compiler/GHC/Hs/Binds.hs | 35 +-
compiler/GHC/Hs/Decls.hs | 30 +-
compiler/GHC/Hs/Expr.hs | 46 ++-
compiler/GHC/Hs/Extension.hs | 24 +-
compiler/GHC/Hs/Instances.hs | 9 -
compiler/GHC/Hs/Pat.hs | 46 ++-
compiler/GHC/Hs/Syn/Type.hs | 14 +-
compiler/GHC/Hs/Type.hs | 108 ++++--
compiler/GHC/Hs/Utils.hs | 54 +--
compiler/GHC/HsToCore/Arrows.hs | 4 +-
compiler/GHC/HsToCore/Docs.hs | 4 +-
compiler/GHC/HsToCore/Expr.hs | 13 +-
compiler/GHC/HsToCore/Match.hs | 14 +-
compiler/GHC/HsToCore/Match/Literal.hs | 4 +-
compiler/GHC/HsToCore/Pmc/Desugar.hs | 6 +-
compiler/GHC/HsToCore/Quote.hs | 45 ++-
compiler/GHC/HsToCore/Ticks.hs | 20 +-
compiler/GHC/HsToCore/Utils.hs | 16 +-
compiler/GHC/Iface/Ext/Ast.hs | 40 +--
compiler/GHC/Parser.y | 77 ++---
compiler/GHC/Parser/Annotation.hs | 74 +++-
compiler/GHC/Parser/PostProcess.hs | 118 ++++---
compiler/GHC/Parser/PostProcess/Haddock.hs | 60 ++--
compiler/GHC/Parser/Types.hs | 4 +-
compiler/GHC/Rename/Bind.hs | 19 +-
compiler/GHC/Rename/Expr.hs | 48 +--
compiler/GHC/Rename/HsType.hs | 39 +--
compiler/GHC/Rename/Module.hs | 29 +-
compiler/GHC/Rename/Pat.hs | 29 +-
compiler/GHC/Rename/Utils.hs | 2 +-
compiler/GHC/Tc/Deriv/Generate.hs | 4 +-
compiler/GHC/Tc/Gen/App.hs | 20 +-
compiler/GHC/Tc/Gen/Arrow.hs | 8 +-
compiler/GHC/Tc/Gen/Bind.hs | 24 +-
compiler/GHC/Tc/Gen/Expr.hs | 12 +-
compiler/GHC/Tc/Gen/Head.hs | 21 +-
compiler/GHC/Tc/Gen/HsType.hs | 22 +-
compiler/GHC/Tc/Gen/Pat.hs | 28 +-
compiler/GHC/Tc/Gen/Sig.hs | 2 +-
compiler/GHC/Tc/TyCl.hs | 10 +-
compiler/GHC/Tc/TyCl/Instance.hs | 2 +-
compiler/GHC/Tc/TyCl/PatSyn.hs | 8 +-
compiler/GHC/Tc/Types/Origin.hs | 6 +-
compiler/GHC/Tc/Zonk/Type.hs | 47 ++-
compiler/GHC/ThToHs.hs | 54 +--
compiler/GHC/Unit/Module/Warnings.hs | 7 +-
compiler/Language/Haskell/Syntax.hs | 2 -
compiler/Language/Haskell/Syntax/Binds.hs | 44 +--
compiler/Language/Haskell/Syntax/Concrete.hs | 64 ----
compiler/Language/Haskell/Syntax/Decls.hs | 22 +-
compiler/Language/Haskell/Syntax/Expr.hs | 11 -
compiler/Language/Haskell/Syntax/Pat.hs | 14 +-
compiler/Language/Haskell/Syntax/Type.hs | 52 ++-
compiler/ghc.cabal.in | 1 -
.../tests/count-deps/CountDepsAst.stdout | 1 -
.../tests/count-deps/CountDepsParser.stdout | 1 -
.../tests/ghc-api/exactprint/T22919.stderr | 5 +-
.../tests/ghc-api/exactprint/Test20239.stderr | 42 +--
.../ghc-api/exactprint/ZeroWidthSemi.stderr | 11 +-
.../should_compile_flag_haddock/T17544.stderr | 325 +++++++++---------
.../T17544_kw.stderr | 56 +--
testsuite/tests/module/mod185.stderr | 2 +-
.../should_compile/DumpParsedAst.stderr | 158 ++++-----
.../DumpParsedAstComments.stderr | 29 +-
.../should_compile/DumpRenamedAst.stderr | 147 +++-----
.../parser/should_compile/DumpSemis.stderr | 41 +--
.../should_compile/DumpTypecheckedAst.stderr | 136 +-------
.../parser/should_compile/KindSigs.stderr | 29 +-
.../tests/parser/should_compile/T14189.stderr | 26 +-
.../tests/parser/should_compile/T15323.stderr | 24 +-
.../tests/parser/should_compile/T20452.stderr | 58 ++--
.../tests/parser/should_compile/T20718.stderr | 20 +-
.../parser/should_compile/T20718b.stderr | 14 +-
.../tests/parser/should_compile/T20846.stderr | 2 +-
.../should_compile/T23315/T23315.stderr | 2 +-
.../tests/perf/compiler/hard_hole_fits.hs | 6 +-
.../tests/perf/compiler/hard_hole_fits.stderr | 28 +-
.../simple-plugin/Simple/RemovePlugin.hs | 2 +-
testsuite/tests/printer/T18791.stderr | 28 +-
testsuite/tests/printer/Test20297.stdout | 4 +-
utils/check-exact/ExactPrint.hs | 231 ++++++-------
utils/check-exact/Main.hs | 12 +-
utils/check-exact/Parsers.hs | 2 +-
utils/check-exact/Transform.hs | 18 +-
utils/check-exact/Utils.hs | 6 +-
utils/check-ppr/Main.hs | 12 +-
utils/haddock | 2 +-
89 files changed, 1428 insertions(+), 1574 deletions(-)
delete mode 100644 compiler/Language/Haskell/Syntax/Concrete.hs
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 416fe1659d8a..ee9a70271c4a 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -801,7 +801,7 @@ summariseRequirement pn mod_name = do
hpm_module = L loc (HsModule {
hsmodExt = XModulePs {
hsmodAnn = noAnn,
- hsmodLayout = NoLayoutInfo,
+ hsmodLayout = EpNoLayout,
hsmodDeprecMessage = Nothing,
hsmodHaddockModHeader = Nothing
},
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index ca4bee354371..3f049e326dd1 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -68,9 +68,9 @@ import Data.Data hiding ( Fixity )
data XModulePs
= XModulePs {
hsmodAnn :: EpAnn AnnsModule,
- hsmodLayout :: LayoutInfo GhcPs,
+ hsmodLayout :: EpLayout,
-- ^ Layout info for the module.
- -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo.
+ -- For incomplete modules (e.g. the output of parseHeader), it is EpNoLayout.
hsmodDeprecMessage :: Maybe (LWarningTxt GhcPs),
-- ^ reason\/explanation for warning/deprecation of this module
--
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 8ba92f8d2897..fe79411477c4 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -139,9 +139,29 @@ type instance XPSB (GhcPass idL) GhcTc = NameSet
type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = DataConCantHappen
-type instance XMultAnn GhcPs = NoExtField
-type instance XMultAnn GhcRn = NoExtField
-type instance XMultAnn GhcTc = Mult
+type instance XNoMultAnn GhcPs = NoExtField
+type instance XNoMultAnn GhcRn = NoExtField
+type instance XNoMultAnn GhcTc = Mult
+
+type instance XPct1Ann GhcPs = EpToken "%1"
+type instance XPct1Ann GhcRn = NoExtField
+type instance XPct1Ann GhcTc = Mult
+
+type instance XMultAnn GhcPs = EpToken "%"
+type instance XMultAnn GhcRn = NoExtField
+type instance XMultAnn GhcTc = Mult
+
+type instance XXMultAnn (GhcPass _) = DataConCantHappen
+
+setTcMultAnn :: Mult -> HsMultAnn GhcRn -> HsMultAnn GhcTc
+setTcMultAnn mult (HsPct1Ann _) = HsPct1Ann mult
+setTcMultAnn mult (HsMultAnn _ p) = HsMultAnn mult p
+setTcMultAnn mult (HsNoMultAnn _) = HsNoMultAnn mult
+
+getTcMultAnn :: HsMultAnn GhcTc -> Mult
+getTcMultAnn (HsPct1Ann mult) = mult
+getTcMultAnn (HsMultAnn mult _) = mult
+getTcMultAnn (HsNoMultAnn mult) = mult
-- ---------------------------------------------------------------------
@@ -516,12 +536,9 @@ plusHsValBinds _ _
-- Used to print, for instance, let bindings:
-- let %1 x = …
pprHsMultAnn :: forall id. OutputableBndrId id => HsMultAnn (GhcPass id) -> SDoc
-pprHsMultAnn HsNoMultAnn = empty
+pprHsMultAnn (HsNoMultAnn _) = empty
pprHsMultAnn (HsPct1Ann _) = text "%1"
-pprHsMultAnn (HsMultAnn _ p) = text"%" <> ppr p
-
-ppr_mult_ann :: forall id. OutputableBndrId id => MultAnn (GhcPass id) -> SDoc
-ppr_mult_ann = pprHsMultAnn . mult_ann
+pprHsMultAnn (HsMultAnn _ p) = text "%" <> ppr p
instance (OutputableBndrId pl, OutputableBndrId pr)
=> Outputable (HsBindLR (GhcPass pl) (GhcPass pr)) where
@@ -532,7 +549,7 @@ ppr_monobind :: forall idL idR.
=> HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
ppr_monobind (PatBind { pat_lhs = pat, pat_mult = mult_ann, pat_rhs = grhss })
- = ppr_mult_ann @idL mult_ann
+ = pprHsMultAnn @idL mult_ann
<+> pprPatBind pat grhss
ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
= sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 28e6541bfc04..079eea2b7f0c 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
@@ -351,9 +352,11 @@ data DataDeclRn = DataDeclRn
, tcdFVs :: NameSet }
deriving Data
-type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey DeclTag)
+type instance XClassDecl GhcPs =
+ ( EpAnn [AddEpAnn]
+ , EpLayout -- See Note [Class EpLayout]
+ , AnnSortKey DeclTag ) -- TODO:AZ:tidy up AnnSortKey
- -- TODO:AZ:tidy up AnnSortKey above
type instance XClassDecl GhcRn = NameSet -- FVs
type instance XClassDecl GhcTc = NameSet -- FVs
@@ -662,11 +665,24 @@ type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen
standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
-type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn]
-type instance XConDeclH98 (GhcPass _) = EpAnn [AddEpAnn]
+type instance XConDeclGADT GhcPs = (EpUniToken "::" "∷", EpAnn [AddEpAnn])
+type instance XConDeclGADT GhcRn = NoExtField
+type instance XConDeclGADT GhcTc = NoExtField
+
+type instance XConDeclH98 GhcPs = EpAnn [AddEpAnn]
+type instance XConDeclH98 GhcRn = NoExtField
+type instance XConDeclH98 GhcTc = NoExtField
type instance XXConDecl (GhcPass _) = DataConCantHappen
+type instance XPrefixConGADT (GhcPass _) = NoExtField
+
+type instance XRecConGADT GhcPs = EpUniToken "->" "→"
+type instance XRecConGADT GhcRn = NoExtField
+type instance XRecConGADT GhcTc = NoExtField
+
+type instance XXConDeclGADTDetails (GhcPass _) = DataConCantHappen
+
-- Codomain could be 'NonEmpty', but at the moment all users need a list.
getConNames :: ConDecl GhcRn -> [LocatedN Name]
getConNames ConDeclH98 {con_name = name} = [name]
@@ -682,7 +698,7 @@ getRecConArgs_maybe (ConDeclH98{con_args = args}) = case args of
InfixCon{} -> Nothing
getRecConArgs_maybe (ConDeclGADT{con_g_args = args}) = case args of
PrefixConGADT{} -> Nothing
- RecConGADT flds _ -> Just flds
+ RecConGADT _ flds -> Just flds
hsConDeclTheta :: Maybe (LHsContext (GhcPass p)) -> [LHsType (GhcPass p)]
hsConDeclTheta Nothing = []
@@ -771,8 +787,8 @@ pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs
<+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt,
sep (ppr_args args ++ [ppr res_ty]) ])
where
- ppr_args (PrefixConGADT args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args
- ppr_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields) <+> arrow]
+ ppr_args (PrefixConGADT _ args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args
+ ppr_args (RecConGADT _ fields) = [pprConDeclFields (unLoc fields) <+> arrow]
-- Display linear arrows as unrestricted with -XNoLinearTypes
-- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon)
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 1ed31c848fa4..b00c493e7d19 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -243,7 +243,7 @@ type instance XLitE (GhcPass _) = EpAnnCO
type instance XLam (GhcPass _) = EpAnn [AddEpAnn]
type instance XApp (GhcPass _) = EpAnnCO
-type instance XAppTypeE GhcPs = NoExtField
+type instance XAppTypeE GhcPs = EpToken "@"
type instance XAppTypeE GhcRn = NoExtField
type instance XAppTypeE GhcTc = Type
@@ -267,7 +267,9 @@ type instance XNegApp GhcPs = EpAnn [AddEpAnn]
type instance XNegApp GhcRn = NoExtField
type instance XNegApp GhcTc = NoExtField
-type instance XPar (GhcPass _) = EpAnnCO
+type instance XPar GhcPs = (EpToken "(", EpToken ")")
+type instance XPar GhcRn = NoExtField
+type instance XPar GhcTc = NoExtField
type instance XExplicitTuple GhcPs = EpAnn [AddEpAnn]
type instance XExplicitTuple GhcRn = NoExtField
@@ -289,7 +291,7 @@ type instance XMultiIf GhcPs = EpAnn [AddEpAnn]
type instance XMultiIf GhcRn = NoExtField
type instance XMultiIf GhcTc = Type
-type instance XLet GhcPs = EpAnnCO
+type instance XLet GhcPs = (EpToken "let", EpToken "in")
type instance XLet GhcRn = NoExtField
type instance XLet GhcTc = NoExtField
@@ -372,7 +374,7 @@ type instance XStatic GhcTc = (NameSet, Type)
-- Free variables and type of expression, this is stored for convenience as wiring in
-- StaticPtr is a bit tricky (see #20150)
-type instance XEmbTy GhcPs = NoExtField
+type instance XEmbTy GhcPs = EpToken "type"
type instance XEmbTy GhcRn = NoExtField
type instance XEmbTy GhcTc = DataConCantHappen
-- A free-standing HsEmbTy is an error.
@@ -539,7 +541,7 @@ ppr_expr (HsOverLabel _ s l) = char '#' <> case s of
SourceText src -> ftext src
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]
@@ -644,11 +646,11 @@ ppr_expr (HsMultiIf _ alts)
ppr_alt (L _ (XGRHS x)) = ppr x
-- special case: let ... in let ...
-ppr_expr (HsLet _ _ binds _ expr@(L _ (HsLet _ _ _ _ _)))
+ppr_expr (HsLet _ binds expr@(L _ (HsLet _ _ _)))
= sep [hang (text "let") 2 (hsep [pprBinds binds, text "in"]),
ppr_lexpr expr]
-ppr_expr (HsLet _ _ binds _ expr)
+ppr_expr (HsLet _ binds expr)
= sep [hang (text "let") 2 (pprBinds binds),
hang (text "in") 2 (ppr expr)]
@@ -718,7 +720,7 @@ ppr_expr (HsProc _ pat (L _ (HsCmdTop _ cmd)))
ppr_expr (HsStatic _ e)
= hsep [text "static", ppr e]
-ppr_expr (HsEmbTy _ _ ty)
+ppr_expr (HsEmbTy _ ty)
= hsep [text "type", ppr ty]
ppr_expr (XExpr x) = case ghcPass @p of
@@ -776,7 +778,7 @@ ppr_apps :: (OutputableBndrId p)
-> SDoc
ppr_apps (HsApp _ (L _ fun) arg) args
= ppr_apps fun (Left arg : args)
-ppr_apps (HsAppType _ (L _ fun) _ arg) args
+ppr_apps (HsAppType _ (L _ fun) arg) args
= ppr_apps fun (Right arg : args)
ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))
where
@@ -872,8 +874,13 @@ hsExprNeedsParens prec = go
-- | Parenthesize an expression without token information
-gHsPar :: LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
-gHsPar e = HsPar noAnn noHsTok e noHsTok
+gHsPar :: forall p. IsPass p => LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
+gHsPar e = HsPar x e
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
-- | @'parenthesizeHsExpr' p e@ checks if @'hsExprNeedsParens' p e@ is true,
-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
@@ -883,11 +890,11 @@ parenthesizeHsExpr p le@(L loc e)
| 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
@@ -1122,7 +1129,10 @@ type instance XCmdArrForm GhcTc = NoExtField
type instance XCmdApp (GhcPass _) = EpAnnCO
type instance XCmdLam (GhcPass _) = NoExtField
-type instance XCmdPar (GhcPass _) = EpAnnCO
+
+type instance XCmdPar GhcPs = (EpToken "(", EpToken ")")
+type instance XCmdPar GhcRn = NoExtField
+type instance XCmdPar GhcTc = NoExtField
type instance XCmdCase GhcPs = EpAnn EpAnnHsCase
type instance XCmdCase GhcRn = NoExtField
@@ -1134,7 +1144,7 @@ type instance XCmdIf GhcPs = EpAnn AnnsIf
type instance XCmdIf GhcRn = NoExtField
type instance XCmdIf GhcTc = NoExtField
-type instance XCmdLet GhcPs = EpAnnCO
+type instance XCmdLet GhcPs = (EpToken "let", EpToken "in")
type instance XCmdLet GhcRn = NoExtField
type instance XCmdLet GhcTc = NoExtField
@@ -1235,7 +1245,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
@@ -1260,11 +1270,11 @@ ppr_cmd (HsCmdIf _ _ e ct ce)
nest 4 (ppr ce)]
-- special case: let ... in let ...
-ppr_cmd (HsCmdLet _ _ binds _ cmd@(L _ (HsCmdLet {})))
+ppr_cmd (HsCmdLet _ binds cmd@(L _ (HsCmdLet {})))
= sep [hang (text "let") 2 (hsep [pprBinds binds, text "in"]),
ppr_lcmd cmd]
-ppr_cmd (HsCmdLet _ _ binds _ cmd)
+ppr_cmd (HsCmdLet _ binds cmd)
= sep [hang (text "let") 2 (pprBinds binds),
hang (text "in") 2 (ppr cmd)]
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index 66c3d93929b0..895fb0cc1777 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -25,10 +25,7 @@ module GHC.Hs.Extension where
import GHC.Prelude
-import GHC.TypeLits (KnownSymbol, symbolVal)
-
import Data.Data hiding ( Fixity )
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Types.Name
import GHC.Types.Name.Reader
@@ -237,29 +234,10 @@ pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc
pprIfTc pp = case ghcPass @p of GhcTc -> pp
_ -> empty
-type instance Anno (HsToken tok) = TokenLocation
-
-noHsTok :: GenLocated TokenLocation (HsToken tok)
-noHsTok = L NoTokenLoc HsTok
-
-type instance Anno (HsUniToken tok utok) = TokenLocation
-
-noHsUniTok :: GenLocated TokenLocation (HsUniToken tok utok)
-noHsUniTok = L NoTokenLoc HsNormalTok
-
--- Outputable
instance Outputable NoExtField where
ppr _ = text "NoExtField"
instance Outputable DataConCantHappen where
- ppr = dataConCantHappen
-
-instance KnownSymbol tok => Outputable (HsToken tok) where
- ppr _ = text (symbolVal (Proxy :: Proxy tok))
-
-instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where
- ppr HsNormalTok = text (symbolVal (Proxy :: Proxy tok))
- ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok))
-
-deriving instance Typeable p => Data (LayoutInfo (GhcPass p))
+ ppr = dataConCantHappen
\ No newline at end of file
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 18289f499cd8..edbff6064fe8 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -108,10 +108,6 @@ deriving instance Data (HsPatSynDir GhcPs)
deriving instance Data (HsPatSynDir GhcRn)
deriving instance Data (HsPatSynDir GhcTc)
-deriving instance Data (MultAnn GhcPs)
-deriving instance Data (MultAnn GhcRn)
-deriving instance Data (MultAnn GhcTc)
-
deriving instance Data (HsMultAnn GhcPs)
deriving instance Data (HsMultAnn GhcRn)
deriving instance Data (HsMultAnn GhcTc)
@@ -520,11 +516,6 @@ deriving instance Data (HsTyLit GhcPs)
deriving instance Data (HsTyLit GhcRn)
deriving instance Data (HsTyLit GhcTc)
--- deriving instance Data (HsLinearArrowTokens p)
-deriving instance Data (HsLinearArrowTokens GhcPs)
-deriving instance Data (HsLinearArrowTokens GhcRn)
-deriving instance Data (HsLinearArrowTokens GhcTc)
-
-- deriving instance (DataIdLR p p) => Data (HsArrow p)
deriving instance Data (HsArrow GhcPs)
deriving instance Data (HsArrow GhcRn)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 7554f3612d00..b7f01d8d1dc5 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -8,6 +8,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
@@ -95,11 +96,13 @@ type instance XLazyPat GhcPs = EpAnn [AddEpAnn] -- For '~'
type instance XLazyPat GhcRn = NoExtField
type instance XLazyPat GhcTc = NoExtField
-type instance XAsPat GhcPs = EpAnnCO
+type instance XAsPat GhcPs = EpToken "@"
type instance XAsPat GhcRn = NoExtField
type instance XAsPat GhcTc = NoExtField
-type instance XParPat (GhcPass _) = EpAnnCO
+type instance XParPat GhcPs = (EpToken "(", EpToken ")")
+type instance XParPat GhcRn = NoExtField
+type instance XParPat GhcTc = NoExtField
type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!'
type instance XBangPat GhcRn = NoExtField
@@ -155,7 +158,7 @@ type instance XSigPat GhcPs = EpAnn [AddEpAnn]
type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
-type instance XEmbTyPat GhcPs = NoExtField
+type instance XEmbTyPat GhcPs = EpToken "type"
type instance XEmbTyPat GhcRn = NoExtField
type instance XEmbTyPat GhcTc = Type
@@ -172,6 +175,10 @@ type instance ConLikeP GhcPs = RdrName -- IdP GhcPs
type instance ConLikeP GhcRn = Name -- IdP GhcRn
type instance ConLikeP GhcTc = ConLike
+type instance XConPatTyArg GhcPs = EpToken "@"
+type instance XConPatTyArg GhcRn = NoExtField
+type instance XConPatTyArg GhcTc = NoExtField
+
type instance XHsFieldBind _ = EpAnn [AddEpAnn]
-- ---------------------------------------------------------------------
@@ -333,10 +340,10 @@ pprPat (VarPat _ lvar) = pprPatBndr (unLoc lvar)
pprPat (WildPat _) = char '_'
pprPat (LazyPat _ pat) = char '~' <> pprParendLPat appPrec pat
pprPat (BangPat _ pat) = char '!' <> pprParendLPat appPrec pat
-pprPat (AsPat _ name _ pat) = hcat [pprPrefixOcc (unLoc name), char '@',
+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
@@ -383,7 +390,7 @@ pprPat (ConPat { pat_con = con
, cpt_dicts = dicts
, cpt_binds = binds
} = ext
-pprPat (EmbTyPat _ toktype tp) = ppr toktype <+> ppr tp
+pprPat (EmbTyPat _ tp) = text "type" <+> ppr tp
pprPat (XPat ext) = case ghcPass @p of
GhcRn -> case ext of
@@ -477,7 +484,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
@@ -498,8 +505,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
@@ -560,8 +567,8 @@ isIrrefutableHsPat is_strict = goL
= isIrrefutableHsPat False p'
| otherwise = True
go (BangPat _ pat) = goL pat
- go (ParPat _ _ pat _) = goL pat
- go (AsPat _ _ _ pat) = goL pat
+ go (ParPat _ pat) = goL pat
+ go (AsPat _ _ pat) = goL pat
go (ViewPat _ _ pat) = goL pat
go (SigPat _ pat _) = goL pat
go (TuplePat _ pats _) = all goL pats
@@ -608,7 +615,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
@@ -634,7 +641,7 @@ isBoringHsPat = goL
VarPat {} -> True
LazyPat {} -> True
BangPat _ pat -> goL pat
- ParPat _ _ pat _ -> goL pat
+ ParPat _ pat -> goL pat
AsPat {} -> False -- the pattern x@y links x and y together,
-- which is a nontrivial piece of information
ViewPat _ _ pat -> goL pat
@@ -791,8 +798,13 @@ conPatNeedsParens p = go
-- | Parenthesize a pattern without token information
-gParPat :: LPat (GhcPass pass) -> Pat (GhcPass pass)
-gParPat p = ParPat noAnn noHsTok p noHsTok
+gParPat :: forall p. IsPass p => LPat (GhcPass p) -> Pat (GhcPass p)
+gParPat pat = ParPat x pat
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
@@ -819,8 +831,8 @@ collectEvVarsPat :: Pat GhcTc -> Bag EvVar
collectEvVarsPat pat =
case pat of
LazyPat _ p -> collectEvVarsLPat p
- AsPat _ _ _ p -> collectEvVarsLPat p
- ParPat _ _ p _ -> collectEvVarsLPat p
+ AsPat _ _ p -> collectEvVarsLPat p
+ ParPat _ p -> collectEvVarsLPat p
BangPat _ p -> collectEvVarsLPat p
ListPat _ ps -> unionManyBags $ map collectEvVarsLPat ps
TuplePat _ ps _ -> unionManyBags $ map collectEvVarsLPat ps
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index 8b407db14546..497632e2e3fd 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -42,13 +42,13 @@ 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
hsPatType (LazyPat _ pat) = hsLPatType pat
hsPatType (LitPat _ lit) = hsLitType lit
-hsPatType (AsPat _ var _ _) = idType (unLoc var)
+hsPatType (AsPat _ var _) = idType (unLoc var)
hsPatType (ViewPat ty _ _) = ty
hsPatType (ListPat ty _) = mkListTy ty
hsPatType (TuplePat tys _ bx) = mkTupleTy1 bx tys
@@ -63,7 +63,7 @@ hsPatType (ConPat { pat_con = lcon
hsPatType (SigPat ty _ _) = ty
hsPatType (NPat ty _ _ _) = ty
hsPatType (NPlusKPat ty _ _ _ _ _) = ty
-hsPatType (EmbTyPat ty _ _) = typeKind ty
+hsPatType (EmbTyPat ty _) = typeKind ty
hsPatType (XPat ext) =
case ext of
CoPat _ _ ty -> ty
@@ -107,10 +107,10 @@ hsExprType (HsOverLit _ lit) = overLitType lit
hsExprType (HsLit _ lit) = hsLitType lit
hsExprType (HsLam _ _ (MG { mg_ext = match_group })) = matchGroupTcType match_group
hsExprType (HsApp _ f _) = funResultTy $ lhsExprType f
-hsExprType (HsAppType x f _ _) = piResultTy (lhsExprType f) x
+hsExprType (HsAppType x f _) = piResultTy (lhsExprType f) x
hsExprType (OpApp v _ _ _) = dataConCantHappen v
hsExprType (NegApp _ _ se) = syntaxExprType se
-hsExprType (HsPar _ _ e _) = lhsExprType e
+hsExprType (HsPar _ e) = lhsExprType e
hsExprType (SectionL v _ _) = dataConCantHappen v
hsExprType (SectionR v _ _) = dataConCantHappen v
hsExprType (ExplicitTuple _ args box) = mkTupleTy box $ map hsTupArgType args
@@ -118,7 +118,7 @@ hsExprType (ExplicitSum alt_tys _ _ _) = mkSumTy alt_tys
hsExprType (HsCase _ _ (MG { mg_ext = match_group })) = mg_res_ty match_group
hsExprType (HsIf _ _ t _) = lhsExprType t
hsExprType (HsMultiIf ty _) = ty
-hsExprType (HsLet _ _ _ _ body) = lhsExprType body
+hsExprType (HsLet _ _ body) = lhsExprType body
hsExprType (HsDo ty _ _) = ty
hsExprType (ExplicitList ty _) = mkListTy ty
hsExprType (RecordCon con_expr _ _) = hsExprType con_expr
@@ -142,7 +142,7 @@ hsExprType (HsUntypedSplice ext _) = dataConCantHappen ext
hsExprType (HsProc _ _ lcmd_top) = lhsCmdTopType lcmd_top
hsExprType (HsStatic (_, ty) _s) = ty
hsExprType (HsPragE _ _ e) = lhsExprType e
-hsExprType (HsEmbTy x _ _) = dataConCantHappen x
+hsExprType (HsEmbTy x _) = dataConCantHappen x
hsExprType (XExpr (WrapExpr (HsWrap wrap e))) = hsWrapperType wrap $ hsExprType e
hsExprType (XExpr (ExpansionExpr (HsExpanded _ tc_e))) = hsExprType tc_e
hsExprType (XExpr (ConLikeTc con _ _)) = conLikeType con
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 0ac161bcdcc7..9fa25a17536f 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -26,7 +26,7 @@ module GHC.Hs.Type (
Mult, HsScaled(..),
hsMult, hsScaledThing,
HsArrow(..), arrowToHsType,
- HsLinearArrowTokens(..),
+ EpLinearArrow(..),
hsLinear, hsUnrestricted, isUnrestricted,
pprHsArrow,
@@ -101,7 +101,6 @@ import Language.Haskell.Syntax.Type
import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) )
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Core.DataCon( SrcStrictness(..), SrcUnpackedness(..), HsImplBang(..) )
import GHC.Hs.Extension
@@ -340,6 +339,14 @@ instance NamedThing (HsTyVarBndr flag GhcRn) where
getName (UserTyVar _ _ v) = unLoc v
getName (KindedTyVar _ _ v _) = unLoc v
+type instance XBndrRequired (GhcPass _) = NoExtField
+
+type instance XBndrInvisible GhcPs = EpToken "@"
+type instance XBndrInvisible GhcRn = NoExtField
+type instance XBndrInvisible GhcTc = NoExtField
+
+type instance XXBndrVis (GhcPass _) = DataConCantHappen
+
type instance XForAllTy (GhcPass _) = NoExtField
type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpAnn [AddEpAnn]
@@ -354,7 +361,9 @@ type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn]
type instance XStarTy (GhcPass _) = NoExtField
type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn]
-type instance XAppKindTy (GhcPass _) = NoExtField
+type instance XAppKindTy GhcPs = EpToken "@"
+type instance XAppKindTy GhcRn = NoExtField
+type instance XAppKindTy GhcTc = NoExtField
type instance XSpliceTy GhcPs = NoExtField
type instance XSpliceTy GhcRn = HsUntypedSpliceResult (LHsType GhcRn)
@@ -394,6 +403,27 @@ type instance XStrTy (GhcPass _) = SourceText
type instance XCharTy (GhcPass _) = SourceText
type instance XXTyLit (GhcPass _) = DataConCantHappen
+data EpLinearArrow
+ = EpPct1 !(EpToken "%1") !(EpUniToken "->" "→")
+ | EpLolly !(EpToken "⊸")
+ deriving Data
+
+instance NoAnn EpLinearArrow where
+ noAnn = EpPct1 noAnn noAnn
+
+type instance XUnrestrictedArrow GhcPs = EpUniToken "->" "→"
+type instance XUnrestrictedArrow GhcRn = NoExtField
+type instance XUnrestrictedArrow GhcTc = NoExtField
+
+type instance XLinearArrow GhcPs = EpLinearArrow
+type instance XLinearArrow GhcRn = NoExtField
+type instance XLinearArrow GhcTc = NoExtField
+
+type instance XExplicitMult GhcPs = (EpToken "%", EpUniToken "->" "→")
+type instance XExplicitMult GhcRn = NoExtField
+type instance XExplicitMult GhcTc = NoExtField
+
+type instance XXArrow (GhcPass _) = DataConCantHappen
oneDataConHsTy :: HsType GhcRn
oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)
@@ -401,11 +431,21 @@ oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)
manyDataConHsTy :: HsType GhcRn
manyDataConHsTy = HsTyVar noAnn NotPromoted (noLocA manyDataConName)
-hsLinear :: a -> HsScaled (GhcPass p) a
-hsLinear = HsScaled (HsLinearArrow (HsPct1 noHsTok noHsUniTok))
+hsLinear :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a
+hsLinear = HsScaled (HsLinearArrow x)
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
-hsUnrestricted :: a -> HsScaled (GhcPass p) a
-hsUnrestricted = HsScaled (HsUnrestrictedArrow noHsUniTok)
+hsUnrestricted :: forall p a. IsPass p => a -> HsScaled (GhcPass p) a
+hsUnrestricted = HsScaled (HsUnrestrictedArrow x)
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
isUnrestricted :: HsArrow GhcRn -> Bool
isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName
@@ -417,7 +457,7 @@ isUnrestricted _ = False
arrowToHsType :: HsArrow GhcRn -> LHsType GhcRn
arrowToHsType (HsUnrestrictedArrow _) = noLocA manyDataConHsTy
arrowToHsType (HsLinearArrow _) = noLocA oneDataConHsTy
-arrowToHsType (HsExplicitMult _ p _) = p
+arrowToHsType (HsExplicitMult _ p) = p
instance
(OutputableBndrId pass) =>
@@ -428,7 +468,7 @@ instance
pprHsArrow :: (OutputableBndrId pass) => HsArrow (GhcPass pass) -> SDoc
pprHsArrow (HsUnrestrictedArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left False)
pprHsArrow (HsLinearArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left True)
-pprHsArrow (HsExplicitMult _ p _) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p))
+pprHsArrow (HsExplicitMult _ p) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p))
type instance XConDeclField (GhcPass _) = EpAnn [AddEpAnn]
type instance XXConDeclField (GhcPass _) = DataConCantHappen
@@ -546,10 +586,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
mkHsAppTys = foldl' mkHsAppTy
-mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppKindTy :: XAppKindTy (GhcPass p)
+ -> LHsType (GhcPass p) -> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-mkHsAppKindTy ty at k
- = addCLocA ty k (HsAppKindTy noExtField ty at k)
+mkHsAppKindTy x ty k = addCLocA ty k (HsAppKindTy x ty k)
{-
************************************************************************
@@ -598,7 +638,7 @@ hsTyGetAppHead_maybe = go
where
go (L _ (HsTyVar _ _ ln)) = Just ln
go (L _ (HsAppTy _ l _)) = go l
- go (L _ (HsAppKindTy _ t _ _)) = go t
+ go (L _ (HsAppKindTy _ t _)) = go t
go (L _ (HsOpTy _ _ _ ln _)) = Just ln
go (L _ (HsParTy _ t)) = go t
go (L _ (HsKindSig _ t _)) = go t
@@ -606,19 +646,29 @@ hsTyGetAppHead_maybe = go
------------------------------------------------------------
+type instance XValArg (GhcPass _) = NoExtField
+
+type instance XTypeArg GhcPs = EpToken "@"
+type instance XTypeArg GhcRn = NoExtField
+type instance XTypeArg GhcTc = NoExtField
+
+type instance XArgPar (GhcPass _) = SrcSpan
+
+type instance XXArg (GhcPass _) = DataConCantHappen
+
-- | Compute the 'SrcSpan' associated with an 'LHsTypeArg'.
-lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan
+lhsTypeArgSrcSpan :: LHsTypeArg GhcPs -> SrcSpan
lhsTypeArgSrcSpan arg = case arg of
- HsValArg tm -> getLocA tm
- HsTypeArg at ty -> getTokenSrcSpan (getLoc at) `combineSrcSpans` getLocA ty
+ HsValArg _ tm -> getLocA tm
+ HsTypeArg at ty -> getEpTokenSrcSpan at `combineSrcSpans` getLocA ty
HsArgPar sp -> sp
--------------------------------
numVisibleArgs :: [HsArg p tm ty] -> Arity
numVisibleArgs = count is_vis
- where is_vis (HsValArg _) = True
- is_vis _ = False
+ where is_vis (HsValArg _ _) = True
+ is_vis _ = False
--------------------------------
@@ -633,7 +683,7 @@ numVisibleArgs = count is_vis
-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
-- @
pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
- => id -> LexicalFixity -> [HsArg p tm ty] -> SDoc
+ => id -> LexicalFixity -> [HsArg (GhcPass p) tm ty] -> SDoc
pprHsArgsApp thing fixity (argl:argr:args)
| Infix <- fixity
= let pp_op_app = hsep [ ppr_single_hs_arg argl
@@ -648,7 +698,7 @@ pprHsArgsApp thing _fixity args
-- | Pretty-print a prefix identifier to a list of 'HsArg's.
ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
- => SDoc -> [HsArg p tm ty] -> SDoc
+ => SDoc -> [HsArg (GhcPass p) tm ty] -> SDoc
ppr_hs_args_prefix_app acc [] = acc
ppr_hs_args_prefix_app acc (arg:args) =
case arg of
@@ -658,8 +708,8 @@ ppr_hs_args_prefix_app acc (arg:args) =
-- | Pretty-print an 'HsArg' in isolation.
ppr_single_hs_arg :: (Outputable tm, Outputable ty)
- => HsArg p tm ty -> SDoc
-ppr_single_hs_arg (HsValArg tm) = ppr tm
+ => HsArg (GhcPass p) tm ty -> SDoc
+ppr_single_hs_arg (HsValArg _ tm) = ppr tm
ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty
-- GHC shouldn't be constructing ASTs such that this case is ever reached.
-- Still, it's possible some wily user might construct their own AST that
@@ -669,8 +719,8 @@ ppr_single_hs_arg (HsArgPar{}) = empty
-- | This instance is meant for debug-printing purposes. If you wish to
-- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where
- ppr (HsValArg tm) = text "HsValArg" <+> ppr tm
- ppr (HsTypeArg at ty) = text "HsTypeArg" <+> ppr at <+> ppr ty
+ ppr (HsValArg _ tm) = text "HsValArg" <+> ppr tm
+ ppr (HsTypeArg _ ty) = text "HsTypeArg" <+> ppr ty
ppr (HsArgPar sp) = text "HsArgPar" <+> ppr sp
--------------------------------
@@ -1041,13 +1091,13 @@ instance OutputableBndrFlag Specificity p where
pprTyVarBndr (KindedTyVar _ SpecifiedSpec n k) = parens $ hsep [ppr n, dcolon, ppr k]
pprTyVarBndr (KindedTyVar _ InferredSpec n k) = braces $ hsep [ppr n, dcolon, ppr k]
-instance OutputableBndrFlag (HsBndrVis p') p where
+instance OutputableBndrFlag (HsBndrVis (GhcPass p')) p where
pprTyVarBndr (UserTyVar _ vis n) = pprHsBndrVis vis $ ppr n
pprTyVarBndr (KindedTyVar _ vis n k) =
pprHsBndrVis vis $ parens $ hsep [ppr n, dcolon, ppr k]
-pprHsBndrVis :: HsBndrVis pass -> SDoc -> SDoc
-pprHsBndrVis HsBndrRequired d = d
+pprHsBndrVis :: HsBndrVis (GhcPass p) -> SDoc -> SDoc
+pprHsBndrVis (HsBndrRequired _) d = d
pprHsBndrVis (HsBndrInvisible _) d = char '@' <> d
instance OutputableBndrId p => Outputable (HsSigType (GhcPass p)) where
@@ -1273,7 +1323,7 @@ ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*')
ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
= hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
-ppr_mono_ty (HsAppKindTy _ ty _ k)
+ppr_mono_ty (HsAppKindTy _ ty k)
= ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2)
= sep [ ppr_mono_lty ty1
@@ -1388,7 +1438,7 @@ lhsTypeHasLeadingPromotionQuote ty
go (HsWildCardTy{}) = False
go (HsStarTy{}) = False
go (HsAppTy _ t _) = goL t
- go (HsAppKindTy _ t _ _) = goL t
+ go (HsAppKindTy _ t _) = goL t
go (HsParTy{}) = False
go (HsDocTy _ t _) = goL t
go (XHsType{}) = False
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 78ded75d25c1..761de4af3064 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -179,7 +179,7 @@ just attach 'noSrcSpan' to everything.
-}
-- | @e => (e)@
-mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+mkHsPar :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsPar e = L (getLoc e) (gHsPar e)
mkSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
@@ -261,7 +261,7 @@ mkHsAppsWith
mkHsAppsWith mkLocated = foldl' (mkHsAppWith mkLocated)
mkHsAppType :: LHsExpr GhcRn -> LHsWcType GhcRn -> LHsExpr GhcRn
-mkHsAppType e t = addCLocA t_body e (HsAppType noExtField e noHsTok paren_wct)
+mkHsAppType e t = addCLocA t_body e (HsAppType noExtField e paren_wct)
where
t_body = hswc_body t
paren_wct = t { hswc_body = t_body }
@@ -321,7 +321,7 @@ mkLHsPar = parenthesizeHsExpr appPrec
mkParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
mkParPat = parenthesizePat appPrec
-nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
+nlParPat :: IsPass p => LPat (GhcPass p) -> LPat (GhcPass p)
nlParPat p = noLocA (gParPat p)
-------------------------------
@@ -604,7 +604,7 @@ nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsOpApp e1 op e2 = noLocA (mkHsOpApp e1 op e2)
nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
-nlHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
+nlHsPar :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
@@ -626,36 +626,46 @@ nlList exprs = noLocA (ExplicitList noAnn exprs)
nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar :: IsSrcSpanAnn p a
=> PromotionFlag -> IdP (GhcPass p) -> LHsType (GhcPass p)
-nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsFunTy :: forall p. IsPass p
+ => LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsAppTy f t = noLocA (HsAppTy noExtField f t)
nlHsTyVar p x = noLocA (HsTyVar noAnn p (noLocA x))
-nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) a b)
+nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow x) a b)
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
nlHsParTy t = noLocA (HsParTy noAnn t)
-nlHsTyConApp :: IsSrcSpanAnn p a
+nlHsTyConApp :: forall p a. IsSrcSpanAnn p a
=> PromotionFlag
-> LexicalFixity -> IdP (GhcPass p)
-> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp prom fixity tycon tys
| Infix <- fixity
- , HsValArg ty1 : HsValArg ty2 : rest <- tys
+ , HsValArg _ ty1 : HsValArg _ ty2 : rest <- tys
= foldl' mk_app (noLocA $ HsOpTy noAnn prom ty1 (noLocA tycon) ty2) rest
| otherwise
= foldl' mk_app (nlHsTyVar prom tycon) tys
where
mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
- mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
+ mk_app fun@(L _ (HsOpTy {})) arg = mk_app (nlHsParTy fun) arg
-- parenthesize things like `(A + B) C`
- mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun ty)
- mk_app fun (HsTypeArg at ki) = noLocA (HsAppKindTy noExtField fun at ki)
- mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun)
+ mk_app fun (HsValArg _ ty) = nlHsAppTy fun ty
+ mk_app fun (HsTypeArg _ ki) = nlHsAppKindTy fun ki
+ mk_app fun (HsArgPar _) = nlHsParTy fun
-nlHsAppKindTy ::
+nlHsAppKindTy :: forall p. IsPass p =>
LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
-nlHsAppKindTy f k
- = noLocA (HsAppKindTy noExtField f noHsTok k)
+nlHsAppKindTy f k = noLocA (HsAppKindTy x f k)
+ where
+ x = case ghcPass @p of
+ GhcPs -> noAnn
+ GhcRn -> noExtField
+ GhcTc -> noExtField
{-
Tuples. All these functions are *pre-typechecker* because they lack
@@ -1237,9 +1247,9 @@ collect_pat flag pat bndrs = case pat of
WildPat _ -> bndrs
LazyPat _ pat -> collect_lpat flag pat bndrs
BangPat _ pat -> collect_lpat flag pat bndrs
- AsPat _ a _ pat -> unXRec @p a : 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
@@ -1252,7 +1262,7 @@ collect_pat flag pat bndrs = case pat of
CollVarTyVarBinders -> collect_lpat flag pat bndrs ++ collectPatSigBndrs sig
XPat ext -> collectXXPat @p flag ext bndrs
SplicePat ext _ -> collectXSplicePat @p flag ext bndrs
- EmbTyPat _ _ tp -> case flag of
+ EmbTyPat _ tp -> case flag of
CollNoDictBinders -> bndrs
CollWithDictBinders -> bndrs
CollVarTyVarBinders -> collectTyPatBndrs tp ++ bndrs
@@ -1621,8 +1631,8 @@ hsConDeclsBinders cons = go emptyFieldIndices cons
get_flds_gadt :: FieldIndices p -> HsConDeclGADTDetails (GhcPass p)
-> (Maybe [Located Int], FieldIndices p)
- get_flds_gadt seen (RecConGADT flds _) = first Just $ get_flds seen flds
- get_flds_gadt seen (PrefixConGADT []) = (Just [], seen)
+ get_flds_gadt seen (RecConGADT _ flds) = first Just $ get_flds seen flds
+ get_flds_gadt seen (PrefixConGADT _ []) = (Just [], seen)
get_flds_gadt seen _ = (Nothing, seen)
get_flds :: FieldIndices p -> LocatedL [LConDeclField (GhcPass p)]
@@ -1798,9 +1808,9 @@ lPatImplicits = hs_lpat
hs_pat (LazyPat _ pat) = hs_lpat pat
hs_pat (BangPat _ pat) = hs_lpat pat
- hs_pat (AsPat _ _ _ 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
hs_pat (SigPat _ pat _) = hs_lpat pat
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 1ee8bb38cd89..370bbe9afbbe 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -415,7 +415,7 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp _ cmd arg) env_ids = do
free_vars `unionDVarSet`
(exprFreeIdsDSet core_arg `uniqDSetIntersectUniqSet` local_vars))
-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
@@ -591,7 +591,7 @@ dsCmd ids local_vars stack_ty res_ty
--
-- ---> premap (\ ((xs),stk) -> let binds in ((ys),stk)) c
-dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ _ lbinds@binds _ body) env_ids = do
+dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@binds body) env_ids = do
let
defined_vars = mkVarSet (collectLocalBinders CollWithDictBinders binds)
local_vars' = defined_vars `unionVarSet` local_vars
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 95fca01d6bf1..8bac3488ce4e 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -418,8 +418,8 @@ h98ConArgDocs con_args = case con_args of
gadtConArgDocs :: HsConDeclGADTDetails GhcRn -> HsType GhcRn -> IntMap (HsDoc GhcRn)
gadtConArgDocs con_args res_ty = case con_args of
- PrefixConGADT args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty]
- RecConGADT _ _ -> con_arg_docs 1 [res_ty]
+ PrefixConGADT _ args -> con_arg_docs 0 $ map (unLoc . hsScaledThing) args ++ [res_ty]
+ RecConGADT _ _ -> con_arg_docs 1 [res_ty]
con_arg_docs :: Int -> [HsType GhcRn] -> IntMap (HsDoc GhcRn)
con_arg_docs n = IM.fromList . catMaybes . zipWith f [n..]
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 7f44894f70e6..70f6252325b5 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -158,7 +158,7 @@ ds_val_bind _ (is_rec, binds) _body
-- would transform a linear definition into a non-linear one. See Wrinkle 2
-- Note [Desugar Strict binds] in GHC.HsToCore.Binds.
ds_val_bind dflags (NonRecursive, hsbinds) body
- | [L _loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = MultAnn{mult_ext=mult}
+ | [L _loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_ann
, pat_ext = (ty, (rhs_tick, _var_ticks))})] <- bagToList hsbinds
-- Non-recursive, non-overloaded bindings only come in ones
, pat' <- decideBangHood dflags pat
@@ -167,6 +167,7 @@ ds_val_bind dflags (NonRecursive, hsbinds) body
; rhs_expr <- dsGuarded grhss ty rhss_nablas
; let rhs' = mkOptTickBox rhs_tick rhs_expr
; let body_ty = exprType body
+ ; let mult = getTcMultAnn mult_ann
; error_expr <- mkErrorAppDs pAT_ERROR_ID body_ty (ppr pat')
; matchSimply rhs' PatBindRhs mult pat' body error_expr }
-- This is the one place where matchSimply is given a non-ManyTy
@@ -295,7 +296,7 @@ dsExpr (HsRecSel _ (FieldOcc 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 x _) = dataConCantHappen x
@@ -441,7 +442,7 @@ dsExpr (ExplicitSum types alt arity expr)
dsExpr (HsPragE _ prag expr) =
ds_prag_expr prag expr
-dsExpr (HsEmbTy x _ _) = dataConCantHappen x
+dsExpr (HsEmbTy x _) = dataConCantHappen x
dsExpr (HsCase ctxt discrim matches)
= do { core_discrim <- dsLExpr discrim
@@ -450,7 +451,7 @@ dsExpr (HsCase ctxt discrim matches)
-- Pepe: The binds are in scope in the body but NOT in the binding group
-- This is to avoid silliness in breakpoints
-dsExpr (HsLet _ _ binds _ body) = do
+dsExpr (HsLet _ binds body) = do
body' <- dsLExpr body
dsLocalBinds binds body'
@@ -982,11 +983,11 @@ 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
- go wrap (HsAppType ty (L _ hs_e) _ _)
+ go wrap (HsAppType ty (L _ hs_e) _)
= go (wrap <.> WpTyApp ty) hs_e
go wrap (HsVar _ (L _ var))
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index d5c30d14629b..b930583a9ad6 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -420,7 +420,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 g (ParPat _ _ pat _) = tidy1 v g (unLoc pat)
+tidy1 v g (ParPat _ pat) = tidy1 v g (unLoc pat)
tidy1 v g (SigPat _ pat _) = tidy1 v g (unLoc pat)
tidy1 _ _ (WildPat ty) = return (idDsWrapper, WildPat ty)
tidy1 v g (BangPat _ (L l p)) = tidy_bang_pat v g l p
@@ -432,7 +432,7 @@ tidy1 v _ (VarPat _ (L _ var))
-- case v of { x@p -> mr[] }
-- = case v of { p -> let x=v in mr[] }
-tidy1 v g (AsPat _ (L _ var) _ pat)
+tidy1 v g (AsPat _ (L _ var) pat)
= do { (wrap, pat') <- tidy1 v g (unLoc pat)
; return (wrapBind var v . wrap, pat') }
@@ -514,13 +514,13 @@ tidy_bang_pat :: Id -> Bool -> SrcSpanAnnA -> Pat GhcTc
-> DsM (DsWrapper, Pat GhcTc)
-- Discard par/sig under a bang
-tidy_bang_pat v g _ (ParPat _ _ (L l p) _) = tidy_bang_pat v g l p
+tidy_bang_pat v g _ (ParPat _ (L l p)) = tidy_bang_pat v g l p
tidy_bang_pat v g _ (SigPat _ (L l p) _) = tidy_bang_pat v g l p
-- Push the bang-pattern inwards, in the hope that
-- it may disappear next time
-tidy_bang_pat v g l (AsPat x v' at p)
- = tidy1 v g (AsPat x v' at (L l (BangPat noExtField p)))
+tidy_bang_pat v g l (AsPat x v' p)
+ = tidy1 v g (AsPat x v' (L l (BangPat noExtField p)))
tidy_bang_pat v g l (XPat (CoPat w p t))
= tidy1 v g (XPat $ CoPat w (BangPat noExtField (L l p)) t)
@@ -1135,8 +1135,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 0f7cf893f918..31fd8fdf4daa 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -437,7 +437,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
@@ -481,7 +481,7 @@ getSimpleIntegralLit HsDoublePrim{} = 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 _ (HsLit _ (HsChar _ c))) = Just c
getLHsCharLit (L _ (XExpr (HsTick _ e))) = getLHsCharLit e
getLHsCharLit (L _ (XExpr (HsBinTick _ _ e))) = getLHsCharLit e
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 0382ee61d6a0..e7b977556318 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -110,7 +110,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
@@ -120,10 +120,10 @@ desugarPat x pat = case pat of
-- (x@pat) ==> Desugar pat with x as match var and handle impedance
-- mismatch with incoming match var
- AsPat _ (L _ y) _ p -> (mkPmLetVar y x ++) <$> desugarLPat y p
+ AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p
SigPat _ p _ty -> desugarLPat x p
- EmbTyPat _ _ _ -> pure []
+ EmbTyPat _ _ -> pure []
XPat ext -> case ext of
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 5a01b10479f2..0d5a5950aca2 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -693,21 +693,21 @@ repTyFamEqn (FamEqn { feqn_tycon = tc_name
; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs ->
do { tys1 <- case fixity of
Prefix -> repTyArgs (repNamedTyCon tc) tys
- Infix -> do { (HsValArg t1: HsValArg t2: args) <- checkTys tys
+ Infix -> do { (HsValArg _ t1: HsValArg _ t2: args) <- checkTys tys
; t1' <- repLTy t1
; t2' <- repLTy t2
; repTyArgs (repTInfix t1' tc t2') args }
; rhs1 <- repLTy rhs
; repTySynEqn mb_exp_bndrs tys1 rhs1 } }
where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
- checkTys tys@(HsValArg _:HsValArg _:_) = return tys
+ checkTys tys@(HsValArg _ _:HsValArg _ _:_) = return tys
checkTys _ = panic "repTyFamEqn:checkTys"
repTyArgs :: MetaM (Core (M TH.Type)) -> [LHsTypeArg GhcRn] -> MetaM (Core (M TH.Type))
repTyArgs f [] = f
-repTyArgs f (HsValArg ty : as) = do { f' <- f
- ; ty' <- repLTy ty
- ; repTyArgs (repTapp f' ty') as }
+repTyArgs f (HsValArg _ ty : as) = do { f' <- f
+ ; ty' <- repLTy ty
+ ; repTyArgs (repTapp f' ty') as }
repTyArgs f (HsTypeArg _ ki : as) = do { f' <- f
; ki' <- repLTy ki
; repTyArgs (repTappKind f' ki') as }
@@ -724,14 +724,14 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn =
; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs ->
do { tys1 <- case fixity of
Prefix -> repTyArgs (repNamedTyCon tc) tys
- Infix -> do { (HsValArg t1: HsValArg t2: args) <- checkTys tys
+ Infix -> do { (HsValArg _ t1: HsValArg _ t2: args) <- checkTys tys
; t1' <- repLTy t1
; t2' <- repLTy t2
; repTyArgs (repTInfix t1' tc t2') args }
; repDataDefn tc (Right (mb_exp_bndrs, tys1)) defn } }
where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
- checkTys tys@(HsValArg _: HsValArg _: _) = return tys
+ checkTys tys@(HsValArg _ _: HsValArg _ _: _) = return tys
checkTys _ = panic "repDataFamInstD:checkTys"
repForD :: LForeignDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
@@ -1187,7 +1187,7 @@ instance RepTV (HsBndrVis GhcRn) TH.BndrVis where
; rep2 kindedBndrTVName [nm, vis', ki] }
rep_bndr_vis :: HsBndrVis GhcRn -> MetaM (Core TH.BndrVis)
-rep_bndr_vis HsBndrRequired = rep2_nw bndrReqName []
+rep_bndr_vis (HsBndrRequired _) = rep2_nw bndrReqName []
rep_bndr_vis (HsBndrInvisible _) = rep2_nw bndrInvisName []
addHsOuterFamEqnTyVarBinds ::
@@ -1402,7 +1402,7 @@ repTy (HsAppTy _ f a) = do
f1 <- repLTy f
a1 <- repLTy a
repTapp f1 a1
-repTy (HsAppKindTy _ ty _ ki) = do
+repTy (HsAppKindTy _ ty ki) = do
ty1 <- repLTy ty
ki1 <- repLTy ki
repTappKind ty1 ki1
@@ -1540,8 +1540,7 @@ repE (HsLam _ LamCases (MG { mg_alts = (L _ ms) }))
; core_ms <- coreListM matchTyConName ms'
; repLamCases core_ms }
repE (HsApp _ x y) = do {a <- repLE x; b <- repLE y; repApp a b}
-repE (HsAppType _ e _ t)
- = do { a <- repLE e
+repE (HsAppType _ e t) = do { a <- repLE e
; s <- repLTy (hswc_body t)
; repAppType a s }
@@ -1554,7 +1553,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) }))
@@ -1571,10 +1570,10 @@ repE (HsMultiIf _ alts)
= do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts
; expr' <- repMultiIf (nonEmptyCoreList alts')
; wrapGenSyms (concat binds) expr' }
-repE (HsLet _ _ bs _ e) = do { (ss,ds) <- repBinds bs
- ; e2 <- addBinds ss (repLE e)
- ; z <- repLetE ds e2
- ; wrapGenSyms ss z }
+repE (HsLet _ bs e) = do { (ss,ds) <- repBinds bs
+ ; e2 <- addBinds ss (repLE e)
+ ; z <- repLetE ds e2
+ ; wrapGenSyms ss z }
-- FIXME: I haven't got the types here right yet
repE e@(HsDo _ ctxt (L _ sts))
@@ -1667,7 +1666,7 @@ repE (HsGetField _ e (L _ (DotFieldOcc _ (L _ (FieldLabelString f))))) = do
e1 <- repLE e
repGetField e1 f
repE (HsProjection _ xs) = repProjection (fmap (field_label . unLoc . dfoLabel . unLoc) xs)
-repE (HsEmbTy _ _ t) = do
+repE (HsEmbTy _ t) = do
t1 <- repLTy (hswc_body t)
rep2 typeEName [unC t1]
repE (XExpr (HsExpanded orig_expr ds_expr))
@@ -2086,9 +2085,9 @@ repP (LitPat _ l) = do { l2 <- repLiteral l; repPlit l2 }
repP (VarPat _ x) = do { x' <- lookupBinder (unLoc x); repPvar x' }
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
+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 _ ps) = do { qs <- repLPs ps; repPlist qs }
repP (TuplePat _ ps boxed)
| isBoxed boxed = do { qs <- repLPs ps; repPtup qs }
@@ -2127,8 +2126,8 @@ repP p@(NPat _ (L _ l) (Just _) _)
repP (SigPat _ p t) = do { p' <- repLP p
; t' <- repLTy (hsPatSigType t)
; repPsig p' t' }
-repP (EmbTyPat _ _ t) = do { t' <- repLTy (hstp_body t)
- ; repPtype t' }
+repP (EmbTyPat _ t) = do { t' <- repLTy (hstp_body t)
+ ; repPtype t' }
repP (SplicePat (HsUntypedSpliceNested n) _) = rep_splice n
repP p@(SplicePat (HsUntypedSpliceTop _ _) _) = pprPanic "repP: top level splice" (ppr p)
repP other = notHandled (ThExoticPattern other)
@@ -2759,11 +2758,11 @@ repGadtDataCons :: NonEmpty (LocatedN Name)
repGadtDataCons cons details res_ty
= do cons' <- mapM lookupLOcc cons -- See Note [Binders and occurrences]
case details of
- PrefixConGADT ps -> do
+ PrefixConGADT _ ps -> do
arg_tys <- repPrefixConArgs ps
res_ty' <- repLTy res_ty
rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty']
- RecConGADT ips _ -> do
+ RecConGADT _ ips -> do
arg_vtys <- repRecConArgs ips
res_ty' <- repLTy res_ty
rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys,
diff --git a/compiler/GHC/HsToCore/Ticks.hs b/compiler/GHC/HsToCore/Ticks.hs
index a44761d1b191..e33c09ca4f19 100644
--- a/compiler/GHC/HsToCore/Ticks.hs
+++ b/compiler/GHC/HsToCore/Ticks.hs
@@ -483,9 +483,9 @@ addTickHsExpr (HsLam x v mg) = liftM (HsLam x v)
(addTickMatchGroup True mg)
addTickHsExpr (HsApp x e1 e2) = liftM2 (HsApp x) (addTickLHsExprNever e1)
(addTickLHsExpr e2)
-addTickHsExpr (HsAppType x e at ty) = do
+addTickHsExpr (HsAppType x e ty) = do
e' <- addTickLHsExprNever e
- return (HsAppType x e' at ty)
+ return (HsAppType x e' ty)
addTickHsExpr (OpApp fix e1 e2 e3) =
liftM4 OpApp
(return fix)
@@ -496,9 +496,9 @@ addTickHsExpr (NegApp x e neg) =
liftM2 (NegApp x)
(addTickLHsExpr e)
(addTickSyntaxExpr hpcSrcSpan neg)
-addTickHsExpr (HsPar x lpar e rpar) = do
+addTickHsExpr (HsPar x e) = do
e' <- addTickLHsExprEvalInner e
- return (HsPar x lpar e' rpar)
+ return (HsPar x e')
addTickHsExpr (SectionL x e1 e2) =
liftM2 (SectionL x)
(addTickLHsExpr e1)
@@ -528,11 +528,11 @@ addTickHsExpr (HsMultiIf ty alts)
= do { let isOneOfMany = case alts of [_] -> False; _ -> True
; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False) alts
; return $ HsMultiIf ty alts' }
-addTickHsExpr (HsLet x tkLet binds tkIn e) =
+addTickHsExpr (HsLet x binds e) =
bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
e' <- addTickLHsExprLetBody e
- return (HsLet x tkLet binds' tkIn e')
+ return (HsLet x binds' e')
addTickHsExpr (HsDo srcloc cxt (L l stmts))
= do { (stmts', _) <- addTickLStmts' forQual stmts (return ())
; return (HsDo srcloc cxt (L l stmts')) }
@@ -824,9 +824,9 @@ addTickHsCmd (OpApp e1 c2 fix c3) =
(return fix)
(addTickLHsCmd c3)
-}
-addTickHsCmd (HsCmdPar x lpar e rpar) = do
+addTickHsCmd (HsCmdPar x e) = do
e' <- addTickLHsCmd e
- return (HsCmdPar x lpar e' rpar)
+ return (HsCmdPar x e')
addTickHsCmd (HsCmdCase x e mgs) =
liftM2 (HsCmdCase x)
(addTickLHsExpr e)
@@ -836,11 +836,11 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) =
(addBinTickLHsExpr (BinBox CondBinBox) e1)
(addTickLHsCmd c2)
(addTickLHsCmd c3)
-addTickHsCmd (HsCmdLet x tkLet binds tkIn c) =
+addTickHsCmd (HsCmdLet x binds c) =
bindLocals (collectLocalBinders CollNoDictBinders binds) $ do
binds' <- addTickHsLocalBinds binds -- to think about: !patterns.
c' <- addTickLHsCmd c
- return (HsCmdLet x tkLet binds' tkIn c')
+ return (HsCmdLet x binds' c')
addTickHsCmd (HsCmdDo srcloc (L l stmts))
= do { (stmts', _) <- addTickLCmdStmts' stmts (return ())
; return (HsCmdDo srcloc (L l stmts')) }
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 07b875e858fa..a7ac0bcaf246 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -131,7 +131,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]
--
@@ -140,7 +140,7 @@ selectMatchVar _w (VarPat _ var) = return (localiseId (unLoc var))
-- multiplicity stored within the variable
-- itself. It's easier to pull it from the
-- variable, so we ignore the multiplicity.
-selectMatchVar _w (AsPat _ var _ _) = assert (isManyTy _w ) (return (localiseId (unLoc var)))
+selectMatchVar _w (AsPat _ var _) = assert (isManyTy _w ) (return (localiseId (unLoc var)))
selectMatchVar w other_pat = newSysLocalDs w (hsPatType other_pat)
{- Note [Localise pattern binders]
@@ -791,7 +791,7 @@ mkSelectorBinds ticks pat ctx 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
@@ -800,7 +800,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})
@@ -817,7 +817,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
@@ -1058,7 +1058,7 @@ decideBangHood dflags lpat
where
go lp@(L l p)
= case p of
- ParPat x lpar p rpar -> L l (ParPat x lpar (go p) rpar)
+ ParPat x p -> L l (ParPat x (go p))
LazyPat _ lp' -> lp'
BangPat _ _ -> lp
_ -> L l (BangPat noExtField lp)
@@ -1090,5 +1090,5 @@ isTrueLHsExpr (L _ (XExpr (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 533255d6f006..021101e96d50 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -555,8 +555,8 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where
HsOuterExplicit{hso_bndrs = tvs} ->
foldl1' combineSrcSpans [getHasLoc a, getHasLocList tvs, getHasLocList b, getHasLoc c]
-instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg p tm ty) where
- getHasLoc (HsValArg tm) = getHasLoc tm
+instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg (GhcPass p) tm ty) where
+ getHasLoc (HsValArg _ tm) = getHasLoc tm
getHasLoc (HsTypeArg _ ty) = getHasLoc ty
getHasLoc (HsArgPar sp) = sp
@@ -736,10 +736,10 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
HsApp{} -> Nothing
HsAppType{} -> Nothing
NegApp{} -> Nothing
- HsPar _ _ e _ -> computeLType e
+ HsPar _ e -> computeLType e
ExplicitTuple{} -> Nothing
HsIf _ _ t f -> computeLType t <|> computeLType f
- HsLet _ _ _ _ body -> computeLType body
+ HsLet _ _ body -> computeLType body
RecordCon con_expr _ _ -> computeType con_expr
ExprWithTySig _ e _ -> computeLType e
HsPragE _ _ e -> computeLType e
@@ -960,14 +960,14 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
LazyPat _ p ->
[ toHie $ PS rsp scope pscope p
]
- AsPat _ lname _ pat ->
+ AsPat _ lname pat ->
[ toHie $ C (PatternBind scope
(combineScopes (mkScope pat) pscope)
rsp)
lname
, toHie $ PS rsp scope pscope pat
]
- ParPat _ _ pat _ ->
+ ParPat _ pat ->
[ toHie $ PS rsp scope pscope pat
]
BangPat _ pat ->
@@ -1028,7 +1028,7 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
sig
HieRn -> pure []
]
- EmbTyPat _ _ tp ->
+ EmbTyPat _ tp ->
[ toHie $ TS (ResolvedScopes [scope, pscope]) tp
]
XPat e ->
@@ -1176,7 +1176,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
[ toHie a
, toHie b
]
- HsAppType _ expr _ sig ->
+ HsAppType _ expr sig ->
[ toHie expr
, toHie $ TS (ResolvedScopes []) sig
]
@@ -1188,7 +1188,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
NegApp _ a _ ->
[ toHie a
]
- HsPar _ _ a _ ->
+ HsPar _ a ->
[ toHie a
]
SectionL _ a b ->
@@ -1217,7 +1217,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
HsMultiIf _ grhss ->
[ toHie grhss
]
- HsLet _ _ binds _ expr ->
+ HsLet _ binds expr ->
[ toHie $ RS (mkScope expr) binds
, toHie expr
]
@@ -1264,7 +1264,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
HsStatic _ expr ->
[ toHie expr
]
- HsEmbTy _ _ ty ->
+ HsEmbTy _ ty ->
[ toHie $ TS (ResolvedScopes []) ty
]
HsTypedBracket xbracket b -> case hiePass @p of
@@ -1474,8 +1474,8 @@ instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg re
toHie (InfixCon a b) = concatM [ toHie a, toHie b]
instance ToHie (HsConDeclGADTDetails GhcRn) where
- toHie (PrefixConGADT args) = toHie args
- toHie (RecConGADT rec _) = toHie rec
+ toHie (PrefixConGADT _ args) = toHie args
+ toHie (RecConGADT _ rec) = toHie rec
instance HiePass p => ToHie (LocatedAn NoEpAnns (HsCmdTop (GhcPass p))) where
toHie (L span top) = concatM $ makeNodeA top span : case top of
@@ -1497,7 +1497,7 @@ instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where
[ toHie a
, toHie b
]
- HsCmdPar _ _ a _ ->
+ HsCmdPar _ a ->
[ toHie a
]
HsCmdCase _ expr alts ->
@@ -1512,7 +1512,7 @@ instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where
, toHie b
, toHie c
]
- HsCmdLet _ _ binds _ cmd' ->
+ HsCmdLet _ binds cmd' ->
[ toHie $ RS (mkScope cmd') binds
, toHie cmd'
]
@@ -1706,8 +1706,8 @@ instance ToHie (LocatedA (ConDecl GhcRn)) where
rhsScope = combineScopes argsScope tyScope
ctxScope = maybe NoScope mkScope ctx
argsScope = case args of
- PrefixConGADT xs -> scaled_args_scope xs
- RecConGADT x _ -> mkScope x
+ PrefixConGADT _ xs -> scaled_args_scope xs
+ RecConGADT _ x -> mkScope x
tyScope = mkScope typ
resScope = ResolvedScopes [ctxScope, rhsScope]
ConDeclH98 { con_name = name, con_ex_tvs = qvars
@@ -1839,7 +1839,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
[ toHie a
, toHie b
]
- HsAppKindTy _ ty _ ki ->
+ HsAppKindTy _ ty ki ->
[ toHie ty
, toHie ki
]
@@ -1897,8 +1897,8 @@ instance ToHie (LocatedA (HsType GhcRn)) where
HsStarTy _ _ -> []
XHsType _ -> []
-instance (ToHie tm, ToHie ty) => ToHie (HsArg p tm ty) where
- toHie (HsValArg tm) = toHie tm
+instance (ToHie tm, ToHie ty) => ToHie (HsArg (GhcPass p) tm ty) where
+ toHie (HsValArg _ tm) = toHie tm
toHie (HsTypeArg _ ty) = toHie ty
toHie (HsArgPar sp) = locOnly sp
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index ae30baad8c61..2257f55603fb 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -912,15 +912,15 @@ implicit_top :: { () }
body :: { ([TrailingAnn]
,([LImportDecl GhcPs], [LHsDecl GhcPs])
- ,LayoutInfo GhcPs) }
- : '{' top '}' { (fst $2, snd $2, explicitBraces $1 $3) }
- | vocurly top close { (fst $2, snd $2, VirtualBraces (getVOCURLY $1)) }
+ ,EpLayout) }
+ : '{' top '}' { (fst $2, snd $2, epExplicitBraces $1 $3) }
+ | vocurly top close { (fst $2, snd $2, EpVirtualBraces (getVOCURLY $1)) }
body2 :: { ([TrailingAnn]
,([LImportDecl GhcPs], [LHsDecl GhcPs])
- ,LayoutInfo GhcPs) }
- : '{' top '}' { (fst $2, snd $2, explicitBraces $1 $3) }
- | missing_module_keyword top close { ([], snd $2, VirtualBraces leftmostColumn) }
+ ,EpLayout) }
+ : '{' top '}' { (fst $2, snd $2, epExplicitBraces $1 $3) }
+ | missing_module_keyword top close { ([], snd $2, EpVirtualBraces leftmostColumn) }
top :: { ([TrailingAnn]
@@ -940,19 +940,19 @@ header :: { Located (HsModule GhcPs) }
{% fileSrcSpan >>= \ loc ->
acs (\cs -> (L loc (HsModule (XModulePs
(EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
- NoLayoutInfo $3 Nothing)
+ EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
))) }
| 'signature' modid maybe_warning_pragma maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
acs (\cs -> (L loc (HsModule (XModulePs
(EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
- NoLayoutInfo $3 Nothing)
+ EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
))) }
| header_body2
{% fileSrcSpan >>= \ loc ->
- return (L loc (HsModule (XModulePs noAnn NoLayoutInfo Nothing Nothing) Nothing Nothing $1 [])) }
+ return (L loc (HsModule (XModulePs noAnn EpNoLayout Nothing Nothing) Nothing Nothing $1 [])) }
header_body :: { [LImportDecl GhcPs] }
: '{' header_top { $2 }
@@ -1730,22 +1730,22 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
decllist_cls
:: { Located ([AddEpAnn]
, OrdList (LHsDecl GhcPs)
- , LayoutInfo GhcPs) } -- Reversed
+ , EpLayout) } -- Reversed
: '{' decls_cls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
- ,snd $ unLoc $2, explicitBraces $1 $3) }
+ ,snd $ unLoc $2, epExplicitBraces $1 $3) }
| vocurly decls_cls close { let { L l (anns, decls) = $2 }
- in L l (anns, decls, VirtualBraces (getVOCURLY $1)) }
+ in L l (anns, decls, EpVirtualBraces (getVOCURLY $1)) }
-- Class body
--
where_cls :: { Located ([AddEpAnn]
,(OrdList (LHsDecl GhcPs)) -- Reversed
- ,LayoutInfo GhcPs) }
+ ,EpLayout) }
-- No implicit parameters
-- May have type declarations
: 'where' decllist_cls { sLL $1 $> (mj AnnWhere $1:(fstOf3 $ unLoc $2)
,sndOf3 $ unLoc $2,thdOf3 $ unLoc $2) }
- | {- empty -} { noLoc ([],nilOL,NoLayoutInfo) }
+ | {- empty -} { noLoc ([],nilOL,EpNoLayout) }
-- Declarations in instance bodies
--
@@ -1963,7 +1963,7 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
| {- empty -} { Nothing }
warning_category :: { Maybe (Located InWarningCategory) }
- : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (hsTok' $1) (getSTRINGs $2)
+ : 'in' STRING { Just (sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)
(sL1 $2 $ mkWarningCategory (getSTRING $2))) }
| {- empty -} { Nothing }
@@ -2191,20 +2191,20 @@ type :: { LHsType GhcPs }
-- See Note [%shift: type -> btype]
: btype %shift { $1 }
| btype '->' ctype {% acsA (\cs -> sLL $1 $>
- $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsUnrestrictedArrow (hsUniTok $2)) $1 $3) }
+ $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsUnrestrictedArrow (epUniTok $2)) $1 $3) }
| btype mult '->' ctype {% hintLinear (getLoc $2)
- >> let arr = (unLoc $2) (hsUniTok $3)
+ >> let arr = (unLoc $2) (epUniTok $3)
in acsA (\cs -> sLL $1 $>
$ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) arr $1 $4) }
| btype '->.' ctype {% hintLinear (getLoc $2) >>
acsA (\cs -> sLL $1 $>
- $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsLinearArrow (HsLolly (hsTok $2))) $1 $3) }
+ $ HsFunTy (EpAnn (glEE $1 $>) NoEpAnns cs) (HsLinearArrow (EpLolly (epTok $2))) $1 $3) }
-- [mu AnnLollyU $2] }
-mult :: { Located (LHsUniToken "->" "\8594" GhcPs -> HsArrow GhcPs) }
- : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (hsTok $1) $2) }
+mult :: { Located (EpUniToken "->" "\8594" -> HsArrow GhcPs) }
+ : PREFIX_PERCENT atype { sLL $1 $> (mkMultTy (epTok $1) $2) }
btype :: { LHsType GhcPs }
: infixtype {% runPV $1 }
@@ -2226,7 +2226,7 @@ ftype :: { forall b. DisambTD b => PV (LocatedA b) }
| ftype tyarg { $1 >>= \ $1 ->
mkHsAppTyPV $1 $2 }
| ftype PREFIX_AT atype { $1 >>= \ $1 ->
- mkHsAppKindTyPV $1 (hsTok $2) $3 }
+ mkHsAppKindTyPV $1 (epTok $2) $3 }
tyarg :: { LHsType GhcPs }
: atype { $1 }
@@ -2420,7 +2420,7 @@ gadt_constr :: { LConDecl GhcPs }
-- Returns a list because of: C,D :: ty
-- TODO:AZ capture the optSemi. Why leading?
: optSemi con_list '::' sigtype
- {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (hsUniTok $3) $4 }
+ {% mkGadtDecl (comb2 $2 $>) (unLoc $2) (epUniTok $3) $4 }
{- Note [Difference in parsing GADT and data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2553,7 +2553,7 @@ decl_no_th :: { LHsDecl GhcPs }
| infixexp opt_sig rhs {% runPV (unECP $1) >>= \ $1 ->
do { let { l = comb2 $1 $> }
- ; r <- checkValDef l $1 (HsNoMultAnn, $2) $3;
+ ; r <- checkValDef l $1 (HsNoMultAnn noExtField, $2) $3;
-- Depending upon what the pattern looks like we might get either
-- a FunBind or PatBind back from checkValDef. See Note
-- [FunBind vs PatBind]
@@ -2561,7 +2561,7 @@ decl_no_th :: { LHsDecl GhcPs }
; return $! (sL (commentsA l cs) $ ValD noExtField r) } }
| PREFIX_PERCENT atype infixexp opt_sig rhs {% runPV (unECP $3) >>= \ $3 ->
do { let { l = comb2 $3 $> }
- ; r <- checkValDef l $3 (mkMultAnn (hsTok $1) $2, $4) $5;
+ ; r <- checkValDef l $3 (mkMultAnn (epTok $1) $2, $4) $5;
-- parses bindings of the form %p x or
-- %p x :: sig
--
@@ -2731,7 +2731,7 @@ exp :: { ECP }
-- Embed types into expressions and patterns for required type arguments
| 'type' atype
{% do { requireExplicitNamespaces (getLoc $1)
- ; return $ ECP $ mkHsEmbTyPV (comb2 $1 $>) (hsTok $1) $2 } }
+ ; return $ ECP $ mkHsEmbTyPV (comb2 $1 $>) (epTok $1) $2 } }
infixexp :: { ECP }
: exp10 { $1 }
@@ -2836,7 +2836,7 @@ fexp :: { ECP }
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
| fexp PREFIX_AT atype { ECP $
unECP $1 >>= \ $1 ->
- mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (hsTok $2) $3 }
+ mkHsAppTypePV (noAnnSrcSpan $ comb2 $1 $>) $1 (epTok $2) $3 }
| 'static' aexp {% runPV (unECP $2) >>= \ $2 ->
fmap ecpFromExp $
@@ -2849,7 +2849,7 @@ aexp :: { ECP }
: qvar TIGHT_INFIX_AT aexp
{ ECP $
unECP $3 >>= \ $3 ->
- mkHsAsPatPV (comb2 $1 $>) $1 (hsTok $2) $3 }
+ mkHsAsPatPV (comb2 $1 $>) $1 (epTok $2) $3 }
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parser.Lexer
@@ -2864,7 +2864,7 @@ aexp :: { ECP }
mkHsNegAppPV (comb2 $1 $>) $2 [mj AnnMinus $1] }
| 'let' binds 'in' exp { ECP $
unECP $4 >>= \ $4 ->
- mkHsLetPV (comb2 $1 $>) (hsTok $1) (unLoc $2) (hsTok $3) $4 }
+ mkHsLetPV (comb2 $1 $>) (epTok $1) (unLoc $2) (epTok $3) $4 }
| '\\' apats '->' exp
{ ECP $
unECP $4 >>= \ $4 ->
@@ -2968,7 +2968,7 @@ aexp2 :: { ECP }
-- but the less cluttered version fell out of having texps.
| '(' texp ')' { ECP $
unECP $2 >>= \ $2 ->
- mkHsParPV (comb2 $1 $>) (hsTok $1) $2 (hsTok $3) }
+ mkHsParPV (comb2 $1 $>) (epTok $1) $2 (epTok $3) }
| '(' tup_exprs ')' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2
@@ -4465,19 +4465,16 @@ listAsAnchorM (L l _:_) =
RealSrcSpan ll _ -> Just $ realSpanAsAnchor ll
_ -> Nothing
-hsTok :: Located Token -> LHsToken tok GhcPs
-hsTok (L l _) = L (mkTokenLocation l) HsTok
+epTok :: Located Token -> EpToken tok
+epTok (L l _) = EpTok (EpaSpan l)
-hsTok' :: Located Token -> Located (HsToken tok)
-hsTok' (L l _) = L l HsTok
-
-hsUniTok :: Located Token -> LHsUniToken tok utok GhcPs
-hsUniTok t@(L l _) =
- L (mkTokenLocation l)
- (if isUnicode t then HsUnicodeTok else HsNormalTok)
+epUniTok :: Located Token -> EpUniToken tok utok
+epUniTok t@(L l _) = EpUniTok (EpaSpan l) u
+ where
+ u = if isUnicode t then UnicodeSyntax else NormalSyntax
-explicitBraces :: Located Token -> Located Token -> LayoutInfo GhcPs
-explicitBraces t1 t2 = ExplicitBraces (hsTok t1) (hsTok t2)
+epExplicitBraces :: Located Token -> Located Token -> EpLayout
+epExplicitBraces t1 t2 = EpExplicitBraces (epTok t1) (epTok t2)
-- -------------------------------------
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index aa6b4e3c8e63..6cf248ab2553 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -1,11 +1,17 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
module GHC.Parser.Annotation (
-- * Core Exact Print Annotation types
AnnKeywordId(..),
+ EpToken(..), EpUniToken(..),
+ getEpTokenSrcSpan,
+ EpLayout(..),
EpaComment(..), EpaCommentTok(..),
IsUnicodeSyntax(..),
unicodeAnn,
@@ -15,7 +21,6 @@ module GHC.Parser.Annotation (
AddEpAnn(..),
EpaLocation, EpaLocation'(..), epaLocationRealSrcSpan,
TokenLocation(..),
- getTokenSrcSpan,
DeltaPos(..), deltaPos, getDeltaLine,
EpAnn(..), Anchor,
@@ -99,6 +104,7 @@ import Data.Function (on)
import Data.List (sortBy, foldl1')
import Data.Semigroup
import GHC.Data.FastString
+import GHC.TypeLits (Symbol, KnownSymbol)
import GHC.Types.Name
import GHC.Types.SrcLoc
import GHC.Hs.DocString
@@ -356,6 +362,59 @@ data HasE = HasE | NoE
-- ---------------------------------------------------------------------
+-- | A token stored in the syntax tree. For example, when parsing a
+-- let-expression, we store @EpToken "let"@ and @EpToken "in"@.
+-- The locations of those tokens can be used to faithfully reproduce
+-- (exactprint) the original program text.
+data EpToken (tok :: Symbol)
+ = NoEpTok
+ | EpTok !EpaLocation
+
+-- | With @UnicodeSyntax@, there might be multiple ways to write the same
+-- token. For example an arrow could be either @->@ or @→@. This choice must be
+-- recorded in order to exactprint such tokens, so instead of @EpToken "->"@ we
+-- introduce @EpUniToken "->" "→"@.
+data EpUniToken (tok :: Symbol) (utok :: Symbol)
+ = NoEpUniTok
+ | EpUniTok !EpaLocation !IsUnicodeSyntax
+
+deriving instance Eq (EpToken tok)
+deriving instance KnownSymbol tok => Data (EpToken tok)
+deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (EpUniToken tok utok)
+
+getEpTokenSrcSpan :: EpToken tok -> SrcSpan
+getEpTokenSrcSpan NoEpTok = noSrcSpan
+getEpTokenSrcSpan (EpTok EpaDelta{}) = noSrcSpan
+getEpTokenSrcSpan (EpTok (EpaSpan span)) = span
+
+-- | Layout information for declarations.
+data EpLayout =
+
+ -- | Explicit braces written by the user.
+ --
+ -- @
+ -- class C a where { foo :: a; bar :: a }
+ -- @
+ EpExplicitBraces !(EpToken "{") !(EpToken "}")
+ |
+ -- | Virtual braces inserted by the layout algorithm.
+ --
+ -- @
+ -- class C a where
+ -- foo :: a
+ -- bar :: a
+ -- @
+ EpVirtualBraces
+ !Int -- ^ Layout column (indentation level, begins at 1)
+ |
+ -- | Empty or compiler-generated blocks do not have layout information
+ -- associated with them.
+ EpNoLayout
+
+deriving instance Data EpLayout
+
+-- ---------------------------------------------------------------------
+
data EpaComment =
EpaComment
{ ac_tok :: EpaCommentTok
@@ -429,11 +488,6 @@ noCommentsToEpaLocation (EpaDelta dp NoComments) = EpaDelta dp []
data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
deriving (Data,Eq)
-getTokenSrcSpan :: TokenLocation -> SrcSpan
-getTokenSrcSpan NoTokenLoc = noSrcSpan
-getTokenSrcSpan (TokenLoc EpaDelta{}) = noSrcSpan
-getTokenSrcSpan (TokenLoc (EpaSpan span)) = span
-
instance Outputable a => Outputable (GenLocated TokenLocation a) where
ppr (L _ x) = ppr x
@@ -1342,6 +1396,12 @@ instance NoAnn AnnPragma where
instance NoAnn AnnParen where
noAnn = AnnParen AnnParens noAnn noAnn
+instance NoAnn (EpToken s) where
+ noAnn = NoEpTok
+
+instance NoAnn (EpUniToken s t) where
+ noAnn = NoEpUniTok
+
-- ---------------------------------------------------------------------
instance (Outputable a) => Outputable (EpAnn a) where
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index c6e304479439..6f5ad2e75b43 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -193,19 +193,18 @@ mkClassDecl :: SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a,[LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
- -> LayoutInfo GhcPs
+ -> EpLayout
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
-mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn
+mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layout annsIn
= do { let loc = noAnnSrcSpan loc'
; (binds, sigs, ats, at_defs, _, docs) <- cvBindsAndSigs where_cls
; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr
; tyvars <- checkTyVars (text "class") whereDots cls tparams
; cs <- getCommentsFor (locA loc) -- Get any remaining comments
; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) ann cs
- ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey)
- , tcdLayout = layoutInfo
+ ; return (L loc (ClassDecl { tcdCExt = (anns', layout, NoAnnSortKey)
, tcdCtxt = mcxt
, tcdLName = cls, tcdTyVars = tyvars
, tcdFixity = fixity
@@ -806,7 +805,7 @@ mkConDeclH98 ann name mb_forall mb_cxt args
-- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
mkGadtDecl :: SrcSpan
-> NonEmpty (LocatedN RdrName)
- -> LHsUniToken "::" "∷" GhcPs
+ -> EpUniToken "::" "∷"
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl loc names dcol ty = do
@@ -821,13 +820,13 @@ mkGadtDecl loc names dcol ty = do
HsUnrestrictedArrow arr -> return arr
_ -> do addError $ mkPlainErrorMsgEnvelope (getLocA body_ty) $
(PsErrIllegalGadtRecordMultiplicity hsArr)
- return noHsUniTok
+ return noAnn
- return ( RecConGADT (L an' rf) arr, res_ty
+ return ( RecConGADT arr (L an' rf), res_ty
, [], epAnnComments ll)
_ -> do
let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
- return (PrefixConGADT arg_types, res_type, anns, cs)
+ return (PrefixConGADT noExtField arg_types, res_type, anns, cs)
let an = EpAnn (spanAsAnchor loc) annsa (cs Semi.<> csa)
@@ -836,9 +835,8 @@ mkGadtDecl loc names dcol ty = do
HsOuterExplicit an _ -> EpAnn (entry an) noAnn emptyComments
pure $ L l ConDeclGADT
- { con_g_ext = an
+ { con_g_ext = (dcol, an)
, con_names = names
- , con_dcolon = dcol
, con_bndrs = L bndrs_loc outer_bndrs
, con_mb_cxt = mcxt
, con_g_args = args
@@ -947,7 +945,7 @@ checkTyVars pp_what equals_or_where tc tparms
; return (mkHsQTvs tvs) }
where
check (HsTypeArg at ki) = chkParens [] [] emptyComments (HsBndrInvisible at) ki
- check (HsValArg ty) = chkParens [] [] emptyComments HsBndrRequired ty
+ check (HsValArg _ ty) = chkParens [] [] emptyComments (HsBndrRequired noExtField) ty
check (HsArgPar sp) = addFatalError $ mkPlainErrorMsgEnvelope sp $
(PsErrMalformedDecl pp_what (unLoc tc))
-- Keep around an action for adjusting the annotations of extra parens
@@ -984,11 +982,11 @@ checkTyVars pp_what equals_or_where tc tparms
-- Return an AddEpAnn for use in widenLocatedAn. The AnnKeywordId is not used.
for_widening :: HsBndrVis GhcPs -> AddEpAnn
- for_widening (HsBndrInvisible (L (TokenLoc loc) _)) = AddEpAnn AnnAnyclass loc
- for_widening _ = AddEpAnn AnnAnyclass (EpaDelta (SameLine 0) [])
+ for_widening (HsBndrInvisible (EpTok loc)) = AddEpAnn AnnAnyclass loc
+ for_widening _ = AddEpAnn AnnAnyclass (EpaDelta (SameLine 0) [])
for_widening_ann :: HsBndrVis GhcPs -> EpAnn [AddEpAnn]
- for_widening_ann (HsBndrInvisible (L (TokenLoc (EpaSpan (RealSrcSpan r _mb))) _))
+ for_widening_ann (HsBndrInvisible (EpTok (EpaSpan (RealSrcSpan r _mb))))
= EpAnn (realSpanAsAnchor r) [] emptyComments
for_widening_ann _ = noAnn
@@ -1082,15 +1080,17 @@ checkTyClHdr is_cls ty
go _ (HsTyVar _ _ ltc@(L _ tc)) acc ops cps fix
| isRdrTc tc = return (ltc, acc, fix, (reverse ops) ++ cps)
go _ (HsOpTy _ _ t1 ltc@(L _ tc) t2) acc ops cps _fix
- | isRdrTc tc = return (ltc, HsValArg t1:HsValArg t2:acc, Infix, (reverse ops) ++ cps)
+ | isRdrTc tc = return (ltc, lhs:rhs:acc, Infix, (reverse ops) ++ cps)
+ where lhs = HsValArg noExtField t1
+ rhs = HsValArg noExtField t2
go l (HsParTy _ ty) acc ops cps fix = goL ty acc (o:ops) (c:cps) fix
where
(o,c) = mkParensEpAnn (realSrcSpan l)
- go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg t2:acc) ops cps fix
- go _ (HsAppKindTy _ ty at ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix
+ go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg noExtField t2:acc) ops cps fix
+ go _ (HsAppKindTy at ty ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix
go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix
= return (L (noAnnSrcSpan l) (nameRdrName tup_name)
- , map HsValArg ts, fix, (reverse ops)++cps)
+ , map (HsValArg noExtField) ts, fix, (reverse ops)++cps)
where
arity = length ts
tup_name | is_cls = cTupleTyConName arity
@@ -1281,7 +1281,7 @@ checkAPat loc e0 = do
PatBuilderPar lpar e rpar -> do
p <- checkLPat e
- return (ParPat (EpAnn (spanAsAnchor (locA loc)) NoEpAnns emptyComments) lpar p rpar)
+ return (ParPat (lpar, rpar) p)
_ -> do
details <- fromParseContext <$> askParseContext
@@ -1323,15 +1323,16 @@ checkValDef loc lhs (mult, Just (sigAnn, sig)) grhss
>>= checkLPat
checkPatBind loc [] lhs' grhss mult
-checkValDef loc lhs (HsNoMultAnn, Nothing) g
+checkValDef loc lhs (mult_ann, Nothing) grhss
+ | HsNoMultAnn{} <- mult_ann
= do { mb_fun <- isFunLhs lhs
; case mb_fun of
Just (fun, is_infix, pats, ann) ->
checkFunBind NoSrcStrict loc ann
- fun is_infix pats g
+ fun is_infix pats grhss
Nothing -> do
lhs' <- checkPattern lhs
- checkPatBind loc [] lhs' g HsNoMultAnn }
+ checkPatBind loc [] lhs' grhss mult_ann }
checkValDef loc lhs (mult_ann, Nothing) ghrss
-- %p x = rhs parses as a *pattern* binding
@@ -1381,7 +1382,7 @@ checkPatBind :: SrcSpan
-> HsMultAnn GhcPs
-> P (HsBind GhcPs)
checkPatBind loc annsIn (L _ (BangPat (EpAnn _ ans cs) (L _ (VarPat _ v))))
- (L _match_span grhss) HsNoMultAnn
+ (L _match_span grhss) (HsNoMultAnn _)
= return (makeFunBind v (L (noAnnSrcSpan loc)
[L (noAnnSrcSpan loc) (m (EpAnn (spanAsAnchor loc) (ans++annsIn) cs) v)]))
where
@@ -1394,8 +1395,7 @@ checkPatBind loc annsIn (L _ (BangPat (EpAnn _ ans cs) (L _ (VarPat _ v))))
checkPatBind loc annsIn lhs (L _ grhss) mult = do
cs <- getCommentsFor loc
- let mult_ann = MultAnn{mult_ext=NoExtField, mult_ann=mult}
- return (PatBind (EpAnn (spanAsAnchor loc) annsIn cs) lhs mult_ann grhss)
+ return (PatBind (EpAnn (spanAsAnchor loc) annsIn cs) lhs mult grhss)
checkValSigLhs :: LHsExpr GhcPs -> P (LocatedN RdrName)
@@ -1564,9 +1564,9 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-- | Disambiguate "let ... in ..."
mkHsLetPV
:: SrcSpan
- -> LHsToken "let" GhcPs
+ -> EpToken "let"
-> HsLocalBinds GhcPs
- -> LHsToken "in" GhcPs
+ -> EpToken "in"
-> LocatedA b
-> PV (LocatedA b)
-- | Infix operator representation
@@ -1593,7 +1593,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
-- | Disambiguate "f x" (function application)
mkHsAppPV :: SrcSpanAnnA -> LocatedA b -> LocatedA (FunArg b) -> PV (LocatedA b)
-- | Disambiguate "f @t" (visible type application)
- mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
+ mkHsAppTypePV :: SrcSpanAnnA -> LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate "if ... then ... else ..."
mkHsIfPV :: SrcSpan
-> LHsExpr GhcPs
@@ -1611,7 +1611,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
AnnList ->
PV (LocatedA b)
-- | Disambiguate "( ... )" (parentheses)
- mkHsParPV :: SrcSpan -> LHsToken "(" GhcPs -> LocatedA b -> LHsToken ")" GhcPs -> PV (LocatedA b)
+ mkHsParPV :: SrcSpan -> EpToken "(" -> LocatedA b -> EpToken ")" -> PV (LocatedA b)
-- | Disambiguate a variable "f" or a data constructor "MkF".
mkHsVarPV :: LocatedN RdrName -> PV (LocatedA b)
-- | Disambiguate a monomorphic literal
@@ -1646,7 +1646,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
:: SrcSpan -> LHsExpr GhcPs -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
-- | Disambiguate "a@b" (as-pattern)
mkHsAsPatPV
- :: SrcSpan -> LocatedN RdrName -> LHsToken "@" GhcPs -> LocatedA b -> PV (LocatedA b)
+ :: SrcSpan -> LocatedN RdrName -> EpToken "@" -> LocatedA b -> PV (LocatedA b)
-- | Disambiguate "~a" (lazy pattern)
mkHsLazyPatPV :: SrcSpan -> LocatedA b -> [AddEpAnn] -> PV (LocatedA b)
-- | Disambiguate "!a" (bang pattern)
@@ -1655,7 +1655,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
mkSumOrTuplePV
:: SrcSpanAnnA -> Boxity -> SumOrTuple b -> [AddEpAnn] -> PV (LocatedA b)
-- | Disambiguate "type t" (embedded type)
- mkHsEmbTyPV :: SrcSpan -> LHsToken "type" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
+ mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
-- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas
rejectPragmaPV :: LocatedA b -> PV ()
@@ -1716,7 +1716,7 @@ instance DisambECP (HsCmd GhcPs) where
mkHsLetPV l tkLet bs tkIn e = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsCmdLet (EpAnn (spanAsAnchor l) NoEpAnns cs) tkLet bs tkIn e)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdLet (tkLet, tkIn) bs e)
type InfixOp (HsCmd GhcPs) = HsExpr GhcPs
@@ -1750,7 +1750,7 @@ instance DisambECP (HsCmd GhcPs) where
mkHsDoPV l (Just m) _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
mkHsParPV l lpar c rpar = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsCmdPar (EpAnn (spanAsAnchor l) NoEpAnns cs) lpar c rpar)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdPar (lpar, rpar) c)
mkHsVarPV (L l v) = cmdFail (locA l) (ppr v)
mkHsLitPV (L l a) = cmdFail l (ppr a)
mkHsOverLitPV (L l a) = cmdFail (locA l) (ppr a)
@@ -1800,7 +1800,7 @@ instance DisambECP (HsExpr GhcPs) where
return $ mkRdrProjUpdate (noAnnSrcSpan l) fields arg isPun (EpAnn (spanAsAnchor l) anns cs)
mkHsLetPV l tkLet bs tkIn c = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsLet (EpAnn (spanAsAnchor l) NoEpAnns cs) tkLet bs tkIn c)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLet (tkLet, tkIn) bs c)
type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
superInfixOp m = m
mkHsOpAppPV l e1 op e2 = do
@@ -1824,7 +1824,7 @@ instance DisambECP (HsExpr GhcPs) where
return $ L l (HsApp (comment (realSrcSpan $ locA l) cs) e1 e2)
mkHsAppTypePV l e at t = do
checkExpBlockArguments e
- return $ L l (HsAppType noExtField e at (mkHsWildCardBndrs t))
+ return $ L l (HsAppType at e (mkHsWildCardBndrs t))
mkHsIfPV l c semi1 a semi2 b anns = do
checkDoAndIfThenElse PsErrSemiColonsInCondExpr c semi1 a semi2 b
cs <- getCommentsFor l
@@ -1834,7 +1834,7 @@ instance DisambECP (HsExpr GhcPs) where
return $ L (noAnnSrcSpan l) (HsDo (EpAnn (spanAsAnchor l) anns cs) (DoExpr mod) stmts)
mkHsParPV l lpar e rpar = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsPar (EpAnn (spanAsAnchor l) NoEpAnns cs) lpar e rpar)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
mkHsVarPV v@(L l _) = return $ L (l2l l) (HsVar noExtField v)
mkHsLitPV (L l a) = do
cs <- getCommentsFor l
@@ -1873,7 +1873,7 @@ instance DisambECP (HsExpr GhcPs) where
mkSumOrTuplePV = mkSumOrTupleExpr
mkHsEmbTyPV l toktype ty =
return $ L (noAnnSrcSpan l) $
- HsEmbTy noExtField toktype (mkHsWildCardBndrs ty)
+ HsEmbTy toktype (mkHsWildCardBndrs ty)
rejectPragmaPV (L _ (OpApp _ _ _ e)) =
-- assuming left-associative parsing of operators
rejectPragmaPV e
@@ -1948,7 +1948,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsAsPatPV l v at e = do
p <- checkLPat e
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (PatBuilderPat (AsPat (EpAnn (spanAsAnchor l) NoEpAnns cs) v at p))
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (AsPat at v p))
mkHsLazyPatPV l e a = do
p <- checkLPat e
cs <- getCommentsFor l
@@ -1962,7 +1962,7 @@ instance DisambECP (PatBuilder GhcPs) where
mkSumOrTuplePV = mkSumOrTuplePat
mkHsEmbTyPV l toktype ty =
return $ L (noAnnSrcSpan l) $
- PatBuilderPat (EmbTyPat noExtField toktype (mkHsTyPat noAnn ty))
+ PatBuilderPat (EmbTyPat toktype (mkHsTyPat noAnn ty))
rejectPragmaPV _ = return ()
-- | Ensure that a literal pattern isn't of type Addr#, Float#, Double#.
@@ -2023,7 +2023,7 @@ class DisambTD b where
-- | Disambiguate @f x@ (function application or prefix data constructor).
mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @f \@t@ (visible kind application)
- mkHsAppKindTyPV :: LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
+ mkHsAppKindTyPV :: LocatedA b -> EpToken "@" -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @f \# x@ (infix operator)
mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma)
@@ -2032,7 +2032,7 @@ class DisambTD b where
instance DisambTD (HsType GhcPs) where
mkHsAppTyHeadPV = return
mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2)
- mkHsAppKindTyPV t at ki = return (mkHsAppKindTy t at ki)
+ mkHsAppKindTyPV t at ki = return (mkHsAppKindTy at t ki)
mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2)
mkUnpackednessPV = addUnpackednessP
@@ -2069,7 +2069,7 @@ instance DisambTD DataConBuilder where
panic "mkHsAppTyPV: InfixDataConBuilder"
mkHsAppKindTyPV lhs at ki =
- addFatalError $ mkPlainErrorMsgEnvelope (getTokenSrcSpan (getLoc at)) $
+ addFatalError $ mkPlainErrorMsgEnvelope (getEpTokenSrcSpan at) $
(PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
mkHsOpTyPV prom lhs tc rhs = do
@@ -3193,40 +3193,38 @@ mkLHsOpTy prom x op y =
let loc = getLoc x `combineSrcSpansA` (noAnnSrcSpan $ getLocA op) `combineSrcSpansA` getLoc y
in L loc (mkHsOpTy prom x op y)
-mkMultTy :: LHsToken "%" GhcPs -> LHsType GhcPs -> LHsUniToken "->" "→" GhcPs -> HsArrow GhcPs
+mkMultTy :: EpToken "%" -> LHsType GhcPs -> EpUniToken "->" "→" -> HsArrow GhcPs
mkMultTy pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1))) arr
-- See #18888 for the use of (SourceText "1") above
- = HsLinearArrow (HsPct1 (L locOfPct1 HsTok) arr)
+ = HsLinearArrow (EpPct1 pct1 arr)
where
-- The location of "%" combined with the location of "1".
- locOfPct1 :: TokenLocation
- locOfPct1 = token_location_widenR (getLoc pct) (locA (getLoc t))
-mkMultTy pct t arr = HsExplicitMult pct t arr
+ pct1 :: EpToken "%1"
+ pct1 = epTokenWidenR pct (locA (getLoc t))
+mkMultTy pct t arr = HsExplicitMult (pct, arr) t
-mkMultAnn :: LHsToken "%" GhcPs -> LHsType GhcPs -> HsMultAnn GhcPs
+mkMultAnn :: EpToken "%" -> LHsType GhcPs -> HsMultAnn GhcPs
mkMultAnn pct t@(L _ (HsTyLit _ (HsNumTy (SourceText (unpackFS -> "1")) 1)))
-- See #18888 for the use of (SourceText "1") above
- = HsPct1Ann (L locOfPct1 HsTok)
+ = HsPct1Ann pct1
where
-- The location of "%" combined with the location of "1".
- locOfPct1 :: TokenLocation
- locOfPct1 = token_location_widenR (getLoc pct) (locA (getLoc t))
+ pct1 :: EpToken "%1"
+ pct1 = epTokenWidenR pct (locA (getLoc t))
mkMultAnn pct t = HsMultAnn pct t
mkTokenLocation :: SrcSpan -> TokenLocation
mkTokenLocation (UnhelpfulSpan _) = NoTokenLoc
mkTokenLocation (RealSrcSpan r mb) = TokenLoc (EpaSpan (RealSrcSpan r mb))
--- Precondition: the TokenLocation has EpaSpan, never EpaDelta.
-token_location_widenR :: TokenLocation -> SrcSpan -> TokenLocation
-token_location_widenR NoTokenLoc _ = NoTokenLoc
-token_location_widenR tl (UnhelpfulSpan _) = tl
-token_location_widenR (TokenLoc (EpaSpan s1)) s2 =
- (TokenLoc (EpaSpan (combineSrcSpans s1 s2)))
-token_location_widenR (TokenLoc (EpaDelta _ _)) _ =
+-- Precondition: the EpToken has EpaSpan, never EpaDelta.
+epTokenWidenR :: EpToken tok -> SrcSpan -> EpToken tok'
+epTokenWidenR NoEpTok _ = NoEpTok
+epTokenWidenR (EpTok l) (UnhelpfulSpan _) = EpTok l
+epTokenWidenR (EpTok (EpaSpan s1)) s2 = EpTok (EpaSpan (combineSrcSpans s1 s2))
+epTokenWidenR (EpTok (EpaDelta _ _)) _ =
-- Never happens because the parser does not produce EpaDelta.
- panic "token_location_widenR: EpaDelta"
-
+ panic "epTokenWidenR: EpaDelta"
-----------------------------------------------------------------------------
-- Token symbols
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 2282076b8881..672519e7f50c 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -289,8 +289,8 @@ instance HasHaddock (Located (HsModule GhcPs)) where
-- data C = MkC -- ^ Comment on MkC
-- -- ^ Comment on C
--
- let layout_info = hsmodLayout (hsmodExt mod)
- hsmodDecls' <- addHaddockInterleaveItems layout_info (mkDocHsDecl layout_info) (hsmodDecls mod)
+ let layout = hsmodLayout (hsmodExt mod)
+ hsmodDecls' <- addHaddockInterleaveItems layout (mkDocHsDecl layout) (hsmodDecls mod)
pure $ L l_mod $
mod { hsmodExports = hsmodExports'
@@ -312,7 +312,7 @@ lexLHsDocString = fmap lexHsDocString
instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where
addHaddock (L l_exports exports) =
extendHdkA (locA l_exports) $ do
- exports' <- addHaddockInterleaveItems NoLayoutInfo mkDocIE exports
+ exports' <- addHaddockInterleaveItems EpNoLayout mkDocIE exports
registerLocHdkA (srcLocSpan (srcSpanEnd (locA l_exports))) -- Do not consume comments after the closing parenthesis
pure $ L l_exports exports'
@@ -340,10 +340,10 @@ In this case, we should produce four HsDecl items (pseudo-code):
The inputs to addHaddockInterleaveItems are:
- * layout_info :: LayoutInfo GhcPs
+ * layout :: EpLayout
In the example above, note that the indentation level inside the module is
- 2 spaces. It would be represented as layout_info = VirtualBraces 2.
+ 2 spaces. It would be represented as layout = EpVirtualBraces 2.
It is used to delimit the search space for comments when processing
declarations. Here, we restrict indentation levels to >=(2+1), so that when
@@ -352,7 +352,7 @@ The inputs to addHaddockInterleaveItems are:
* get_doc_item :: PsLocated HdkComment -> Maybe a
This is the function used to look up documentation comments.
- In the above example, get_doc_item = mkDocHsDecl layout_info,
+ In the above example, get_doc_item = mkDocHsDecl layout,
and it will produce the following parts of the output:
DocD (DocCommentNext "Comment on D")
@@ -372,25 +372,25 @@ The inputs to addHaddockInterleaveItems are:
addHaddockInterleaveItems
:: forall a.
HasHaddock a
- => LayoutInfo GhcPs
+ => EpLayout
-> (PsLocated HdkComment -> Maybe a) -- Get a documentation item
-> [a] -- Unprocessed (non-documentation) items
-> HdkA [a] -- Documentation items & processed non-documentation items
-addHaddockInterleaveItems layout_info get_doc_item = go
+addHaddockInterleaveItems layout get_doc_item = go
where
go :: [a] -> HdkA [a]
go [] = liftHdkA (takeHdkComments get_doc_item)
go (item : items) = do
docItems <- liftHdkA (takeHdkComments get_doc_item)
- item' <- with_layout_info (addHaddock item)
+ item' <- with_layout (addHaddock item)
other_items <- go items
pure $ docItems ++ item':other_items
- with_layout_info :: HdkA a -> HdkA a
- with_layout_info = case layout_info of
- NoLayoutInfo -> id
- ExplicitBraces{} -> id
- VirtualBraces n ->
+ with_layout :: HdkA a -> HdkA a
+ with_layout = case layout of
+ EpNoLayout -> id
+ EpExplicitBraces{} -> id
+ EpVirtualBraces n ->
let loc_range = mempty { loc_range_col = ColumnFrom (n+1) }
in hoistHdkA (inLocRange loc_range)
@@ -498,18 +498,18 @@ instance HasHaddock (HsDecl GhcPs) where
-- -- ^ Comment on the second method
--
addHaddock (TyClD _ decl)
- | ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout,
+ | ClassDecl { tcdCExt = (x, layout, NoAnnSortKey),
tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs,
tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl
= do
registerHdkA tcdLName
-- todo: register keyword location of 'where', see Note [Register keyword location]
where_cls' <-
- addHaddockInterleaveItems tcdLayout (mkDocHsDecl tcdLayout) $
+ addHaddockInterleaveItems layout (mkDocHsDecl layout) $
flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], [])
pure $
let (tcdMeths', tcdSigs', tcdATs', tcdATDefs', _, tcdDocs) = partitionBindsAndSigs where_cls'
- decl' = ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout
+ decl' = ClassDecl { tcdCExt = (x, layout, NoAnnSortKey)
, tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs
, tcdSigs = tcdSigs'
, tcdMeths = tcdMeths'
@@ -698,19 +698,19 @@ instance HasHaddock (LocatedA (ConDecl GhcPs)) where
addHaddock (L l_con_decl con_decl) =
extendHdkA (locA l_con_decl) $
case con_decl of
- ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
+ ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do
-- discardHasInnerDocs is ok because we don't need this info for GADTs.
con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (NE.head con_names))
con_g_args' <-
case con_g_args of
- PrefixConGADT ts -> PrefixConGADT <$> addHaddock ts
- RecConGADT (L l_rec flds) arr -> do
+ PrefixConGADT x ts -> PrefixConGADT x <$> addHaddock ts
+ RecConGADT arr (L l_rec flds) -> do
-- discardHasInnerDocs is ok because we don't need this info for GADTs.
flds' <- traverse (discardHasInnerDocs . addHaddockConDeclField) flds
- pure $ RecConGADT (L l_rec flds') arr
+ pure $ RecConGADT arr (L l_rec flds')
con_res_ty' <- addHaddock con_res_ty
pure $ L l_con_decl $
- ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt,
+ ConDeclGADT { con_g_ext, con_names, con_bndrs, con_mb_cxt,
con_doc = lexLHsDocString <$> con_doc',
con_g_args = con_g_args',
con_res_ty = con_res_ty' }
@@ -1309,11 +1309,11 @@ reportExtraDocs =
* *
********************************************************************* -}
-mkDocHsDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
-mkDocHsDecl layout_info a = fmap (DocD noExtField) <$> mkDocDecl layout_info a
+mkDocHsDecl :: EpLayout -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
+mkDocHsDecl layout a = fmap (DocD noExtField) <$> mkDocDecl layout a
-mkDocDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
-mkDocDecl layout_info (L l_comment hdk_comment)
+mkDocDecl :: EpLayout -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
+mkDocDecl layout (L l_comment hdk_comment)
| indent_mismatch = Nothing
| otherwise =
Just $ L (noAnnSrcSpan span) $
@@ -1344,10 +1344,10 @@ mkDocDecl layout_info (L l_comment hdk_comment)
-- class C a where
-- f :: a -> a
-- -- ^ indent mismatch
- indent_mismatch = case layout_info of
- NoLayoutInfo -> False
- ExplicitBraces{} -> False
- VirtualBraces n -> n /= srcSpanStartCol (psRealSpan l_comment)
+ indent_mismatch = case layout of
+ EpNoLayout -> False
+ EpExplicitBraces{} -> False
+ EpVirtualBraces n -> n /= srcSpanStartCol (psRealSpan l_comment)
mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs)
mkDocIE (L l_comment hdk_comment) =
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index 505719e0c0ec..110c5e982d6f 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -53,9 +53,9 @@ pprSumOrTuple boxity = \case
-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
data PatBuilder p
= PatBuilderPat (Pat p)
- | PatBuilderPar (LHsToken "(" p) (LocatedA (PatBuilder p)) (LHsToken ")" p)
+ | PatBuilderPar (EpToken "(") (LocatedA (PatBuilder p)) (EpToken ")")
| PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
- | PatBuilderAppType (LocatedA (PatBuilder p)) (LHsToken "@" p) (HsTyPat GhcPs)
+ | PatBuilderAppType (LocatedA (PatBuilder p)) (EpToken "@") (HsTyPat GhcPs)
| PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
(LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
| PatBuilderVar (LocatedN RdrName)
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index c67b1e2fb301..411f13d27417 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -446,7 +446,7 @@ rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat, pat_mult = pat_mult })
= do
-- we don't actually use the FV processing of rnPatsAndThen here
(pat',pat'_fvs) <- rnBindPat name_maker pat
- (pat_mult', mult'_fvs) <- rnMultAnn pat_mult
+ (pat_mult', mult'_fvs) <- rnHsMultAnn pat_mult
return (bind { pat_lhs = pat', pat_ext = pat'_fvs `plusFV` mult'_fvs, pat_mult = pat_mult' })
-- We temporarily store the pat's FVs in bind_fvs;
-- gets updated to the FVs of the whole bind
@@ -571,8 +571,8 @@ isOkNoBindPattern (L _ pat) =
-- Recursive cases
BangPat _ lp -> lpatternContainsSplice lp
LazyPat _ lp -> lpatternContainsSplice lp
- AsPat _ _ _ lp -> lpatternContainsSplice lp
- ParPat _ _ lp _ -> lpatternContainsSplice lp
+ AsPat _ _ lp -> lpatternContainsSplice lp
+ ParPat _ lp -> lpatternContainsSplice lp
ViewPat _ _ lp -> lpatternContainsSplice lp
SigPat _ lp _ -> lpatternContainsSplice lp
ListPat _ lps -> any lpatternContainsSplice lps
@@ -715,16 +715,11 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
-- | Multiplicity annotations are a simple wrapper around types. As such,
-- renaming them is a straightforward wrapper around 'rnLHsType'.
rnHsMultAnn :: HsMultAnn GhcPs -> RnM (HsMultAnn GhcRn, FreeVars)
-rnHsMultAnn HsNoMultAnn = return $ (HsNoMultAnn, emptyFVs)
-rnHsMultAnn (HsPct1Ann x) = return $ (HsPct1Ann x, emptyFVs)
-rnHsMultAnn (HsMultAnn x p) = do
+rnHsMultAnn (HsNoMultAnn _) = return (HsNoMultAnn noExtField, emptyFVs)
+rnHsMultAnn (HsPct1Ann _) = return (HsPct1Ann noExtField, emptyFVs)
+rnHsMultAnn (HsMultAnn _ p) = do
(p', freeVars') <- rnLHsType PatCtx p
- return $ (HsMultAnn x p', freeVars')
-
-rnMultAnn :: MultAnn GhcPs -> RnM (MultAnn GhcRn, FreeVars)
-rnMultAnn (MultAnn{mult_ext=none, mult_ann=ann}) = do
- (ann', freeVars') <- rnHsMultAnn ann
- return $ (MultAnn{mult_ext=none, mult_ann=ann'}, freeVars')
+ return $ (HsMultAnn noExtField p', freeVars')
{- *********************************************************************
* *
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 8a2fb766fd6e..a26ed9d12033 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -293,7 +293,7 @@ rnExpr (HsUnboundVar _ v)
rnExpr (HsOverLabel _ src v)
= do { (from_label, fvs) <- lookupSyntaxName fromLabelClassOpName
; return ( mkExpandedExpr (HsOverLabel noAnn src v) $
- HsAppType noExtField (genLHsVar from_label) noHsTok hs_ty_arg
+ HsAppType noExtField (genLHsVar from_label) hs_ty_arg
, fvs ) }
where
hs_ty_arg = mkEmptyWildCardBndrs $ wrapGenSpan $
@@ -324,12 +324,12 @@ rnExpr (HsApp x fun arg)
; (arg',fvArg) <- rnLExpr arg
; return (HsApp x fun' arg', fvFun `plusFV` fvArg) }
-rnExpr (HsAppType _ fun at arg)
+rnExpr (HsAppType _ fun arg)
= do { type_app <- xoptM LangExt.TypeApplications
; unless type_app $ addErr $ typeAppErr TypeLevel $ hswc_body arg
; (fun',fvFun) <- rnLExpr fun
; (arg',fvArg) <- rnHsWcType HsTypeCtx arg
- ; return (HsAppType NoExtField fun' at arg', fvFun `plusFV` fvArg) }
+ ; return (HsAppType noExtField fun' arg', fvFun `plusFV` fvArg) }
rnExpr (OpApp _ e1 op e2)
= do { (e1', fv_e1) <- rnLExpr e1
@@ -391,17 +391,17 @@ rnExpr (HsUntypedSplice _ splice) = rnUntypedSpliceExpr splice
---------------------------------------------
-- Sections
-- See Note [Parsing sections] in GHC.Parser
-rnExpr (HsPar x lpar (L loc (section@(SectionL {}))) rpar)
+rnExpr (HsPar _ (L loc (section@(SectionL {}))))
= do { (section', fvs) <- rnSection section
- ; return (HsPar x lpar (L loc section') rpar, fvs) }
+ ; return (HsPar noExtField (L loc section'), fvs) }
-rnExpr (HsPar x lpar (L loc (section@(SectionR {}))) rpar)
+rnExpr (HsPar _ (L loc (section@(SectionR {}))))
= do { (section', fvs) <- rnSection section
- ; return (HsPar x lpar (L loc section') rpar, fvs) }
+ ; return (HsPar noExtField (L loc section'), fvs) }
-rnExpr (HsPar x lpar e rpar)
+rnExpr (HsPar _ e)
= do { (e', fvs_e) <- rnLExpr e
- ; return (HsPar x lpar e' rpar, fvs_e) }
+ ; return (HsPar noExtField e', fvs_e) }
rnExpr expr@(SectionL {})
= do { addErr (sectionErr expr); rnSection expr }
@@ -425,10 +425,10 @@ rnExpr (HsCase _ expr matches)
; (new_matches, ms_fvs) <- rnMatchGroup CaseAlt rnLExpr matches
; return (HsCase CaseAlt new_expr new_matches, e_fvs `plusFV` ms_fvs) }
-rnExpr (HsLet _ tkLet binds tkIn expr)
+rnExpr (HsLet _ binds expr)
= rnLocalBindsAndThen binds $ \binds' _ -> do
{ (expr',fvExpr) <- rnLExpr expr
- ; return (HsLet noExtField tkLet binds' tkIn expr', fvExpr) }
+ ; return (HsLet noExtField binds' expr', fvExpr) }
rnExpr (HsDo _ do_or_lc (L l stmts))
= do { ((stmts1, _), fvs1) <-
@@ -560,9 +560,9 @@ rnExpr (ArithSeq _ _ seq)
else
return (ArithSeq noExtField Nothing new_seq, fvs) }
-rnExpr (HsEmbTy _ toktype ty)
+rnExpr (HsEmbTy _ ty)
= do { (ty', fvs) <- rnHsWcType HsTypeCtx ty
- ; return (HsEmbTy noExtField toktype ty', fvs) }
+ ; return (HsEmbTy noExtField ty', fvs) }
{-
************************************************************************
@@ -883,9 +883,9 @@ rnCmd (HsCmdLam x lam_variant matches)
; (new_matches, ms_fvs) <- rnMatchGroup ctxt rnLCmd matches
; return (HsCmdLam x lam_variant new_matches, ms_fvs) }
-rnCmd (HsCmdPar x lpar e rpar)
+rnCmd (HsCmdPar _ e)
= do { (e', fvs_e) <- rnLCmd e
- ; return (HsCmdPar x lpar e' rpar, fvs_e) }
+ ; return (HsCmdPar noExtField e', fvs_e) }
rnCmd (HsCmdCase _ expr matches)
= do { (new_expr, e_fvs) <- rnLExpr expr
@@ -905,10 +905,10 @@ rnCmd (HsCmdIf _ _ p b1 b2)
; return (HsCmdIf noExtField ite p' b1' b2', plusFVs [fvITE, fvP, fvB1, fvB2])}
-rnCmd (HsCmdLet _ tkLet binds tkIn cmd)
+rnCmd (HsCmdLet _ binds cmd)
= rnLocalBindsAndThen binds $ \ binds' _ -> do
{ (cmd',fvExpr) <- rnLCmd cmd
- ; return (HsCmdLet noExtField tkLet binds' tkIn cmd', fvExpr) }
+ ; return (HsCmdLet noExtField binds' cmd', fvExpr) }
rnCmd (HsCmdDo _ (L l stmts))
= do { ((stmts', _), fvs) <-
@@ -931,12 +931,12 @@ 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
-methodNamesCmd (HsCmdLet _ _ _ _ c) = methodNamesLCmd c
+methodNamesCmd (HsCmdLet _ _ c) = methodNamesLCmd c
methodNamesCmd (HsCmdDo _ (L _ stmts)) = methodNamesStmts stmts
methodNamesCmd (HsCmdApp _ c _) = methodNamesLCmd c
@@ -2282,8 +2282,8 @@ isStrictPattern (L loc pat) =
WildPat{} -> False
VarPat{} -> False
LazyPat{} -> False
- AsPat _ _ _ p -> isStrictPattern p
- ParPat _ _ p _ -> isStrictPattern p
+ AsPat _ _ p -> isStrictPattern p
+ ParPat _ p -> isStrictPattern p
ViewPat _ _ p -> isStrictPattern p
SigPat _ p _ -> isStrictPattern p
BangPat{} -> True
@@ -2447,7 +2447,7 @@ isReturnApp :: MonadNames
-- If this is @Nothing@, strip the return/pure
-> Maybe (HsExpr GhcRn)
-> Maybe (LHsExpr GhcRn, Maybe Bool)
-isReturnApp monad_names (L _ (HsPar _ _ expr _)) mb_pure =
+isReturnApp monad_names (L _ (HsPar _ expr)) mb_pure =
isReturnApp monad_names expr mb_pure
isReturnApp monad_names (L loc e) mb_pure = case e of
OpApp x l op r
@@ -2460,8 +2460,8 @@ isReturnApp monad_names (L loc e) mb_pure = case e of
| is_return f -> Just (arg, Just False)
_otherwise -> Nothing
where
- is_var f (L _ (HsPar _ _ e _)) = is_var f e
- is_var f (L _ (HsAppType _ 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
is_var _ _ = False
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index a277af0ca2ee..fd169a7e0b42 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -467,12 +467,12 @@ rnLHsKind ctxt kind = rnLHsTyKi (mkTyKiEnv ctxt KindLevel RnTypeBody) kind
-- renaming a type only, not a kind
rnLHsTypeArg :: HsDocContext -> LHsTypeArg GhcPs
-> RnM (LHsTypeArg GhcRn, FreeVars)
-rnLHsTypeArg ctxt (HsValArg ty)
+rnLHsTypeArg ctxt (HsValArg _ ty)
= do { (tys_rn, fvs) <- rnLHsType ctxt ty
- ; return (HsValArg tys_rn, fvs) }
-rnLHsTypeArg ctxt (HsTypeArg l ki)
+ ; return (HsValArg noExtField tys_rn, fvs) }
+rnLHsTypeArg ctxt (HsTypeArg _ ki)
= do { (kis_rn, fvs) <- rnLHsKind ctxt ki
- ; return (HsTypeArg l kis_rn, fvs) }
+ ; return (HsTypeArg noExtField kis_rn, fvs) }
rnLHsTypeArg _ (HsArgPar sp)
= return (HsArgPar sp, emptyFVs)
@@ -638,12 +638,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
; (ty2', fvs2) <- rnLHsTyKi env ty2
; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) }
-rnHsTyKi env (HsAppKindTy _ ty at k)
+rnHsTyKi env (HsAppKindTy _ ty k)
= do { kind_app <- xoptM LangExt.TypeApplications
; unless kind_app (addErr (typeAppErr KindLevel k))
; (ty', fvs1) <- rnLHsTyKi env ty
; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
- ; return (HsAppKindTy noExtField ty' at k', fvs1 `plusFV` fvs2) }
+ ; return (HsAppKindTy noExtField ty' k', fvs1 `plusFV` fvs2) }
rnHsTyKi env t@(HsIParamTy x n ty)
= do { notInKinds env t
@@ -704,11 +704,10 @@ rnHsTyLit (HsCharTy x c) = pure (HsCharTy x c)
rnHsArrow :: RnTyKiEnv -> HsArrow GhcPs -> RnM (HsArrow GhcRn, FreeVars)
-rnHsArrow _env (HsUnrestrictedArrow arr) = return (HsUnrestrictedArrow arr, emptyFVs)
-rnHsArrow _env (HsLinearArrow (HsPct1 pct1 arr)) = return (HsLinearArrow (HsPct1 pct1 arr), emptyFVs)
-rnHsArrow _env (HsLinearArrow (HsLolly arr)) = return (HsLinearArrow (HsLolly arr), emptyFVs)
-rnHsArrow env (HsExplicitMult pct p arr)
- = (\(mult, fvs) -> (HsExplicitMult pct mult arr, fvs)) <$> rnLHsTyKi env p
+rnHsArrow _env (HsUnrestrictedArrow _) = return (HsUnrestrictedArrow noExtField, emptyFVs)
+rnHsArrow _env (HsLinearArrow _) = return (HsLinearArrow noExtField, emptyFVs)
+rnHsArrow env (HsExplicitMult _ p)
+ = (\(mult, fvs) -> (HsExplicitMult noExtField mult, fvs)) <$> rnLHsTyKi env p
{-
Note [Renaming HsCoreTys]
@@ -1201,12 +1200,10 @@ rnLHsTyVarBndrVisFlag (L loc bndr) = do
addErr (TcRnIllegalInvisTyVarBndr lbndr)
return lbndr
--- rnHsBndrVis is a no-op. We could use 'coerce' in an ideal world,
--- but GHC can't crack this nut because type families are involved:
--- HsBndrInvisible stores (LHsToken "@" pass), which is defined via XRec.
+-- rnHsBndrVis is almost a no-op, it simply discards the token for "@".
rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn
-rnHsBndrVis HsBndrRequired = HsBndrRequired
-rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at
+rnHsBndrVis (HsBndrRequired _) = HsBndrRequired noExtField
+rnHsBndrVis (HsBndrInvisible _at) = HsBndrInvisible noExtField
newTyVarNameRn, newTyVarNameRnImplicit
:: Maybe a -- associated class
@@ -1955,7 +1952,7 @@ To account for that, we introduce another helper, `filterInScopeNonClassM`,
which acts much like `filterInScopeM` but leaves class variables intact. -}
extract_tyarg :: LHsTypeArg GhcPs -> FreeKiTyVars -> FreeKiTyVars
-extract_tyarg (HsValArg ty) acc = extract_lty ty acc
+extract_tyarg (HsValArg _ ty) acc = extract_lty ty acc
extract_tyarg (HsTypeArg _ ki) acc = extract_lty ki acc
extract_tyarg (HsArgPar _) acc = acc
@@ -2016,8 +2013,8 @@ extractRdrKindSigVars (L _ resultSig) = case resultSig of
extractConDeclGADTDetailsTyVars ::
HsConDeclGADTDetails GhcPs -> FreeKiTyVars -> FreeKiTyVars
extractConDeclGADTDetailsTyVars con_args = case con_args of
- PrefixConGADT args -> extract_scaled_ltys args
- RecConGADT (L _ flds) _ -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
+ PrefixConGADT _ args -> extract_scaled_ltys args
+ RecConGADT _ (L _ flds) -> extract_ltys $ map (cd_fld_type . unLoc) $ flds
-- | Get type/kind variables mentioned in the kind signature, preserving
-- left-to-right order:
@@ -2054,7 +2051,7 @@ extract_lty (L _ ty) acc
flds
HsAppTy _ ty1 ty2 -> extract_lty ty1 $
extract_lty ty2 acc
- HsAppKindTy _ ty _ k -> extract_lty ty $
+ HsAppKindTy _ ty k -> extract_lty ty $
extract_lty k acc
HsListTy _ ty -> extract_lty ty acc
HsTupleTy _ _ tys -> extract_ltys tys acc
@@ -2103,7 +2100,7 @@ extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars ->
FreeKiTyVars
-extract_hs_arrow (HsExplicitMult _ p _) acc = extract_lty p acc
+extract_hs_arrow (HsExplicitMult _ p) acc = extract_lty p acc
extract_hs_arrow _ acc = acc
extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 48baed0ed8fe..3bd676e09f0d 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -1245,7 +1245,7 @@ validRuleLhs foralls lhs
check (OpApp _ e1 op e2) = checkl op `mplus` checkl_e e1
`mplus` checkl_e e2
check (HsApp _ e1 e2) = checkl e1 `mplus` checkl_e e2
- check (HsAppType _ e _ _) = checkl e
+ check (HsAppType _ e _) = checkl e
check (HsVar _ lv)
| (unLoc lv) `notElem` foralls = Nothing
check other = Just other -- Failure
@@ -1727,8 +1727,7 @@ rnTyClDecl (DataDecl
, tcdDataDefn = defn'
, tcdDExt = rn_info }, fvs) } }
-rnTyClDecl (ClassDecl { tcdLayout = layout,
- tcdCtxt = context, tcdLName = lcls,
+rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
tcdTyVars = tyvars, tcdFixity = fixity,
tcdFDs = fds, tcdSigs = sigs,
tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
@@ -1782,8 +1781,7 @@ rnTyClDecl (ClassDecl { tcdLayout = layout,
; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs
; docs' <- traverse rnLDocDecl docs
- ; return (ClassDecl { tcdLayout = rnLayoutInfo layout,
- tcdCtxt = context', tcdLName = lcls',
+ ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',
tcdTyVars = tyvars', tcdFixity = fixity,
tcdFDs = fds', tcdSigs = sigs',
tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',
@@ -1792,11 +1790,6 @@ rnTyClDecl (ClassDecl { tcdLayout = layout,
where
cls_doc = ClassDeclCtx lcls
-rnLayoutInfo :: LayoutInfo GhcPs -> LayoutInfo GhcRn
-rnLayoutInfo (ExplicitBraces ob cb) = ExplicitBraces ob cb
-rnLayoutInfo (VirtualBraces n) = VirtualBraces n
-rnLayoutInfo NoLayoutInfo = NoLayoutInfo
-
-- Does the data type declaration include a CUSK?
data_decl_has_cusk :: LHsQTyVars (GhcPass p) -> NewOrData -> Bool -> Maybe (LHsKind (GhcPass p')) -> RnM Bool
data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do
@@ -1915,7 +1908,7 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
is_strict (HsSrcBang _ _ s) = isSrcStrict s
- con_args (ConDeclGADT { con_g_args = PrefixConGADT args }) = args
+ con_args (ConDeclGADT { con_g_args = PrefixConGADT _ args }) = args
con_args (ConDeclH98 { con_args = PrefixCon _ args }) = args
con_args (ConDeclH98 { con_args = InfixCon arg1 arg2 }) = [arg1, arg2]
con_args _ = []
@@ -2405,7 +2398,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
, text "new_ex_dqtvs':" <+> ppr new_ex_tvs ])
; mb_doc' <- traverse rnLHsDoc mb_doc
- ; return (decl { con_ext = noAnn
+ ; return (decl { con_ext = noExtField
, con_name = new_name, con_ex_tvs = new_ex_tvs
, con_mb_cxt = new_context, con_args = new_args
, con_doc = mb_doc'
@@ -2413,7 +2406,6 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
all_fvs) }}
rnConDecl (ConDeclGADT { con_names = names
- , con_dcolon = dcol
, con_bndrs = L l outer_bndrs
, con_mb_cxt = mcxt
, con_g_args = args
@@ -2451,8 +2443,7 @@ rnConDecl (ConDeclGADT { con_names = names
; traceRn "rnConDecl (ConDeclGADT)"
(ppr names $$ ppr outer_bndrs')
; new_mb_doc <- traverse rnLHsDoc mb_doc
- ; return (ConDeclGADT { con_g_ext = noAnn, con_names = new_names
- , con_dcolon = dcol
+ ; return (ConDeclGADT { con_g_ext = noExtField, con_names = new_names
, con_bndrs = L l outer_bndrs', con_mb_cxt = new_cxt
, con_g_args = new_args, con_res_ty = new_res_ty
, con_doc = new_mb_doc },
@@ -2485,12 +2476,12 @@ rnConDeclGADTDetails ::
-> HsDocContext
-> HsConDeclGADTDetails GhcPs
-> RnM (HsConDeclGADTDetails GhcRn, FreeVars)
-rnConDeclGADTDetails _ doc (PrefixConGADT tys)
+rnConDeclGADTDetails _ doc (PrefixConGADT _ tys)
= do { (new_tys, fvs) <- mapFvRn (rnScaledLHsType doc) tys
- ; return (PrefixConGADT new_tys, fvs) }
-rnConDeclGADTDetails con doc (RecConGADT flds arr)
+ ; return (PrefixConGADT noExtField new_tys, fvs) }
+rnConDeclGADTDetails con doc (RecConGADT _ flds)
= do { (new_flds, fvs) <- rnRecConDeclFields con doc flds
- ; return (RecConGADT new_flds arr, fvs) }
+ ; return (RecConGADT noExtField new_flds, fvs) }
rnRecConDeclFields ::
Name
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index e839d79e69cc..a9190c550660 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -498,9 +498,9 @@ rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
rnPatAndThen _ (WildPat _) = return (WildPat noExtField)
-rnPatAndThen mk (ParPat x lpar pat rpar) =
+rnPatAndThen mk (ParPat _ pat) =
do { pat' <- rnLPatAndThen mk pat
- ; return (ParPat x lpar pat' rpar) }
+ ; return (ParPat noExtField pat') }
rnPatAndThen mk (LazyPat _ pat) = do { pat' <- rnLPatAndThen mk pat
; return (LazyPat noExtField pat') }
rnPatAndThen mk (BangPat _ pat) = do { pat' <- rnLPatAndThen mk pat
@@ -567,10 +567,10 @@ rnPatAndThen mk (NPlusKPat _ rdr (L l lit) _ _ _ )
(L l lit') lit' ge minus) }
-- The Report says that n+k patterns must be in Integral
-rnPatAndThen mk (AsPat _ rdr at pat)
+rnPatAndThen mk (AsPat _ rdr pat)
= do { new_name <- newPatLName mk rdr
; pat' <- rnLPatAndThen mk pat
- ; return (AsPat noExtField new_name at pat') }
+ ; return (AsPat noExtField new_name pat') }
rnPatAndThen mk p@(ViewPat _ expr pat)
= do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
@@ -633,9 +633,9 @@ rnPatAndThen mk (SplicePat _ splice)
(rn_splice, HsUntypedSpliceNested splice_name) -> return (SplicePat (HsUntypedSpliceNested splice_name) rn_splice) -- Splice was nested and thus already renamed
}
-rnPatAndThen _ (EmbTyPat _ toktype tp)
+rnPatAndThen _ (EmbTyPat _ tp)
= do { tp' <- rnHsTyPat HsTypePatCtx tp
- ; return (EmbTyPat noExtField toktype tp') }
+ ; return (EmbTyPat noExtField tp') }
--------------------
rnConPatAndThen :: NameMaker
@@ -667,9 +667,9 @@ rnConPatAndThen mk con (PrefixCon tyargs pats)
| otherwise -> addErrTc $ TcRnTypeApplicationsDisabled (TypeApplicationInPattern arg)
}
- rnConPatTyArg (HsConPatTyArg at t) = do
+ rnConPatTyArg (HsConPatTyArg _ t) = do
t' <- rnHsTyPat HsTypePatCtx t
- return (HsConPatTyArg at t')
+ return (HsConPatTyArg noExtField t')
rnConPatAndThen mk con (InfixCon pat1 pat2)
= do { con' <- lookupConCps con
@@ -1295,12 +1295,12 @@ rn_ty_pat (HsAppTy _ fun_ty arg_ty) = do
arg_ty' <- rn_lty_pat arg_ty
pure (HsAppTy noExtField fun_ty' arg_ty')
-rn_ty_pat (HsAppKindTy _ ty at ki) = do
+rn_ty_pat (HsAppKindTy _ ty ki) = do
kind_app <- liftRn $ xoptM LangExt.TypeApplications
unless kind_app (liftRn $ addErr (typeAppErr KindLevel ki))
ty' <- rn_lty_pat ty
ki' <- rn_lty_pat ki
- pure (HsAppKindTy noExtField ty' at ki')
+ pure (HsAppKindTy noExtField ty' ki')
rn_ty_pat (HsFunTy an mult lhs rhs) = do
lhs' <- rn_lty_pat lhs
@@ -1412,11 +1412,10 @@ rn_ty_pat ty@(XHsType{}) = do
liftRnFV $ rnHsType ctxt ty
rn_ty_pat_arrow :: HsArrow GhcPs -> TPRnM (HsArrow GhcRn)
-rn_ty_pat_arrow (HsUnrestrictedArrow arr) = pure (HsUnrestrictedArrow arr)
-rn_ty_pat_arrow (HsLinearArrow (HsPct1 pct1 arr)) = pure (HsLinearArrow (HsPct1 pct1 arr))
-rn_ty_pat_arrow (HsLinearArrow (HsLolly arr)) = pure (HsLinearArrow (HsLolly arr))
-rn_ty_pat_arrow (HsExplicitMult pct p arr)
- = rn_lty_pat p <&> (\mult -> HsExplicitMult pct mult arr)
+rn_ty_pat_arrow (HsUnrestrictedArrow _) = pure (HsUnrestrictedArrow noExtField)
+rn_ty_pat_arrow (HsLinearArrow _) = pure (HsLinearArrow noExtField)
+rn_ty_pat_arrow (HsExplicitMult _ p)
+ = rn_lty_pat p <&> (\mult -> HsExplicitMult noExtField mult)
check_data_kinds :: HsType GhcPs -> TPRnM ()
check_data_kinds thing = liftRn $ do
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 759f28071edf..a2e06cc188da 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -732,7 +732,7 @@ genHsVar :: Name -> HsExpr GhcRn
genHsVar nm = HsVar noExtField $ wrapGenSpan nm
genAppType :: HsExpr GhcRn -> HsType (NoGhcTc GhcRn) -> HsExpr GhcRn
-genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) noHsTok (mkEmptyWildCardBndrs (wrapGenSpan ty))
+genAppType expr ty = HsAppType noExtField (wrapGenSpan expr) (mkEmptyWildCardBndrs (wrapGenSpan ty))
genLHsLit :: (NoAnn an) => HsLit GhcRn -> LocatedAn an (HsExpr GhcRn)
genLHsLit = wrapGenSpan . HsLit noAnn
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index ff63fd80f634..ac62cf384d45 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -858,7 +858,7 @@ gen_Ix_binds loc (DerivInstTys{dit_rep_tc = tycon}) = do
enum_index
= mkSimpleGeneratedFunBind loc unsafeIndex_RDR
- [noLocA (AsPat noAnn (noLocA c_RDR) noHsTok
+ [noLocA (AsPat noAnn (noLocA c_RDR)
(nlTuplePat [a_Pat, nlWildPat] Boxed)),
d_Pat] (
untag_Expr [(a_RDR, ah_RDR)] (
@@ -2100,7 +2100,7 @@ gen_Newtype_fam_insts loc' cls inst_tvs inst_tys rhs_ty
rep_cvs' = scopedSort rep_cvs
nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlHsAppType e s = noLocA (HsAppType noExtField e noHsTok hs_ty)
+nlHsAppType e s = noLocA (HsAppType noAnn e hs_ty)
where
hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec $ nlHsCoreTy s
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index a9bf54b25418..a81c3b217553 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -445,7 +445,7 @@ tcValArgs do_ql args
tc_arg :: HsExprArg 'TcpInst -> TcM (HsExprArg 'TcpTc)
tc_arg (EPrag l p) = return (EPrag l (tcExprPrag p))
tc_arg (EWrap w) = return (EWrap w)
- tc_arg (ETypeArg l at hs_ty ty) = return (ETypeArg l at hs_ty ty)
+ tc_arg (ETypeArg l hs_ty ty) = return (ETypeArg l hs_ty ty)
tc_arg eva@(EValArg { eva_arg = arg, eva_arg_ty = Scaled mult arg_ty
, eva_ctxt = ctxt })
@@ -647,10 +647,10 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args
= go1 delta (EPrag sp prag : acc) so_far fun_ty args
-- Rule ITYARG from Fig 4 of the QL paper
- go1 delta acc so_far fun_ty ( ETypeArg { eva_ctxt = ctxt, eva_at = at, eva_hs_ty = hs_ty }
+ go1 delta acc so_far fun_ty ( ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty }
: rest_args )
= do { (ty_arg, inst_ty) <- tcVTA fun_conc_tvs fun_ty hs_ty
- ; let arg' = ETypeArg { eva_ctxt = ctxt, eva_at = at, eva_hs_ty = hs_ty, eva_ty = ty_arg }
+ ; let arg' = ETypeArg { eva_ctxt = ctxt, eva_hs_ty = hs_ty, eva_ty = ty_arg }
; go delta (arg' : acc) so_far inst_ty rest_args }
-- Rule IVAR from Fig 4 of the QL paper:
@@ -750,8 +750,8 @@ looks_like_type_arg EValArg{ eva_arg = ValArg (L _ e) } =
-- type arguments without the `type` qualifier, so `f True` could
-- instantiate `forall (b :: Bool) -> t`.
case stripParensHsExpr e of
- HsEmbTy _ _ _ -> True
- _ -> False
+ HsEmbTy _ _ -> True
+ _ -> False
looks_like_type_arg _ = False
addArgCtxt :: AppCtxt -> LHsExpr GhcRn
@@ -817,7 +817,7 @@ tcVDQ conc_tvs (tvb, inner_ty) arg
expr_to_type :: LHsExpr GhcRn -> TcM (LHsWcType GhcRn)
expr_to_type earg =
case stripParensLHsExpr earg of
- L _ (HsEmbTy _ _ hs_ty) ->
+ L _ (HsEmbTy _ hs_ty) ->
-- The entire type argument is guarded with the `type` herald,
-- e.g. `vfun (type (Maybe Int))`. This special case supports
-- named wildcards. See Note [Wildcards in the T2T translation]
@@ -829,7 +829,7 @@ expr_to_type earg =
HsWC [] <$> go e
where
go :: LHsExpr GhcRn -> TcM (LHsType GhcRn)
- go (L _ (HsEmbTy _ _ t)) =
+ go (L _ (HsEmbTy _ t)) =
-- HsEmbTy means there is an explicit `type` herald, e.g. vfun :: forall a -> blah
-- and the call vfun (type Int)
-- or vfun (Int -> type Int)
@@ -843,10 +843,10 @@ expr_to_type earg =
do { lhs' <- go lhs
; rhs' <- go rhs
; return (L l (HsAppTy noExtField lhs' rhs')) }
- go (L l (HsAppType _ lhs at rhs)) =
+ go (L l (HsAppType _ lhs rhs)) =
do { lhs' <- go lhs
; rhs' <- unwrap_wc rhs
- ; return (L l (HsAppKindTy noExtField lhs' at rhs')) }
+ ; return (L l (HsAppKindTy noExtField lhs' rhs')) }
go (L l e@(OpApp _ lhs op rhs)) =
do { lhs' <- go lhs
; op' <- go op
@@ -888,7 +888,7 @@ expr_to_type earg =
| otherwise = illegal_implicit_tvs bndrs
unwrap_sig (L l (HsSig _ HsOuterExplicit{hso_bndrs=bndrs} body)) =
return $ L l (HsForAllTy noExtField (HsForAllInvis noAnn bndrs) body)
- go (L l (HsPar _ _ e _)) =
+ go (L l (HsPar _ e)) =
do { t <- go e
; return (L l (HsParTy noAnn t)) }
go (L l (HsUntypedSplice splice_result splice))
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 411b5457a292..69bbe17654e2 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -150,15 +150,15 @@ tcCmd env (L loc cmd) cmd_ty@(_, res_ty)
; return (L loc cmd') }
tc_cmd :: CmdEnv -> HsCmd GhcRn -> CmdType -> TcM (HsCmd GhcTc)
-tc_cmd env (HsCmdPar x lpar cmd rpar) res_ty
+tc_cmd env (HsCmdPar x cmd) res_ty
= do { cmd' <- tcCmd env cmd res_ty
- ; return (HsCmdPar x lpar cmd' rpar) }
+ ; return (HsCmdPar x cmd') }
-tc_cmd env (HsCmdLet x tkLet binds tkIn (L body_loc body)) res_ty
+tc_cmd env (HsCmdLet x binds (L body_loc body)) res_ty
= do { (binds', _, body') <- tcLocalBinds binds $
setSrcSpan (locA body_loc) $
tc_cmd env body res_ty
- ; return (HsCmdLet x tkLet binds' tkIn (L body_loc body')) }
+ ; return (HsCmdLet x binds' (L body_loc body')) }
tc_cmd env in_cmd@(HsCmdCase x scrut matches) (stk, res_ty)
= addErrCtxt (cmdCtxt in_cmd) $ do
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 9c4263c49c15..6079f9e3cc3f 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -630,7 +630,7 @@ tcPolyCheck prag_fn
= do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc)
; mono_name <- newNameAt (nameOccName name) (locA nm_loc)
- ; mult <- tcMultAnn HsNoMultAnn
+ ; mult <- tcMultAnn (HsNoMultAnn noExtField)
; (wrap_gen, (wrap_res, matches'))
<- setSrcSpan sig_loc $ -- Sets the binding location for the skolems
tcSkolemiseScoped ctxt (idType poly_id) $ \rho_ty ->
@@ -806,8 +806,8 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list
where
manyIfPat bind@(L _ (PatBind{pat_lhs=(L _ (VarPat{}))}))
= return bind
- manyIfPat (L loc pat@(PatBind {pat_mult=MultAnn{mult_ext=pat_mult}, pat_lhs=lhs, pat_ext =(pat_ty,_)}))
- = do { mult_co_wrap <- tcSubMult NonLinearPatternOrigin ManyTy pat_mult
+ manyIfPat (L loc pat@(PatBind {pat_mult=mult_ann, pat_lhs=lhs, pat_ext =(pat_ty,_)}))
+ = do { mult_co_wrap <- tcSubMult NonLinearPatternOrigin ManyTy (getTcMultAnn mult_ann)
-- The wrapper checks for correct multiplicities.
-- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
; let lhs' = mkLHsWrapPat mult_co_wrap lhs pat_ty
@@ -1366,7 +1366,7 @@ tcMonoBinds is_rec sig_fn no_gen
| NonRecursive <- is_rec -- ...binder isn't mentioned in RHS
, Nothing <- sig_fn name -- ...with no type signature
= setSrcSpanA b_loc $
- do { mult <- tcMultAnn HsNoMultAnn
+ do { mult <- tcMultAnn (HsNoMultAnn noExtField)
; ((co_fn, matches'), rhs_ty')
<- tcInferFRR (FRRBinder name) $ \ exp_ty ->
@@ -1390,7 +1390,7 @@ tcMonoBinds is_rec sig_fn no_gen
-- SPECIAL CASE 2: see Note [Special case for non-recursive pattern bindings]
tcMonoBinds is_rec sig_fn no_gen
- [L b_loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = MultAnn{mult_ann=mult_ann} })]
+ [L b_loc (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_ann })]
| NonRecursive <- is_rec -- ...binder isn't mentioned in RHS
, all (isNothing . sig_fn) bndrs
= addErrCtxt (patMonoBindsCtxt pat grhss) $
@@ -1433,7 +1433,7 @@ tcMonoBinds is_rec sig_fn no_gen
; return ( unitBag $ L b_loc $
PatBind { pat_lhs = pat', pat_rhs = grhss'
, pat_ext = (pat_ty, ([],[]))
- , pat_mult = MultAnn {mult_ext=mult, mult_ann=mult_ann} }
+ , pat_mult = setTcMultAnn mult mult_ann }
, mbis ) }
where
@@ -1561,12 +1561,12 @@ tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name
-- Just g = ...f...
-- Hence always typechecked with InferGen
do { mono_info <- tcLhsSigId no_gen (name, sig)
- ; mult <- tcMultAnn HsNoMultAnn
+ ; mult <- tcMultAnn (HsNoMultAnn noExtField)
; return (TcFunBind mono_info (locA nm_loc) mult matches) }
| otherwise -- No type signature
= do { mono_ty <- newOpenFlexiTyVarTy
- ; mult <- tcMultAnn HsNoMultAnn
+ ; mult <- tcMultAnn (HsNoMultAnn noExtField)
; mono_id <- newLetBndr no_gen name mult mono_ty
; let mono_info = MBI { mbi_poly_name = name
, mbi_sig = Nothing
@@ -1574,7 +1574,7 @@ tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name
, mbi_mono_mult = mult}
; return (TcFunBind mono_info (locA nm_loc) mult matches) }
-tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = MultAnn{mult_ann=mult_ann} })
+tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_mult = mult_ann })
= -- See Note [Typechecking pattern bindings]
do { sig_mbis <- mapM (tcLhsSigId no_gen) sig_names
@@ -1671,7 +1671,7 @@ tcRhs (TcPatBind infos pat' mult mult_ann grhss pat_ty)
; return ( PatBind { pat_lhs = pat', pat_rhs = grhss'
, pat_ext = (pat_ty, ([],[]))
- , pat_mult = MultAnn{mult_ext=mult, mult_ann=mult_ann} } )}
+ , pat_mult = setTcMultAnn mult mult_ann } )}
-- | @'tcMultAnn' ann@ takes an optional multiplicity annotation. If
@@ -1680,7 +1680,7 @@ tcRhs (TcPatBind infos pat' mult mult_ann grhss pat_ty)
tcMultAnn :: HsMultAnn GhcRn -> TcM Mult
tcMultAnn (HsPct1Ann _) = return oneDataConTy
tcMultAnn (HsMultAnn _ p) = tcCheckLHsType p (TheKind multiplicityTy)
-tcMultAnn HsNoMultAnn = newFlexiTyVarTy multiplicityTy
+tcMultAnn (HsNoMultAnn _) = newFlexiTyVarTy multiplicityTy
tcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a
tcExtendTyVarEnvForRhs Nothing thing_inside
@@ -1899,7 +1899,7 @@ decideGeneralisationPlan dflags top_lvl closed sig_fn lbinds
Just (TcIdSig (PartialSig {})) -> True
_ -> False
has_mult_anns_and_pats = any has_mult_ann_and_pat lbinds
- has_mult_ann_and_pat (L _ (PatBind{pat_mult=MultAnn{mult_ann=HsNoMultAnn}})) = False
+ has_mult_ann_and_pat (L _ (PatBind{pat_mult=HsNoMultAnn{}})) = False
has_mult_ann_and_pat (L _ (PatBind{pat_lhs=(L _ (VarPat{}))})) = False
has_mult_ann_and_pat (L _ (PatBind{})) = True
has_mult_ann_and_pat _ = False
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 215f7401e712..466766a53a1d 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -230,9 +230,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 lpar expr rpar) res_ty
+tcExpr (HsPar x expr) res_ty
= do { expr' <- tcMonoExprNC expr res_ty
- ; return (HsPar x lpar expr' rpar) }
+ ; return (HsPar x expr') }
tcExpr (HsPragE x prag expr) res_ty
= do { expr' <- tcMonoExpr expr res_ty
@@ -347,12 +347,12 @@ tcExpr (ExplicitSum _ alt arity expr) res_ty
************************************************************************
-}
-tcExpr (HsLet x tkLet binds tkIn expr) res_ty
+tcExpr (HsLet x binds expr) res_ty
= do { (binds', wrapper, expr') <- tcLocalBinds binds $
tcMonoExpr expr res_ty
-- The wrapper checks for correct multiplicities.
-- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
- ; return (HsLet x tkLet binds' tkIn (mkLHsWrap wrapper expr')) }
+ ; return (HsLet x binds' (mkLHsWrap wrapper expr')) }
tcExpr (HsCase x scrut matches) res_ty
= do { -- We used to typecheck the case alternatives first.
@@ -470,7 +470,7 @@ tcExpr (HsStatic fvs expr) res_ty
(L (noAnnSrcSpan loc) (HsStatic (fvs, mkTyConApp static_ptr_ty_con [expr_ty]) expr'))
}
-tcExpr (HsEmbTy _ _ _) _ = failWith TcRnIllegalTypeExpr
+tcExpr (HsEmbTy _ _) _ = failWith TcRnIllegalTypeExpr
{-
************************************************************************
@@ -1305,7 +1305,7 @@ desugarRecordUpd record_expr possible_parents rbnds res_ty
-- STEP 2 (b): desugar to HsCase, as per note [Record Updates]
; let ds_expr :: HsExpr GhcRn
- ds_expr = HsLet noExtField noHsTok let_binds noHsTok (L gen case_expr)
+ ds_expr = HsLet noExtField let_binds (L gen case_expr)
case_expr :: HsExpr GhcRn
case_expr = HsCase RecUpd record_expr
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 4c8e4c9d92cd..8a8ff0c31652 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -175,7 +175,6 @@ data HsExprArg (p :: TcPass)
, eva_arg_ty :: !(XEVAType p) }
| ETypeArg { eva_ctxt :: AppCtxt
- , eva_at :: !(LHsToken "@" GhcRn)
, eva_hs_ty :: LHsWcType GhcRn -- The type arg
, eva_ty :: !(XETAType p) } -- Kind-checked type arg
@@ -271,10 +270,10 @@ mkEValArg :: AppCtxt -> LHsExpr GhcRn -> HsExprArg 'TcpRn
mkEValArg ctxt e = EValArg { eva_arg = ValArg e, eva_ctxt = ctxt
, eva_arg_ty = noExtField }
-mkETypeArg :: AppCtxt -> LHsToken "@" GhcRn -> LHsWcType GhcRn -> HsExprArg 'TcpRn
-mkETypeArg ctxt at hs_ty =
+mkETypeArg :: AppCtxt -> LHsWcType GhcRn -> HsExprArg 'TcpRn
+mkETypeArg ctxt hs_ty =
ETypeArg { eva_ctxt = ctxt
- , eva_at = at, eva_hs_ty = hs_ty
+ , eva_hs_ty = hs_ty
, eva_ty = noExtField }
addArgWrap :: HsWrapper -> [HsExprArg p] -> [HsExprArg p]
@@ -296,9 +295,9 @@ splitHsApps e = go e (top_ctxt 0 e) []
-- Always returns VACall fun n_val_args noSrcSpan
-- to initialise the argument splitting in 'go'
-- See Note [AppCtxt]
- 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 (HsAppType _ fun _) = top_lctxt (n+1) fun
top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun
top_ctxt n (XExpr (HsExpanded orig _)) = VACall orig n noSrcSpan
top_ctxt n other_fun = VACall other_fun n noSrcSpan
@@ -308,9 +307,9 @@ splitHsApps e = go e (top_ctxt 0 e) []
go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn]
-> TcM ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
-- Modify the AppCtxt as we walk inwards, so it describes the next argument
- 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) at ty) ctxt args = go fun (dec l ctxt) (mkETypeArg ctxt at ty : 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)
-- See Note [Looking through HsExpanded]
@@ -384,8 +383,8 @@ rebuild_hs_apps fun ctxt (arg : args)
= case arg of
EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt' }
-> rebuild_hs_apps (HsApp noAnn lfun arg) ctxt' args
- ETypeArg { eva_hs_ty = hs_ty, eva_at = at, eva_ty = ty, eva_ctxt = ctxt' }
- -> rebuild_hs_apps (HsAppType ty lfun at hs_ty) ctxt' args
+ ETypeArg { eva_hs_ty = hs_ty, eva_ty = ty, eva_ctxt = ctxt' }
+ -> rebuild_hs_apps (HsAppType ty lfun hs_ty) ctxt' args
EPrag ctxt' p
-> rebuild_hs_apps (HsPragE noExtField p lfun) ctxt' args
EWrap (EPar ctxt')
@@ -938,7 +937,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/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index eb31e4177cdf..337175175a04 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -1175,7 +1175,7 @@ tc_hs_type mode (HsFunTy _ mult ty1 ty2) exp_kind
tc_hs_type mode (HsOpTy _ _ ty1 (L _ op) ty2) exp_kind
| op `hasKey` unrestrictedFunTyConKey
- = tc_fun_type mode (HsUnrestrictedArrow noHsUniTok) ty1 ty2 exp_kind
+ = tc_fun_type mode (HsUnrestrictedArrow noExtField) ty1 ty2 exp_kind
--------- Foralls
tc_hs_type mode t@(HsForAllTy { hst_tele = tele, hst_body = ty }) exp_kind
@@ -1551,12 +1551,12 @@ splitHsAppTys hs_ty
-> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]
-> (LHsType GhcRn,
[HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp
- go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as)
- go (L _ (HsAppKindTy _ ty at k)) as = go ty (HsTypeArg at k : as)
+ go (L _ (HsAppTy _ f a)) as = go f (HsValArg noExtField a : as)
+ go (L _ (HsAppKindTy _ ty k)) as = go ty (HsTypeArg noExtField k : as)
go (L sp (HsParTy _ f)) as = go f (HsArgPar (locA sp) : as)
go (L _ (HsOpTy _ prom l op@(L sp _) r)) as
= ( L (l2l sp) (HsTyVar noAnn prom op)
- , HsValArg l : HsValArg r : as )
+ , HsValArg noExtField l : HsValArg noExtField r : as )
go f as = (f, as)
---------------------------
@@ -1672,7 +1672,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
ty_app_err ki_arg substed_fun_ki
---------------- HsValArg: a normal argument (fun ty)
- (HsValArg arg : args, Just (ki_binder, inner_ki))
+ (HsValArg _ arg : args, Just (ki_binder, inner_ki))
-- next binder is invisible; need to instantiate it
| Named (Bndr kv flag) <- ki_binder
, isInvisibleForAllTyFlag flag -- ForAllTy with Inferred or Specified
@@ -1693,7 +1693,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
; go (n+1) fun' subst' inner_ki args }
-- no binder; try applying the substitution, or infer another arrow in fun kind
- (HsValArg _ : _, Nothing)
+ (HsValArg _ _ : _, Nothing)
-> try_again_after_substing_or $
do { let arrows_needed = n_initial_val_args all_args
; co <- matchExpectedFunKind (HsTypeRnThing $ unLoc hs_ty) arrows_needed substed_fun_ki
@@ -1920,10 +1920,10 @@ unsaturated arguments: see #11246. Hence doing this in tcInferApps.
appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn
appTypeToArg f [] = f
-appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args
+appTypeToArg f (HsValArg _ arg : args) = appTypeToArg (mkHsAppTy f arg) args
appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args
-appTypeToArg f (HsTypeArg at arg : args)
- = appTypeToArg (mkHsAppKindTy f at arg) args
+appTypeToArg f (HsTypeArg _ arg : args)
+ = appTypeToArg (mkHsAppKindTy noExtField f arg) args
{- *********************************************************************
@@ -2470,7 +2470,7 @@ mkExplicitTyConBinder :: TyCoVarSet -- variables that are used dependently
-> TyConBinder
mkExplicitTyConBinder dep_set (Bndr tv flag) =
case flag of
- HsBndrRequired -> mkRequiredTyConBinder dep_set tv
+ HsBndrRequired{} -> mkRequiredTyConBinder dep_set tv
HsBndrInvisible{} -> mkNamedTyConBinder Specified tv
-- | Kind-check a 'LHsQTyVars'. Used in 'inferInitialKind' (for tycon kinds and
@@ -2741,7 +2741,7 @@ matchUpSigWithDecl name sig_tcbs sig_res_kind hs_bndrs thing_inside
-- See GHC Proposal #425, section "Kind checking",
-- where zippable and skippable are defined.
zippable :: TyConBndrVis -> HsBndrVis GhcRn -> Bool
- zippable vis HsBndrRequired = isVisibleTcbVis vis
+ zippable vis (HsBndrRequired _) = isVisibleTcbVis vis
zippable vis (HsBndrInvisible _) = isInvisSpecTcbVis vis
-- See GHC Proposal #425, section "Kind checking",
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index bb1a6ab6d3ff..178c85a24a8f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -112,12 +112,12 @@ tcLetPat sig_fn no_gen pat pat_ty thing_inside
| otherwise = not_xstrict lpat
where
xstrict (L _ (LazyPat _ _)) = checkManyPattern pat_ty
- xstrict (L _ (ParPat _ _ p _)) = xstrict p
+ xstrict (L _ (ParPat _ p)) = xstrict p
xstrict _ = return WpHole
not_xstrict (L _ (BangPat _ _)) = return WpHole
not_xstrict (L _ (VarPat _ _)) = return WpHole
- not_xstrict (L _ (ParPat _ _ p _)) = not_xstrict p
+ not_xstrict (L _ (ParPat _ p)) = not_xstrict p
not_xstrict _ = checkManyPattern pat_ty
-----------------
@@ -402,20 +402,20 @@ tc_tt_pat
-- ^ Fully refined result type
-> Checker (Pat GhcRn) (Pat GhcTc)
-- ^ Translated pattern
-tc_tt_pat pat_ty penv (ParPat x lpar pat rpar) thing_inside = do
+tc_tt_pat pat_ty penv (ParPat x pat) thing_inside = do
{ (pat', res) <- tc_tt_lpat pat_ty penv pat thing_inside
- ; return (ParPat x lpar pat' rpar, res) }
+ ; return (ParPat x pat', res) }
tc_tt_pat (ExpFunPatTy pat_ty) penv pat thing_inside = tc_pat pat_ty penv pat thing_inside
tc_tt_pat (ExpForAllPatTy tv) penv pat thing_inside = tc_forall_pat penv (pat, tv) thing_inside
tc_forall_pat :: Checker (Pat GhcRn, TcTyVar) (Pat GhcTc)
-tc_forall_pat _ (EmbTyPat _ toktype tp, tv) thing_inside
+tc_forall_pat _ (EmbTyPat _ tp, tv) thing_inside
-- The entire type pattern is guarded with the `type` herald:
-- f (type t) (x :: t) = ...
-- This special case is not necessary for correctness but avoids
-- a redundant `ExpansionPat` node.
= do { (arg_ty, result) <- tc_ty_pat tp tv thing_inside
- ; return (EmbTyPat arg_ty toktype tp, result) }
+ ; return (EmbTyPat arg_ty tp, result) }
tc_forall_pat _ (pat, tv) thing_inside
-- The type pattern is not guarded with the `type` herald, or perhaps
-- only parts of it are, e.g.
@@ -424,14 +424,14 @@ tc_forall_pat _ (pat, tv) thing_inside
-- Apply a recursive T2T transformation.
= do { tp <- pat_to_type_pat pat
; (arg_ty, result) <- tc_ty_pat tp tv thing_inside
- ; let pat' = XPat $ ExpansionPat pat (EmbTyPat arg_ty noHsTok tp)
+ ; let pat' = XPat $ ExpansionPat pat (EmbTyPat arg_ty tp)
; return (pat', result) }
-- Convert a Pat into the equivalent HsTyPat.
-- See `expr_to_type` (GHC.Tc.Gen.App) for the HsExpr counterpart.
-- The `TcM` monad is only used to fail on ill-formed type patterns.
pat_to_type_pat :: Pat GhcRn -> TcM (HsTyPat GhcRn)
-pat_to_type_pat (EmbTyPat _ _ tp) = return tp
+pat_to_type_pat (EmbTyPat _ tp) = return tp
pat_to_type_pat (VarPat _ lname) = return (HsTP x b)
where b = noLocA (HsTyVar noAnn NotPromoted lname)
x = HsTPRn { hstp_nwcs = []
@@ -456,7 +456,7 @@ pat_to_type_pat (SigPat _ pat sig_ty)
= HsTPRn { hstp_nwcs = hstp_nwcs t ++ hsps_nwcs p
, hstp_imp_tvs = hstp_imp_tvs t ++ hsps_imp_tvs p
, hstp_exp_tvs = hstp_exp_tvs t }
-pat_to_type_pat (ParPat _ _ pat _)
+pat_to_type_pat (ParPat _ pat)
= do { HsTP x t <- pat_to_type_pat (unLoc pat)
; return (HsTP x (noLocA (HsParTy noAnn t))) }
pat_to_type_pat pat =
@@ -498,9 +498,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 lpar pat rpar -> do
+ ParPat x pat -> do
{ (pat', res) <- tc_lpat pat_ty penv pat thing_inside
- ; return (ParPat x lpar pat' rpar, res) }
+ ; return (ParPat x pat', res) }
BangPat x pat -> do
{ (pat', res) <- tc_lpat pat_ty penv pat thing_inside
@@ -531,7 +531,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
; pat_ty <- expTypeToType (scaledThing pat_ty)
; return (mkHsWrapPat mult_wrap (WildPat pat_ty) pat_ty, res) }
- AsPat x (L nm_loc name) at pat -> do
+ AsPat x (L nm_loc name) pat -> do
{ mult_wrap <- checkManyPattern pat_ty
-- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
; (wrap, bndr_id) <- setSrcSpanA nm_loc (tcPatBndr penv name pat_ty)
@@ -546,7 +546,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
--
-- If you fix it, don't forget the bindInstsOfPatIds!
; pat_ty <- readExpType (scaledThing pat_ty)
- ; return (mkHsWrapPat (wrap <.> mult_wrap) (AsPat x (L nm_loc bndr_id) at pat') pat_ty, res) }
+ ; return (mkHsWrapPat (wrap <.> mult_wrap) (AsPat x (L nm_loc bndr_id) pat') pat_ty, res) }
ViewPat _ expr pat -> do
{ mult_wrap <- checkManyPattern pat_ty
@@ -822,7 +822,7 @@ AST is used for the subtraction operation.
SplicePat (HsUntypedSpliceNested _) _ -> panic "tc_pat: nested splice in splice pat"
- EmbTyPat _ _ _ -> failWith TcRnIllegalTypePattern
+ EmbTyPat _ _ -> failWith TcRnIllegalTypePattern
XPat (HsPatExpanded lpat rpat) -> do
{ (rpat', res) <- tc_pat pat_ty penv rpat thing_inside
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index f0804f023e42..94b62a7ca4db 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -298,7 +298,7 @@ no_anon_wc_ty lty = go lty
go (L _ ty) = case ty of
HsWildCardTy _ -> False
HsAppTy _ ty1 ty2 -> go ty1 && go ty2
- HsAppKindTy _ ty _ ki -> go ty && go ki
+ HsAppKindTy _ ty ki -> go ty && go ki
HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && go (arrowToHsType w)
HsListTy _ ty -> go ty
HsTupleTy _ _ tys -> gos tys
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index b00eaf91c525..2c2d60c7b1be 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -1817,8 +1817,8 @@ kcConH98Args new_or_data res_kind con_args = case con_args of
-- Kind-check the types of arguments to a GADT data constructor.
kcConGADTArgs :: NewOrData -> TcKind -> HsConDeclGADTDetails GhcRn -> TcM ()
kcConGADTArgs new_or_data res_kind con_args = case con_args of
- PrefixConGADT tys -> kcConArgTys new_or_data res_kind tys
- RecConGADT (L _ flds) _ -> kcConArgTys new_or_data res_kind $
+ PrefixConGADT _ tys -> kcConArgTys new_or_data res_kind tys
+ RecConGADT _ (L _ flds) -> kcConArgTys new_or_data res_kind $
map (hsLinear . cd_fld_type . unLoc) flds
kcConDecls :: Foldable f
@@ -3890,7 +3890,7 @@ tcConIsInfixGADT :: Name
tcConIsInfixGADT con details
= case details of
RecConGADT{} -> return False
- PrefixConGADT arg_tys -- See Note [Infix GADT constructors]
+ PrefixConGADT _ arg_tys -- See Note [Infix GADT constructors]
| isSymOcc (getOccName con)
, [_ty1,_ty2] <- map hsScaledThing arg_tys
-> do { fix_env <- getFixityEnv
@@ -3916,9 +3916,9 @@ tcConGADTArgs :: ContextKind -- expected kind of arguments
-- might have a specific kind
-> HsConDeclGADTDetails GhcRn
-> TcM [(Scaled TcType, HsSrcBang)]
-tcConGADTArgs exp_kind (PrefixConGADT btys)
+tcConGADTArgs exp_kind (PrefixConGADT _ btys)
= mapM (tcConArg exp_kind) btys
-tcConGADTArgs exp_kind (RecConGADT fields _)
+tcConGADTArgs exp_kind (RecConGADT _ fields)
= tcRecConDeclFields exp_kind fields
tcConArg :: ContextKind -- expected kind for args; always OpenKind for datatypes,
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 1227991fac12..f721dc789f3f 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -2232,7 +2232,7 @@ mkDefMethBind loc dfun_id clas sel_id dm_name
(_, _, _, inst_tys) = tcSplitDFunTy (idType dfun_id)
mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn
- mk_vta fun ty = noLocA (HsAppType noExtField fun noHsTok
+ mk_vta fun ty = noLocA (HsAppType noExtField fun
(mkEmptyWildCardBndrs $ nlHsParTy $ noLocA $ XHsType ty))
-- NB: use visible type application
-- See Note [Default methods in instances]
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 16f2859a51c1..5ddbc729c596 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -1031,7 +1031,7 @@ tcPatToExpr args pat = go pat
= return $ HsVar noExtField (L l var)
| otherwise
= Left (PatSynUnboundVar var)
- go1 (ParPat _ lpar pat rpar) = fmap (\e -> HsPar noAnn lpar e rpar) $ go pat
+ go1 (ParPat _ pat) = fmap (HsPar noExtField) (go pat)
go1 (ListPat _ pats)
= do { exprs <- mapM go pats
; return $ ExplicitList noExtField exprs }
@@ -1050,7 +1050,7 @@ tcPatToExpr args pat = go pat
| otherwise = return $ HsOverLit noAnn n
go1 (SplicePat (HsUntypedSpliceTop _ pat) _) = go1 pat
go1 (SplicePat (HsUntypedSpliceNested _) _) = panic "tcPatToExpr: invalid nested splice"
- go1 (EmbTyPat _ toktype tp) = return $ HsEmbTy noExtField toktype (hstp_to_hswc tp)
+ go1 (EmbTyPat _ tp) = return $ HsEmbTy noExtField (hstp_to_hswc tp)
where hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn
hstp_to_hswc (HsTP { hstp_ext = HsTPRn { hstp_nwcs = wcs }, hstp_body = hs_ty })
= HsWC { hswc_ext = wcs, hswc_body = hs_ty }
@@ -1223,8 +1223,8 @@ 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 (AsPat _ _ 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 7c624fae26ff..2d69db826b14 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -714,10 +714,10 @@ exprCtOrigin (HsOverLit _ lit) = LiteralOrigin lit
exprCtOrigin (HsLit {}) = Shouldn'tHappenOrigin "concrete literal"
exprCtOrigin (HsLam _ _ ms) = matchesCtOrigin ms
exprCtOrigin (HsApp _ e1 _) = lexprCtOrigin e1
-exprCtOrigin (HsAppType _ 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
@@ -726,7 +726,7 @@ exprCtOrigin ExplicitSum{} = Shouldn'tHappenOrigin "explicit sum"
exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches
exprCtOrigin (HsIf {}) = IfThenElseOrigin
exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs
-exprCtOrigin (HsLet _ _ _ _ e) = lexprCtOrigin e
+exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e
exprCtOrigin (HsDo {}) = DoOrigin
exprCtOrigin (RecordCon {}) = Shouldn'tHappenOrigin "record construction"
exprCtOrigin (RecordUpd {}) = RecordUpdOrigin
diff --git a/compiler/GHC/Tc/Zonk/Type.hs b/compiler/GHC/Tc/Zonk/Type.hs
index f9b4da15e4f1..cfc5c2d80787 100644
--- a/compiler/GHC/Tc/Zonk/Type.hs
+++ b/compiler/GHC/Tc/Zonk/Type.hs
@@ -723,7 +723,7 @@ zonk_bind bind@(PatBind { pat_lhs = pat, pat_rhs = grhss
= do { new_pat <- don'tBind $ zonkPat pat -- Env already extended
; new_grhss <- zonkGRHSs zonkLExpr grhss
; new_ty <- zonkTcTypeToTypeX ty
- ; new_mult <- onMultExt zonkTcTypeToTypeX mult_ann
+ ; new_mult <- zonkMultAnn mult_ann
; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss
, pat_mult = new_mult
, pat_ext = (new_ty, ticks) }) }
@@ -812,6 +812,17 @@ zonk_bind (PatSynBind x bind@(PSB { psb_id = L loc id
, psb_def = lpat'
, psb_dir = dir' } } }
+zonkMultAnn :: HsMultAnn GhcTc -> ZonkTcM (HsMultAnn GhcTc)
+zonkMultAnn (HsNoMultAnn mult)
+ = do { mult' <- zonkTcTypeToTypeX mult
+ ; return (HsNoMultAnn mult') }
+zonkMultAnn (HsPct1Ann mult)
+ = do { mult' <- zonkTcTypeToTypeX mult
+ ; return (HsPct1Ann mult') }
+zonkMultAnn (HsMultAnn mult hs_ty)
+ = do { mult' <- zonkTcTypeToTypeX mult
+ ; return (HsMultAnn mult' hs_ty) }
+
zonkPatSynDetails :: HsPatSynDetails GhcTc
-> ZonkTcM (HsPatSynDetails GhcTc)
zonkPatSynDetails (PrefixCon _ as)
@@ -950,10 +961,10 @@ zonkExpr (HsApp x e1 e2)
new_e2 <- zonkLExpr e2
return (HsApp x new_e1 new_e2)
-zonkExpr (HsAppType ty e at t)
+zonkExpr (HsAppType ty e t)
= do new_e <- zonkLExpr e
new_ty <- zonkTcTypeToTypeX ty
- return (HsAppType new_ty new_e at t)
+ return (HsAppType new_ty new_e t)
-- NB: the type is an HsType; can't zonk that!
zonkExpr (HsTypedBracket hsb_tc body)
@@ -973,9 +984,9 @@ zonkExpr (NegApp x expr op)
do { new_expr <- zonkLExpr expr
; return (NegApp x new_expr new_op) }
-zonkExpr (HsPar x lpar e rpar)
+zonkExpr (HsPar x e)
= do { new_e <- zonkLExpr e
- ; return (HsPar x lpar new_e rpar) }
+ ; return (HsPar x new_e) }
zonkExpr (SectionL x _ _) = dataConCantHappen x
zonkExpr (SectionR x _ _) = dataConCantHappen x
@@ -1014,10 +1025,10 @@ zonkExpr (HsMultiIf ty alts)
do { expr' <- zonkLExpr expr
; return $ GRHS x guard' expr' }
-zonkExpr (HsLet x tkLet binds tkIn expr)
+zonkExpr (HsLet x binds expr)
= runZonkBndrT (zonkLocalBinds binds) $ \ new_binds ->
do { new_expr <- zonkLExpr expr
- ; return (HsLet x tkLet new_binds tkIn new_expr) }
+ ; return (HsLet x new_binds new_expr) }
zonkExpr (HsDo ty do_or_lc (L l stmts))
= do new_stmts <- don'tBind $ zonkStmts zonkLExpr stmts
@@ -1062,7 +1073,7 @@ zonkExpr (HsStatic (fvs, ty) expr)
= do new_ty <- zonkTcTypeToTypeX ty
HsStatic (fvs, new_ty) <$> zonkLExpr expr
-zonkExpr (HsEmbTy x _ _) = dataConCantHappen x
+zonkExpr (HsEmbTy x _) = dataConCantHappen x
zonkExpr (XExpr (WrapExpr (HsWrap co_fn expr)))
= runZonkBndrT (zonkCoFn co_fn) $ \ new_co_fn ->
@@ -1148,9 +1159,9 @@ zonkCmd (HsCmdApp x c e)
new_e <- zonkLExpr e
return (HsCmdApp x new_c new_e)
-zonkCmd (HsCmdPar x lpar c rpar)
+zonkCmd (HsCmdPar x c)
= do new_c <- zonkLCmd c
- return (HsCmdPar x lpar new_c rpar)
+ return (HsCmdPar x new_c)
zonkCmd (HsCmdCase x expr ms)
= do new_expr <- zonkLExpr expr
@@ -1168,10 +1179,10 @@ zonkCmd (HsCmdIf x eCond ePred cThen cElse)
; new_cElse <- zonkLCmd cElse
; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) }
-zonkCmd (HsCmdLet x tkLet binds tkIn cmd)
+zonkCmd (HsCmdLet x binds cmd)
= runZonkBndrT (zonkLocalBinds binds) $ \ new_binds ->
do new_cmd <- zonkLCmd cmd
- return (HsCmdLet x tkLet new_binds tkIn new_cmd)
+ return (HsCmdLet x new_binds new_cmd)
zonkCmd (HsCmdDo ty (L l stmts))
= do new_stmts <- don'tBind $ zonkStmts zonkLCmd stmts
@@ -1470,9 +1481,9 @@ zonkPat :: LPat GhcTc -> ZonkBndrTcM (LPat GhcTc)
zonkPat pat = wrapLocZonkBndrMA zonk_pat pat
zonk_pat :: Pat GhcTc -> ZonkBndrTcM (Pat GhcTc)
-zonk_pat (ParPat x lpar p rpar)
+zonk_pat (ParPat x p)
= do { p' <- zonkPat p
- ; return (ParPat x lpar p' rpar) }
+ ; return (ParPat x p') }
zonk_pat (WildPat ty)
= do { ty' <- noBinders $ zonkTcTypeToTypeX ty
@@ -1490,10 +1501,10 @@ zonk_pat (BangPat x pat)
= do { pat' <- zonkPat pat
; return (BangPat x pat') }
-zonk_pat (AsPat x (L loc v) at pat)
+zonk_pat (AsPat x (L loc v) pat)
= do { v' <- zonkIdBndrX v
; pat' <- zonkPat pat
- ; return (AsPat x (L loc v') at pat') }
+ ; return (AsPat x (L loc v') pat') }
zonk_pat (ViewPat ty expr pat)
= do { expr' <- noBinders $ zonkLExpr expr
@@ -1573,9 +1584,9 @@ zonk_pat (NPlusKPat ty (L loc n) (L l lit1) lit2 e1 e2)
; n' <- zonkIdBndrX n
; return (NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') }
-zonk_pat (EmbTyPat ty toktype tp)
+zonk_pat (EmbTyPat ty tp)
= do { ty' <- noBinders $ zonkTcTypeToTypeX ty
- ; return (EmbTyPat ty' toktype tp) }
+ ; return (EmbTyPat ty' tp) }
zonk_pat (XPat ext) = case ext of
{ ExpansionPat orig pat->
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 5ae01c473b8f..2fe751300b00 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -224,7 +224,7 @@ cvtDec (TH.ValD pat body ds)
PatBind { pat_lhs = pat'
, pat_rhs = GRHSs emptyComments body' ds'
, pat_ext = noAnn
- , pat_mult = MultAnn{mult_ext=NoExtField, mult_ann=HsNoMultAnn}
+ , pat_mult = HsNoMultAnn noExtField
} }
cvtDec (TH.FunD nm cls)
@@ -302,7 +302,7 @@ cvtDec (ClassD ctxt cl tvs fds decs)
; unless (null adts')
(failWith $ DefaultDataInstDecl adts')
; returnJustLA $ TyClD noExtField $
- ClassDecl { tcdCExt = (noAnn, NoAnnSortKey), tcdLayout = NoLayoutInfo
+ ClassDecl { tcdCExt = (noAnn, EpNoLayout, NoAnnSortKey)
, tcdCtxt = mkHsContextMaybe cxt', tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
@@ -563,7 +563,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
, feqn_tycon = nm'
, feqn_bndrs = outer_bndrs
, feqn_pats =
- (map HsValArg args') ++ args
+ (map (HsValArg noExtField) args') ++ args
, feqn_fixity = Hs.Infix
, feqn_rhs = rhs' } }
_ -> failWith $ InvalidTyFamInstLHS lhs
@@ -618,7 +618,7 @@ cvt_datainst_hdr cxt bndrs tys
InfixT t1 nm t2 -> do { nm' <- tconNameN nm
; args' <- mapM cvtType [t1,t2]
; return (cxt', nm', outer_bndrs,
- ((map HsValArg args') ++ args)) }
+ ((map (HsValArg noExtField) args') ++ args)) }
_ -> failWith $ InvalidTypeInstanceHeader tys }
----------------
@@ -730,7 +730,7 @@ cvtConstr _ do_con_name (GadtC c strtys ty) = case nonEmpty c of
{ c' <- mapM do_con_name c
; args <- mapM cvt_arg strtys
; ty' <- cvtType ty
- ; mk_gadt_decl c' (PrefixConGADT $ map hsLinear args) ty'}
+ ; mk_gadt_decl c' (PrefixConGADT noExtField $ map hsLinear args) ty'}
cvtConstr parent_con do_con_name (RecGadtC c varstrtys ty) = case nonEmpty c of
Nothing -> failWith RecGadtNoCons
@@ -739,7 +739,7 @@ cvtConstr parent_con do_con_name (RecGadtC c varstrtys ty) = case nonEmpty c of
; ty' <- cvtType ty
; rec_flds <- mapM (cvt_id_arg parent_con) varstrtys
; lrec_flds <- returnLA rec_flds
- ; mk_gadt_decl c' (RecConGADT lrec_flds noHsUniTok) ty' }
+ ; mk_gadt_decl c' (RecConGADT noAnn lrec_flds) ty' }
mk_gadt_decl :: NonEmpty (LocatedN RdrName) -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs
-> CvtM (LConDecl GhcPs)
@@ -748,7 +748,6 @@ mk_gadt_decl names args res_ty
returnLA $ ConDeclGADT
{ con_g_ext = noAnn
, con_names = names
- , con_dcolon = noHsUniTok
, con_bndrs = bndrs
, con_mb_cxt = Nothing
, con_g_args = args
@@ -1047,7 +1046,7 @@ cvtl e = wrapLA (cvt e)
; return $ HsApp noComments e1' e2' }
cvt (AppTypeE e t) = do { e' <- parenthesizeHsExpr opPrec <$> cvtl e
; t' <- parenthesizeHsType appPrec <$> cvtType t
- ; return $ HsAppType noExtField e' noHsTok
+ ; return $ HsAppType noAnn e'
$ mkHsWildCardBndrs t' }
cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its
-- own expression to avoid pretty-printing
@@ -1080,7 +1079,7 @@ cvtl e = wrapLA (cvt e)
| otherwise = do { alts' <- mapM cvtpair alts
; return $ HsMultiIf noAnn alts' }
cvt (LetE ds e) = do { ds' <- cvtLocalDecs LetExpression ds
- ; e' <- cvtl e; return $ HsLet noAnn noHsTok ds' noHsTok e'}
+ ; e' <- cvtl e; return $ HsLet noAnn ds' e'}
cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
; th_origin <- getOrigin
; wrapParLA (HsCase noAnn e' . mkMatchGroup th_origin) ms' }
@@ -1166,7 +1165,7 @@ cvtl e = wrapLA (cvt e)
cvt (TypedBracketE e) = do { e' <- cvtl e
; return $ HsTypedBracket noAnn e' }
cvt (TypeE t) = do { t' <- cvtType t
- ; return $ HsEmbTy noExtField noHsTok (mkHsWildCardBndrs t') }
+ ; return $ HsEmbTy noAnn (mkHsWildCardBndrs t') }
{- | #16895 Ensure an infix expression's operator is a variable/constructor.
Consider this example:
@@ -1441,7 +1440,7 @@ cvtp (ConP s ts ps) = do { s' <- cNameN s
; ps' <- cvtPats ps
; ts' <- mapM cvtType ts
; let pps = map (parenthesizePat appPrec) ps'
- pts = map (\t -> HsConPatTyArg noHsTok (mkHsTyPat noAnn t)) ts'
+ pts = map (\t -> HsConPatTyArg noAnn (mkHsTyPat noAnn t)) ts'
; return $ ConPat
{ pat_con_ext = noAnn
, pat_con = s'
@@ -1467,7 +1466,7 @@ cvtp (ParensP p) = do { p' <- cvtPat 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
- ; return $ AsPat noAnn s' noHsTok p' }
+ ; return $ AsPat noAnn s' p' }
cvtp TH.WildP = return $ WildPat noExtField
cvtp (RecP c fs) = do { c' <- cNameN c; fs' <- mapM cvtPatFld fs
; return $ ConPat
@@ -1484,7 +1483,7 @@ cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; return $ ViewPat noAnn e' p'}
cvtp (TypeP t) = do { t' <- cvtType t
- ; return $ EmbTyPat noExtField noHsTok (mkHsTyPat noAnn t') }
+ ; return $ EmbTyPat noAnn (mkHsTyPat noAnn t') }
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (s,p)
@@ -1529,8 +1528,8 @@ instance CvtFlag TH.Specificity Hs.Specificity where
cvtFlag TH.InferredSpec = Hs.InferredSpec
instance CvtFlag TH.BndrVis (HsBndrVis GhcPs) where
- cvtFlag TH.BndrReq = HsBndrRequired
- cvtFlag TH.BndrInvis = HsBndrInvisible noHsTok
+ cvtFlag TH.BndrReq = HsBndrRequired noExtField
+ cvtFlag TH.BndrInvis = HsBndrInvisible noAnn
cvtTvs :: CvtFlag flag flag' => [TH.TyVarBndr flag] -> CvtM [LHsTyVarBndr flag' GhcPs]
cvtTvs tvs = mapM cvt_tv tvs
@@ -1606,7 +1605,7 @@ cvtTypeKind :: TypeOrKind -> TH.Type -> CvtM (LHsType GhcPs)
cvtTypeKind typeOrKind ty
= do { (head_ty, tys') <- split_ty_app ty
; let m_normals = mapM extract_normal tys'
- where extract_normal (HsValArg ty) = Just ty
+ where extract_normal (HsValArg _ ty) = Just ty
extract_normal _ = Nothing
; case head_ty of
@@ -1643,7 +1642,7 @@ cvtTypeKind typeOrKind ty
_ -> return $
parenthesizeHsType sigPrec x'
let y'' = parenthesizeHsType sigPrec y'
- returnLA (HsFunTy noAnn (HsUnrestrictedArrow noHsUniTok) x'' y'')
+ returnLA (HsFunTy noAnn (HsUnrestrictedArrow noAnn) x'' y'')
| otherwise
-> do { fun_tc <- returnLA $ getRdrName unrestrictedFunTyCon
; mk_apps (HsTyVar noAnn NotPromoted fun_tc) tys' }
@@ -1719,7 +1718,7 @@ cvtTypeKind typeOrKind ty
; ls' <- returnLA s'
; mk_apps
(HsTyVar noAnn prom ls')
- ([HsValArg t1', HsValArg t2'] ++ tys')
+ ([HsValArg noExtField t1', HsValArg noExtField t2'] ++ tys')
}
UInfixT t1 s t2
@@ -1735,7 +1734,7 @@ cvtTypeKind typeOrKind ty
; t2' <- cvtType t2
; mk_apps
(HsTyVar noAnn IsPromoted s')
- ([HsValArg t1', HsValArg t2'] ++ tys')
+ ([HsValArg noExtField t1', HsValArg noExtField t2'] ++ tys')
}
PromotedUInfixT t1 s t2
@@ -1809,9 +1808,9 @@ cvtTypeKind typeOrKind ty
hsTypeToArrow :: LHsType GhcPs -> HsArrow GhcPs
hsTypeToArrow w = case unLoc w of
HsTyVar _ _ (L _ (isExact_maybe -> Just n))
- | n == oneDataConName -> HsLinearArrow (HsPct1 noHsTok noHsUniTok)
- | n == manyDataConName -> HsUnrestrictedArrow noHsUniTok
- _ -> HsExplicitMult noHsTok w noHsUniTok
+ | n == oneDataConName -> HsLinearArrow noAnn
+ | n == manyDataConName -> HsUnrestrictedArrow noAnn
+ _ -> HsExplicitMult noAnn w
-- ConT/InfixT can contain both data constructor (i.e., promoted) names and
-- other (i.e, unpromoted) names, as opposed to PromotedT, which can only
@@ -1837,11 +1836,12 @@ mk_apps head_ty type_args = do
go [] = pure head_ty'
go (arg:args) =
case arg of
- HsValArg ty -> do p_ty <- add_parens ty
+ HsValArg _ ty ->
+ do p_ty <- add_parens ty
mk_apps (HsAppTy noExtField phead_ty p_ty) args
HsTypeArg at ki ->
do p_ki <- add_parens ki
- mk_apps (HsAppKindTy noExtField phead_ty at p_ki) args
+ mk_apps (HsAppKindTy at phead_ty p_ki) args
HsArgPar _ -> mk_apps (HsParTy noAnn phead_ty) args
go type_args
@@ -1852,7 +1852,7 @@ mk_apps head_ty type_args = do
| otherwise = return lt
wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
-wrap_tyarg (HsValArg ty) = HsValArg $ parenthesizeHsType appPrec ty
+wrap_tyarg (HsValArg x ty) = HsValArg x $ parenthesizeHsType appPrec ty
wrap_tyarg (HsTypeArg l ki) = HsTypeArg l $ parenthesizeHsType appPrec ki
wrap_tyarg ta@(HsArgPar {}) = ta -- Already parenthesized
@@ -1884,9 +1884,9 @@ See (among other closed issues) https://gitlab.haskell.org/ghc/ghc/issues/14289
split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
split_ty_app ty = go ty []
where
- go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') }
+ go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg noExtField a':as') }
go (AppKindT ty ki) as' = do { ki' <- cvtKind ki
- ; go ty (HsTypeArg noHsTok ki' : as') }
+ ; go ty (HsTypeArg noAnn ki' : as') }
go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }
go f as = return (f,as)
diff --git a/compiler/GHC/Unit/Module/Warnings.hs b/compiler/GHC/Unit/Module/Warnings.hs
index 6048c10d1bca..25c58e336c29 100644
--- a/compiler/GHC/Unit/Module/Warnings.hs
+++ b/compiler/GHC/Unit/Module/Warnings.hs
@@ -63,7 +63,6 @@ import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Unicode
-import Language.Haskell.Syntax.Concrete (HsToken (HsTok))
import Language.Haskell.Syntax.Extension
import Data.Data
@@ -120,13 +119,13 @@ the possibility of them being infinite.
data InWarningCategory
= InWarningCategory
- { iwc_in :: !(Located (HsToken "in")),
+ { iwc_in :: !(EpToken "in"),
iwc_st :: !SourceText,
iwc_wc :: (Located WarningCategory)
} deriving Data
fromWarningCategory :: WarningCategory -> InWarningCategory
-fromWarningCategory wc = InWarningCategory (noLoc HsTok) NoSourceText (noLoc wc)
+fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLoc wc)
-- See Note [Warning categories]
@@ -238,7 +237,7 @@ warningTxtSame w1 w2
deriving instance Eq InWarningCategory
-deriving instance (Eq (HsToken "in"), Eq (IdP pass)) => Eq (WarningTxt pass)
+deriving instance (Eq (IdP pass)) => Eq (WarningTxt pass)
deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
diff --git a/compiler/Language/Haskell/Syntax.hs b/compiler/Language/Haskell/Syntax.hs
index d23b840af847..82e9f5558de3 100644
--- a/compiler/Language/Haskell/Syntax.hs
+++ b/compiler/Language/Haskell/Syntax.hs
@@ -25,7 +25,6 @@ module Language.Haskell.Syntax (
module Language.Haskell.Syntax.Module.Name,
module Language.Haskell.Syntax.Pat,
module Language.Haskell.Syntax.Type,
- module Language.Haskell.Syntax.Concrete,
module Language.Haskell.Syntax.Extension,
ModuleName(..), HsModule(..)
) where
@@ -36,7 +35,6 @@ import Language.Haskell.Syntax.Expr
import Language.Haskell.Syntax.ImpExp
import Language.Haskell.Syntax.Module.Name
import Language.Haskell.Syntax.Lit
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Type
diff --git a/compiler/Language/Haskell/Syntax/Binds.hs b/compiler/Language/Haskell/Syntax/Binds.hs
index 094ed1214f3b..e8fcc96f7afc 100644
--- a/compiler/Language/Haskell/Syntax/Binds.hs
+++ b/compiler/Language/Haskell/Syntax/Binds.hs
@@ -29,7 +29,6 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
import {-# SOURCE #-} Language.Haskell.Syntax.Pat
( LPat )
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
@@ -43,7 +42,6 @@ import GHC.Types.SourceText (StringLiteral)
import Data.Void
import Data.Bool
import Data.Maybe
-import Data.Functor
{-
************************************************************************
@@ -168,12 +166,14 @@ other interesting cases. Namely,
Note [Multiplicity annotations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Multiplicity annotation are stored in the pat_mult field on PatBinds. The type
-of the pat_mult field is given by the type family MultAnn: it changes depending
-on the phase. Before typechecking, MultAnn is Maybe (HsMultAnn) where Nothing
-means that there was no annotation in the original file. After typechecking
-MultAnn is Mult: the typechecker infers a multiplicity when there is no
-annotation.
+Multiplicity annotations are stored in the pat_mult field on PatBinds,
+represented by the HsMultAnn data type
+
+ HsNoMultAnn <=> no annotation in the source file
+ HsPct1Ann <=> the %1 annotation
+ HsMultAnn <=> the %t annotation, where `t` is some type
+
+In case of HsNoMultAnn the typechecker infers a multiplicity.
We don't need to store a multiplicity on FunBinds:
- let %1 x = … is parsed as a PatBind. So we don't need an annotation before
@@ -239,7 +239,7 @@ data HsBindLR idL idR
| PatBind {
pat_ext :: XPatBind idL idR,
pat_lhs :: LPat idL,
- pat_mult :: MultAnn idL,
+ pat_mult :: HsMultAnn idL,
-- ^ See Note [Multiplicity annotations].
pat_rhs :: GRHSs idR (LHsExpr idR)
}
@@ -285,25 +285,19 @@ data PatSynBind idL idR
}
| XPatSynBind !(XXPatSynBind idL idR)
-
-- | Multiplicity annotations, on binders, are always resolved (to a unification
-- variable if there is no annotation) during type-checking. The resolved
--- multiplicity is stored in the `mult_ext` field.
-type family XMultAnn pass
-
-data MultAnn pass
- = MultAnn { mult_ext :: XMultAnn pass, mult_ann :: HsMultAnn (NoGhcTc pass)}
-
--- | Multiplicity annotations at parse time. In particular `%1` is
--- special-cased.
+-- multiplicity is stored in the extension fields.
data HsMultAnn pass
- = HsNoMultAnn
- | HsPct1Ann !(LHsToken "%1" pass)
- | HsMultAnn !(LHsToken "%" pass) (LHsType pass)
-
-onMultExt :: Functor f => (XMultAnn pass -> f (XMultAnn pass)) -> MultAnn pass -> f (MultAnn pass)
-onMultExt f (MultAnn{mult_ext=x, mult_ann=ann}) =
- f x <&> (\y -> MultAnn{mult_ext = y, mult_ann = ann})
+ = HsNoMultAnn !(XNoMultAnn pass)
+ | HsPct1Ann !(XPct1Ann pass)
+ | HsMultAnn !(XMultAnn pass) (LHsType (NoGhcTc pass))
+ | XMultAnn !(XXMultAnn pass)
+
+type family XNoMultAnn p
+type family XPct1Ann p
+type family XMultAnn p
+type family XXMultAnn p
{-
************************************************************************
diff --git a/compiler/Language/Haskell/Syntax/Concrete.hs b/compiler/Language/Haskell/Syntax/Concrete.hs
deleted file mode 100644
index 76e033baf61a..000000000000
--- a/compiler/Language/Haskell/Syntax/Concrete.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- | Bits of concrete syntax (tokens, layout).
-
-module Language.Haskell.Syntax.Concrete
- ( LHsToken, LHsUniToken,
- HsToken(HsTok),
- HsUniToken(HsNormalTok, HsUnicodeTok),
- LayoutInfo(ExplicitBraces, VirtualBraces, NoLayoutInfo)
- ) where
-
-import GHC.Prelude
-import GHC.TypeLits (Symbol, KnownSymbol)
-import Data.Data
-import Language.Haskell.Syntax.Extension
-
-type LHsToken tok p = XRec p (HsToken tok)
-type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
-
--- | A token stored in the syntax tree. For example, when parsing a
--- let-expression, we store @HsToken "let"@ and @HsToken "in"@.
--- The locations of those tokens can be used to faithfully reproduce
--- (exactprint) the original program text.
-data HsToken (tok :: Symbol) = HsTok
-
--- | With @UnicodeSyntax@, there might be multiple ways to write the same
--- token. For example an arrow could be either @->@ or @→@. This choice must be
--- recorded in order to exactprint such tokens, so instead of @HsToken "->"@ we
--- introduce @HsUniToken "->" "→"@.
---
--- See also @IsUnicodeSyntax@ in @GHC.Parser.Annotation@; we do not use here to
--- avoid a dependency.
-data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
-
-deriving instance Eq (HsToken tok)
-deriving instance KnownSymbol tok => Data (HsToken tok)
-deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
-
--- | Layout information for declarations.
-data LayoutInfo pass =
-
- -- | Explicit braces written by the user.
- --
- -- @
- -- class C a where { foo :: a; bar :: a }
- -- @
- ExplicitBraces !(LHsToken "{" pass) !(LHsToken "}" pass)
- |
- -- | Virtual braces inserted by the layout algorithm.
- --
- -- @
- -- class C a where
- -- foo :: a
- -- bar :: a
- -- @
- VirtualBraces
- !Int -- ^ Layout column (indentation level, begins at 1)
- |
- -- | Empty or compiler-generated blocks do not have layout information
- -- associated with them.
- NoLayoutInfo
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 2a369bd7cefb..5f9f4908a1f1 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -70,7 +70,8 @@ module Language.Haskell.Syntax.Decls (
CImportSpec(..),
-- ** Data-constructor declarations
ConDecl(..), LConDecl,
- HsConDeclH98Details, HsConDeclGADTDetails(..),
+ HsConDeclH98Details,
+ HsConDeclGADTDetails(..), XPrefixConGADT, XRecConGADT, XXConDeclGADTDetails,
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
-- ** Deprecations
@@ -94,7 +95,6 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
-- Because Expr imports Decls via HsBracket
import Language.Haskell.Syntax.Binds
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic (Role)
@@ -457,8 +457,6 @@ data TyClDecl pass
-- 'GHC.Parser.Annotation.AnnRarrow'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs
- tcdLayout :: !(LayoutInfo pass), -- ^ Explicit or virtual braces
- -- See Note [Class LayoutInfo]
tcdCtxt :: Maybe (LHsContext pass), -- ^ Context...
tcdLName :: LIdP pass, -- ^ Name of the class
tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
@@ -501,9 +499,9 @@ c.f. Note [Associated type tyvar names] in GHC.Core.Class
Note [Family instance declaration binders]
-}
-{- Note [Class LayoutInfo]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-The LayoutInfo is used to associate Haddock comments with parts of the declaration.
+{- Note [Class EpLayout]
+~~~~~~~~~~~~~~~~~~~~~~~~
+The EpLayout is used to associate Haddock comments with parts of the declaration.
Compare the following examples:
class C a where
@@ -1081,7 +1079,6 @@ data ConDecl pass
= ConDeclGADT
{ con_g_ext :: XConDeclGADT pass
, con_names :: NonEmpty (LIdP pass)
- , con_dcolon :: !(LHsUniToken "::" "∷" pass)
-- The following fields describe the type after the '::'
-- See Note [GADT abstract syntax]
, con_bndrs :: XRec pass (HsOuterSigTyVarBndrs pass)
@@ -1242,8 +1239,13 @@ type HsConDeclH98Details pass
-- derived Show instances—see Note [Infix GADT constructors] in
-- GHC.Tc.TyCl—but that is an orthogonal concern.)
data HsConDeclGADTDetails pass
- = PrefixConGADT [HsScaled pass (LBangType pass)]
- | RecConGADT (XRec pass [LConDeclField pass]) (LHsUniToken "->" "→" pass)
+ = PrefixConGADT !(XPrefixConGADT pass) [HsScaled pass (LBangType pass)]
+ | RecConGADT !(XRecConGADT pass) (XRec pass [LConDeclField pass])
+ | XConDeclGADTDetails !(XXConDeclGADTDetails pass)
+
+type family XPrefixConGADT p
+type family XRecConGADT p
+type family XXConDeclGADTDetails p
{-
************************************************************************
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 6b6a4dc348fa..a2447ec52e5d 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -25,7 +25,6 @@ import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Decls
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Lit
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Binds
@@ -322,7 +321,6 @@ data HsExpr p
| HsAppType (XAppTypeE p) -- After typechecking: the type argument
(LHsExpr p)
- !(LHsToken "@" p)
(LHsWcType (NoGhcTc p)) -- ^ Visible type application
--
-- Explicit type argument; e.g f @Int x y
@@ -356,9 +354,7 @@ 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]
@@ -429,9 +425,7 @@ data HsExpr p
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsLet (XLet p)
- !(LHsToken "let" p)
(HsLocalBinds p)
- !(LHsToken "in" p)
(LHsExpr p)
-- | - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDo',
@@ -583,7 +577,6 @@ data HsExpr p
-- Embed the syntax of types into expressions.
-- Used with RequiredTypeArguments, e.g. fn (type (Int -> Bool))
| HsEmbTy (XEmbTy p)
- !(LHsToken "type" p)
(LHsWcType (NoGhcTc p))
| XExpr !(XXExpr p)
@@ -861,9 +854,7 @@ data HsCmd id
(MatchGroup id (LHsCmd id)) -- bodies are HsCmd's
| HsCmdPar (XCmdPar id)
- !(LHsToken "(" id)
(LHsCmd id) -- parenthesised command
- !(LHsToken ")" id)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnOpen' @'('@,
-- 'GHC.Parser.Annotation.AnnClose' @')'@
@@ -891,9 +882,7 @@ data HsCmd id
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| HsCmdLet (XCmdLet id)
- !(LHsToken "let" id)
(HsLocalBinds id) -- let(rec)
- !(LHsToken "in" id)
(LHsCmd id)
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnLet',
-- 'GHC.Parser.Annotation.AnnOpen' @'{'@,
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 4a4230abb176..a876df97f821 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -23,7 +23,7 @@ module Language.Haskell.Syntax.Pat (
ConLikeP,
HsConPatDetails, hsConPatArgs, hsConPatTyArgs,
- HsConPatTyArg(..),
+ HsConPatTyArg(..), XConPatTyArg,
HsRecFields(..), HsFieldBind(..), LHsFieldBind,
HsRecField, LHsRecField,
HsRecUpdField, LHsRecUpdField,
@@ -36,7 +36,6 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntyp
-- friends:
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Lit
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
@@ -79,16 +78,13 @@ data Pat p
| AsPat (XAsPat p)
(LIdP p)
- !(LHsToken "@" p)
(LPat p) -- ^ As pattern
-- ^ - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnAt'
-- 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' @')'@
@@ -222,7 +218,6 @@ data Pat p
-- Embed the syntax of types into patterns.
-- Used with RequiredTypeArguments, e.g. fn (type t) = rhs
| EmbTyPat (XEmbTyPat p)
- !(LHsToken "type" p)
(HsTyPat (NoGhcTc p))
-- Extension point; see Note [Trees That Grow] in Language.Haskell.Syntax.Extension
@@ -236,10 +231,9 @@ type family ConLikeP x
-- | Type argument in a data constructor pattern,
-- e.g. the @\@a@ in @f (Just \@a x) = ...@.
-data HsConPatTyArg p =
- HsConPatTyArg
- !(LHsToken "@" p)
- (HsTyPat p)
+data HsConPatTyArg p = HsConPatTyArg !(XConPatTyArg p) (HsTyPat p)
+
+type family XConPatTyArg p
-- | Haskell Constructor Pattern Details
type HsConPatDetails p = HsConDetails (HsConPatTyArg (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index dbf9ad0a741d..4266e34a8a69 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -22,11 +22,11 @@ GHC.Hs.Type: Abstract syntax: user-defined types
module Language.Haskell.Syntax.Type (
HsScaled(..),
hsMult, hsScaledThing,
- HsArrow(..),
- HsLinearArrowTokens(..),
+ HsArrow(..), XUnrestrictedArrow, XLinearArrow, XExplicitMult, XXArrow,
HsType(..), LHsType, HsKind, LHsKind,
- HsBndrVis(..), isHsBndrInvisible,
+ HsBndrVis(..), XBndrRequired, XBndrInvisible, XXBndrVis,
+ isHsBndrInvisible,
HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr,
LHsQTyVars(..),
HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
@@ -38,7 +38,8 @@ module Language.Haskell.Syntax.Type (
HsContext, LHsContext,
HsTyLit(..),
HsIPName(..), hsIPNameFS,
- HsArg(..),
+ HsArg(..), XValArg, XTypeArg, XArgPar, XXArg,
+
LHsTypeArg,
LBangType, BangType,
@@ -60,13 +61,11 @@ module Language.Haskell.Syntax.Type (
import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice )
-import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Types.Name.Reader ( RdrName )
import GHC.Core.DataCon( HsSrcBang(..) )
import GHC.Core.Type (Specificity)
-import GHC.Types.SrcLoc (SrcSpan)
import GHC.Types.Basic (Arity)
import GHC.Hs.Doc (LHsDoc)
@@ -726,19 +725,26 @@ data HsTyVarBndr flag pass
!(XXTyVarBndr pass)
data HsBndrVis pass
- = HsBndrRequired
+ = HsBndrRequired !(XBndrRequired pass)
-- Binder for a visible (required) variable:
-- type Dup a = (a, a)
-- ^^^
- | HsBndrInvisible (LHsToken "@" pass)
+ | HsBndrInvisible !(XBndrInvisible pass)
-- Binder for an invisible (specified) variable:
-- type KindOf @k (a :: k) = k
-- ^^^
+ | XXBndrVis !(XXBndrVis pass)
+
+type family XBndrRequired p
+type family XBndrInvisible p
+type family XXBndrVis p
+
isHsBndrInvisible :: HsBndrVis pass -> Bool
isHsBndrInvisible HsBndrInvisible{} = True
-isHsBndrInvisible HsBndrRequired = False
+isHsBndrInvisible HsBndrRequired{} = False
+isHsBndrInvisible (XXBndrVis _) = False
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
isHsKindedTyVar :: HsTyVarBndr flag pass -> Bool
@@ -783,7 +789,6 @@ data HsType pass
| HsAppKindTy (XAppKindTy pass) -- type level type app
(LHsType pass)
- !(LHsToken "@" pass)
(LHsKind pass)
| HsFunTy (XFunTy pass)
@@ -932,21 +937,24 @@ data HsTyLit pass
-- | Denotes the type of arrows in the surface language
data HsArrow pass
- = HsUnrestrictedArrow !(LHsUniToken "->" "→" pass)
+ = HsUnrestrictedArrow !(XUnrestrictedArrow pass)
-- ^ a -> b or a → b
- | HsLinearArrow !(HsLinearArrowTokens pass)
+ | HsLinearArrow !(XLinearArrow pass)
-- ^ a %1 -> b or a %1 → b, or a ⊸ b
- | HsExplicitMult !(LHsToken "%" pass) !(LHsType pass) !(LHsUniToken "->" "→" pass)
+ | HsExplicitMult !(XExplicitMult pass) !(LHsType pass)
-- ^ a %m -> b or a %m → b (very much including `a %Many -> b`!
-- This is how the programmer wrote it). It is stored as an
-- `HsType` so as to preserve the syntax as written in the
-- program.
-data HsLinearArrowTokens pass
- = HsPct1 !(LHsToken "%1" pass) !(LHsUniToken "->" "→" pass)
- | HsLolly !(LHsToken "⊸" pass)
+ | XArrow !(XXArrow pass)
+
+type family XUnrestrictedArrow p
+type family XLinearArrow p
+type family XExplicitMult p
+type family XXArrow p
-- | This is used in the syntax. In constructor declaration. It must keep the
-- arrow representation.
@@ -1227,9 +1235,15 @@ do not bring any type variables into scope over the body of a function at all.
-- | Arguments in an expression/type after splitting
data HsArg p tm ty
- = HsValArg tm -- Argument is an ordinary expression (f arg)
- | HsTypeArg !(LHsToken "@" p) ty -- Argument is a visible type application (f @ty)
- | HsArgPar SrcSpan -- See Note [HsArgPar]
+ = HsValArg !(XValArg p) tm -- Argument is an ordinary expression (f arg)
+ | HsTypeArg !(XTypeArg p) ty -- Argument is a visible type application (f @ty)
+ | HsArgPar !(XArgPar p) -- See Note [HsArgPar]
+ | XArg !(XXArg p)
+
+type family XValArg p
+type family XTypeArg p
+type family XArgPar p
+type family XXArg p
-- type level equivalent
type LHsTypeArg p = HsArg p (LHsType p) (LHsKind p)
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 682fbd9e775a..b5d7b46cf3e9 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -940,7 +940,6 @@ Library
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
- Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index 8d949c7f2240..c20d251fefa6 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -223,7 +223,6 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
-Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 5ff9b58b502d..83399fd302e8 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -243,7 +243,6 @@ GHC.Utils.Word64
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
-Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
diff --git a/testsuite/tests/ghc-api/exactprint/T22919.stderr b/testsuite/tests/ghc-api/exactprint/T22919.stderr
index 3c9dbaaca850..510337bfd8d1 100644
--- a/testsuite/tests/ghc-api/exactprint/T22919.stderr
+++ b/testsuite/tests/ghc-api/exactprint/T22919.stderr
@@ -17,13 +17,14 @@
{ T22919.hs:2:7-9 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { T22919.hs:1:15-27 })
+ (EpaSpan
+ { T22919.hs:1:15-27 })
(EpaComment
(EpaBlockComment
"{- comment -}")
{ T22919.hs:1:8-13 }))]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
index 909a51637ac6..f309eda6e2e6 100644
--- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr
+++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr
@@ -18,12 +18,13 @@
(EpaCommentsBalanced
[]
[(L
- (EpaSpan { Test20239.hs:8:34-63 })
+ (EpaSpan
+ { Test20239.hs:8:34-63 })
(EpaComment
(EpaLineComment
"-- ^ Run any arbitrary IO code")
{ Test20239.hs:7:86 }))]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -45,13 +46,15 @@
[])
(EpaComments
[(L
- (EpaSpan { Test20239.hs:3:1-28 })
+ (EpaSpan
+ { Test20239.hs:3:1-28 })
(EpaComment
(EpaLineComment
"-- | Leading Haddock Comment")
{ Test20239.hs:1:18-22 }))
,(L
- (EpaSpan { Test20239.hs:4:1-25 })
+ (EpaSpan
+ { Test20239.hs:4:1-25 })
(EpaComment
(EpaLineComment
"-- Running over two lines")
@@ -69,7 +72,8 @@
,(AddEpAnn AnnEqual (EpaSpan { Test20239.hs:5:34 }))]
(EpaComments
[(L
- (EpaSpan { Test20239.hs:6:34-70 })
+ (EpaSpan
+ { Test20239.hs:6:34-70 })
(EpaComment
(EpaLineComment
"-- ^ Run a query against the database")
@@ -86,6 +90,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { Test20239.hs:5:22-32 })
@@ -147,13 +152,9 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (EpPct1
+ (NoEpTok)
+ (NoEpUniTok)))
(L
(EpAnn
(EpaSpan { Test20239.hs:5:51-55 })
@@ -207,13 +208,9 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (EpPct1
+ (NoEpTok)
+ (NoEpUniTok)))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:50-86 })
@@ -244,10 +241,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { Test20239.hs:7:62-63 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { Test20239.hs:7:62-63 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:51-60 })
diff --git a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr b/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
index b7ef2e2c9659..dd302e531e9f 100644
--- a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
+++ b/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
@@ -17,18 +17,20 @@
{ ZeroWidthSemi.hs:8:1-58 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { ZeroWidthSemi.hs:3:1-19 })
+ (EpaSpan
+ { ZeroWidthSemi.hs:3:1-19 })
(EpaComment
(EpaLineComment
"-- leading comments")
{ ZeroWidthSemi.hs:1:22-26 }))]
[(L
- (EpaSpan { ZeroWidthSemi.hs:8:1-58 })
+ (EpaSpan
+ { ZeroWidthSemi.hs:8:1-58 })
(EpaComment
(EpaLineComment
"-- Trailing comment, should be in HsModule extension point")
{ ZeroWidthSemi.hs:6:5 }))]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -50,7 +52,8 @@
[])
(EpaComments
[(L
- (EpaSpan { ZeroWidthSemi.hs:5:1-19 })
+ (EpaSpan
+ { ZeroWidthSemi.hs:5:1-19 })
(EpaComment
(EpaLineComment
"-- Function comment")
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
index 6cdc3ebec860..5038369a76a0 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -43,16 +43,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:(5,1)-(6,16) })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:5:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:5:12-16 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (3))
(NoAnnSortKey))
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -78,7 +78,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:5:10 })
@@ -140,10 +141,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:6:11-12 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544.hs:6:11-12 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544.hs:6:9 })
@@ -230,16 +230,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:(9,1)-(10,16) })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:9:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:9:12-16 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (3))
(NoAnnSortKey))
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -265,7 +265,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:9:10 })
@@ -327,10 +328,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:10:11-12 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544.hs:10:11-12 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544.hs:10:9 })
@@ -411,16 +411,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:(13,1)-(14,16) })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:13:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:13:12-16 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (3))
(NoAnnSortKey))
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -446,7 +446,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:13:10 })
@@ -508,10 +509,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:14:11-12 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544.hs:14:11-12 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544.hs:14:9 })
@@ -595,16 +595,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:(17,1)-(20,16) })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:17:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:17:12-16 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (3))
(NoAnnSortKey))
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -630,7 +630,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:17:10 })
@@ -692,10 +693,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:18:11-12 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544.hs:18:11-12 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544.hs:18:9 })
@@ -792,10 +792,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:20:11-12 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544.hs:20:11-12 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544.hs:20:9 })
@@ -857,7 +856,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:22:1-30 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:22:1-5 }))
@@ -866,16 +865,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:22:30 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:22:18 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:22:30 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:22:30 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -901,7 +896,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:22:10 })
@@ -955,7 +951,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:22:28 })
@@ -1095,6 +1092,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:24:11-13 })
@@ -1134,11 +1132,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:25:5-18 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:25:10-11 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:25:5-18 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -1150,10 +1152,6 @@
(Unqual
{OccName: MkD5}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:25:10-11 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:25:13-18 })
@@ -1165,6 +1163,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -1234,7 +1233,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:28:1-30 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:28:1-5 }))
@@ -1243,16 +1242,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:28:30 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:28:18 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:28:30 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:28:30 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -1278,7 +1273,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:28:10 })
@@ -1332,7 +1328,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:28:28 })
@@ -1472,6 +1469,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:30:11-13 })
@@ -1511,11 +1509,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:31:5-18 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:31:10-11 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:31:5-18 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -1527,10 +1529,6 @@
(Unqual
{OccName: MkD6}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:31:10-11 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:31:13-18 })
@@ -1542,6 +1540,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -1611,7 +1610,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:34:1-30 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:34:1-5 }))
@@ -1620,16 +1619,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:34:30 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:34:18 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:34:30 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:34:30 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -1655,7 +1650,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:34:10 })
@@ -1709,7 +1705,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:34:28 })
@@ -1849,6 +1846,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:36:11-13 })
@@ -1888,11 +1886,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:37:5-18 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:37:10-11 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:37:5-18 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -1904,10 +1906,6 @@
(Unqual
{OccName: MkD7}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:37:10-11 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:37:13-18 })
@@ -1919,6 +1917,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -1988,7 +1987,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:40:1-30 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:40:1-5 }))
@@ -1997,16 +1996,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:40:30 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:40:18 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:40:30 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:40:30 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -2032,7 +2027,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:40:10 })
@@ -2086,7 +2082,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:40:28 })
@@ -2226,6 +2223,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:42:11-13 })
@@ -2265,11 +2263,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:43:5-18 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:43:10-11 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:43:5-18 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -2281,10 +2283,6 @@
(Unqual
{OccName: MkD8}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:43:10-11 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:43:13-18 })
@@ -2296,6 +2294,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -2365,7 +2364,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:46:1-30 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:46:1-5 }))
@@ -2374,16 +2373,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:46:30 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:46:18 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:46:30 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:46:30 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -2409,7 +2404,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:46:10 })
@@ -2463,7 +2459,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:46:28 })
@@ -2603,6 +2600,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:48:11-13 })
@@ -2642,11 +2640,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:49:5-18 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:49:10-11 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:49:5-18 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -2658,10 +2660,6 @@
(Unqual
{OccName: MkD9}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:49:10-11 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:49:13-18 })
@@ -2673,6 +2671,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -2742,7 +2741,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544.hs:52:1-32 })
[(AddEpAnn AnnClass (EpaSpan { T17544.hs:52:1-5 }))
@@ -2751,16 +2750,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:52:32 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T17544.hs:52:19 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:52:32 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T17544.hs:52:32 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -2786,7 +2781,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:52:11 })
@@ -2840,7 +2836,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544.hs:52:30 })
@@ -2980,6 +2977,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544.hs:54:12-14 })
@@ -3019,11 +3017,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544.hs:55:5-20 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544.hs:55:11-12 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544.hs:55:5-20 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -3035,10 +3037,6 @@
(Unqual
{OccName: MkD10}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544.hs:55:11-12 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544.hs:55:14-20 })
@@ -3050,6 +3048,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
index d0afee6137f5..76bd8bb57985 100644
--- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
+++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Just
@@ -89,11 +89,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544_kw.hs:16:9-20 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544_kw.hs:16:15-16 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544_kw.hs:16:9-20 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -105,10 +109,6 @@
(Unqual
{OccName: MkFoo}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544_kw.hs:16:15-16 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544_kw.hs:16:18-20 })
@@ -120,6 +120,7 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
@@ -201,11 +202,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T17544_kw.hs:19:9-26 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T17544_kw.hs:19:15-16 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T17544_kw.hs:19:9-26 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -217,10 +222,6 @@
(Unqual
{OccName: MkBar}))
[])
- (L
- (TokenLoc
- (EpaSpan { T17544_kw.hs:19:15-16 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T17544_kw.hs:19:18-26 })
@@ -232,12 +233,12 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[(HsScaled
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T17544_kw.hs:19:21-22 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T17544_kw.hs:19:21-22 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T17544_kw.hs:19:18-19 })
@@ -303,16 +304,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T17544_kw.hs:(21,1)-(24,18) })
[(AddEpAnn AnnClass (EpaSpan { T17544_kw.hs:21:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:23:3-7 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (5))
(NoAnnSortKey))
- (VirtualBraces
- (5))
(Nothing)
(L
(EpAnn
@@ -338,7 +339,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T17544_kw.hs:21:11 })
diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr
index c9fbd962ef69..ea36d59b7027 100644
--- a/testsuite/tests/module/mod185.stderr
+++ b/testsuite/tests/module/mod185.stderr
@@ -17,7 +17,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index a43f159b2882..5fc349913805 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -163,13 +163,9 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (EpPct1
+ (NoEpTok)
+ (NoEpUniTok)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:26-30 })
@@ -245,10 +241,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:9:20-21 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:9:20-21 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:9:16-18 })
@@ -358,6 +353,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:10-17 })
@@ -572,6 +568,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:12:10-12 })
@@ -640,7 +637,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:10:30 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:10:21-22 })
@@ -762,7 +760,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:8 })
@@ -787,7 +786,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:15:17 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:11 })
@@ -857,13 +857,9 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (EpPct1
+ (NoEpTok)
+ (NoEpUniTok)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:25-29 })
@@ -987,10 +983,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:17:14-15 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:17:14-15 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:17:12 })
@@ -1028,10 +1023,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:17:29-30 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:17:29-30 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:17:17-27 })
@@ -1062,10 +1056,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:17:20-21 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:17:20-21 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:17:18 })
@@ -1182,10 +1175,8 @@
(HsOuterImplicit
(NoExtField))
[(HsTypeArg
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:19:6 }))
- (HsTok))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:19:6 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:7-11 })
@@ -1210,6 +1201,7 @@
(Unqual
{OccName: Peano})))))
,(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:13 })
@@ -1234,6 +1226,7 @@
(Unqual
{OccName: a})))))
,(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:15 })
@@ -1284,7 +1277,8 @@
(EpaComments
[]))
(HsAppKindTy
- (NoExtField)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:19:21 }))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:19 })
@@ -1308,10 +1302,6 @@
[]))
(Unqual
{OccName: T}))))
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:19:21 }))
- (HsTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:22-26 })
@@ -1408,7 +1398,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:18:23 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:18:17 })
@@ -1456,7 +1447,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:18:40 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:18:26 })
@@ -1480,10 +1472,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:18:33-34 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:18:33-34 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:18:31 })
@@ -1619,10 +1610,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:21:22-23 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:21:22-23 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:21:20 })
@@ -1660,10 +1650,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:21:27-28 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:21:27-28 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:21:25 })
@@ -1744,6 +1733,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:22-37 })
@@ -1810,10 +1800,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:22:30-31 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:22:30-31 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:28 })
@@ -1880,10 +1869,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:22:54-55 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:22:54-55 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:42-52 })
@@ -1914,10 +1902,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:22:45-46 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:22:45-46 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:43 })
@@ -1996,11 +1983,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:23:3-45 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:23:7-8 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { DumpParsedAst.hs:23:3-45 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -2012,10 +2003,6 @@
(Unqual
{OccName: Nat}))
[])
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:23:7-8 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:10-45 })
@@ -2027,12 +2014,12 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[(HsScaled
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:23:36-37 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:23:36-37 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:10-34 })
@@ -2103,10 +2090,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpParsedAst.hs:23:27-28 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:23:27-28 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:22-25 })
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
index eeda54cd0b71..c96f2d5f06e4 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
@@ -18,19 +18,21 @@
{ DumpParsedAstComments.hs:19:17-23 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { DumpParsedAstComments.hs:1:1-28 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:1:1-28 })
(EpaComment
(EpaBlockComment
"{-# LANGUAGE Haskell2010 #-}")
{ DumpParsedAstComments.hs:1:1 }))
,(L
- (EpaSpan { DumpParsedAstComments.hs:(2,1)-(4,4) })
+ (EpaSpan
+ { DumpParsedAstComments.hs:(2,1)-(4,4) })
(EpaComment
(EpaBlockComment
"{-\n Block comment at the beginning\n -}")
{ DumpParsedAstComments.hs:1:1-28 }))]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -52,13 +54,15 @@
[])
(EpaComments
[(L
- (EpaSpan { DumpParsedAstComments.hs:7:1-20 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:7:1-20 })
(EpaComment
(EpaLineComment
"-- comment 1 for bar")
{ DumpParsedAstComments.hs:5:30-34 }))
,(L
- (EpaSpan { DumpParsedAstComments.hs:8:1-20 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:8:1-20 })
(EpaComment
(EpaLineComment
"-- comment 2 for bar")
@@ -162,19 +166,22 @@
[])
(EpaComments
[(L
- (EpaSpan { DumpParsedAstComments.hs:10:1-16 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:10:1-16 })
(EpaComment
(EpaLineComment
"-- Other comment")
{ DumpParsedAstComments.hs:9:7 }))
,(L
- (EpaSpan { DumpParsedAstComments.hs:12:1-20 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:12:1-20 })
(EpaComment
(EpaLineComment
"-- comment 1 for foo")
{ DumpParsedAstComments.hs:10:1-16 }))
,(L
- (EpaSpan { DumpParsedAstComments.hs:13:1-20 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:13:1-20 })
(EpaComment
(EpaLineComment
"-- comment 2 for foo")
@@ -268,7 +275,8 @@
[])
(EpaComments
[(L
- (EpaSpan { DumpParsedAstComments.hs:15:3-19 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:15:3-19 })
(EpaComment
(EpaLineComment
"-- normal comment")
@@ -327,7 +335,8 @@
[])
(EpaComments
[(L
- (EpaSpan { DumpParsedAstComments.hs:18:1-20 })
+ (EpaSpan
+ { DumpParsedAstComments.hs:18:1-20 })
(EpaComment
(EpaLineComment
"-- | Haddock comment")
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 4e67f0be7b26..224d5445cef3 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -176,11 +176,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:9:14-17 })
@@ -204,11 +200,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:9:21-24 })
@@ -224,13 +216,7 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:9:26-30 })
@@ -302,6 +288,7 @@
[{Name: a}
,{Name: as}])
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:10-17 })
@@ -509,6 +496,7 @@
(HsOuterImplicit
[])
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:14:10-12 })
@@ -569,7 +557,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:12:30 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:12:21-22 })
@@ -691,10 +680,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:11:20-21 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:11:16-18 })
@@ -809,10 +795,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:16:22-23 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:16:20 })
@@ -849,10 +832,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:16:27-28 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:16:25 })
@@ -928,6 +908,7 @@
[{Name: a}
,{Name: k}])
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:22-37 })
@@ -993,10 +974,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:19:30-31 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:28 })
@@ -1061,10 +1039,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:19:54-55 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:42-52 })
@@ -1095,10 +1070,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:19:45-46 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:43 })
@@ -1174,11 +1146,7 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(:|
(L
(EpAnn
@@ -1189,10 +1157,6 @@
[]))
{Name: DumpRenamedAst.Nat})
[])
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:20:7-8 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:10-45 })
@@ -1205,12 +1169,10 @@
,{Name: g}]))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[(HsScaled
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:20:36-37 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:10-34 })
@@ -1280,10 +1242,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:20:27-28 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:22-25 })
@@ -1514,7 +1473,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:8 })
@@ -1538,7 +1498,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:22:17 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:11 })
@@ -1585,11 +1546,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:21-23 })
@@ -1605,13 +1562,7 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:25-29 })
@@ -1730,10 +1681,7 @@
[{Name: a}
,{Name: f}])
[(HsTypeArg
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:26:6 }))
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:26:7-11 })
@@ -1757,6 +1705,7 @@
[]))
{Name: DumpRenamedAst.Peano}))))
,(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:26:13 })
@@ -1780,6 +1729,7 @@
[]))
{Name: a}))))
,(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:26:15 })
@@ -1852,10 +1802,6 @@
(EpaComments
[]))
{Name: DumpRenamedAst.T})))
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:26:21 }))
- (HsTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:26:22-26 })
@@ -1948,7 +1894,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:25:23 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:25:17 })
@@ -1994,7 +1941,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:25:40 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:25:26 })
@@ -2017,10 +1965,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:25:33-34 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:25:31 })
@@ -2140,10 +2085,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:24:14-15 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:12 })
@@ -2180,10 +2122,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:24:29-30 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:17-27 })
@@ -2214,10 +2153,7 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpRenamedAst.hs:24:20-21 }))
- (HsNormalTok)))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:18 })
@@ -2297,8 +2233,6 @@
(ClassDecl
{NameSet:
[]}
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -2323,7 +2257,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:28:9 })
@@ -2375,7 +2310,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:29:10 })
@@ -2397,7 +2333,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:29:12 })
@@ -2544,6 +2481,7 @@
(HsOuterImplicit
[{Name: b}])
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:32:10-12 })
@@ -2583,6 +2521,7 @@
[]))
{Name: a}))))))
,(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:32:14 })
diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr
index 301d0adfa043..65b8903d7e8b 100644
--- a/testsuite/tests/parser/should_compile/DumpSemis.stderr
+++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr
@@ -29,7 +29,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -1328,16 +1328,16 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { DumpSemis.hs:(28,1)-(29,23) })
[(AddEpAnn AnnClass (EpaSpan { DumpSemis.hs:28:1-5 }))
,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:28:40-44 }))]
(EpaComments
[]))
+ (EpVirtualBraces
+ (3))
(NoAnnSortKey))
- (VirtualBraces
- (3))
(Nothing)
(L
(EpAnn
@@ -1367,7 +1367,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { DumpSemis.hs:28:38 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { DumpSemis.hs:28:24-28 })
@@ -1452,10 +1453,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpSemis.hs:29:18-19 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpSemis.hs:29:18-19 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpSemis.hs:29:12-16 })
@@ -1694,10 +1694,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { DumpSemis.hs:31:27-28 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { DumpSemis.hs:31:27-28 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { DumpSemis.hs:31:25 })
@@ -1951,15 +1950,11 @@
(EpaComments
[]))
(HsLet
- (EpAnn
- (EpaSpan { DumpSemis.hs:34:10-35 })
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (TokenLoc
+ ((,)
+ (EpTok
(EpaSpan { DumpSemis.hs:34:10-12 }))
- (HsTok))
+ (EpTok
+ (EpaSpan { DumpSemis.hs:34:32-33 })))
(HsValBinds
(EpAnn
(EpaSpan { DumpSemis.hs:34:13-31 })
@@ -2186,10 +2181,6 @@
(EmptyLocalBinds
(NoExtField)))))]))))]}
[]))
- (L
- (TokenLoc
- (EpaSpan { DumpSemis.hs:34:32-33 }))
- (HsTok))
(L
(EpAnn
(EpaSpan { DumpSemis.hs:34:35 })
diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
index 7c9fb5ba89d6..875072e46841 100644
--- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
@@ -155,14 +155,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -203,10 +196,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "T")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "T")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -391,14 +381,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -439,10 +422,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "'MkT")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "'MkT")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -627,14 +607,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -675,10 +648,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "Peano")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "Peano")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -863,14 +833,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -911,10 +874,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "'Zero")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "'Zero")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -1099,14 +1059,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -1147,10 +1100,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "'Succ")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "'Succ")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -1827,14 +1777,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -1905,14 +1848,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -1983,14 +1919,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -2071,16 +2000,7 @@
(ConLikeTc
({abstract:ConLike})
[]
- []))))))))
- (L
- (NoTokenLoc)
- (HsTok))))))
- (L
- (NoTokenLoc)
- (HsTok))))))
- (L
- (NoTokenLoc)
- (HsTok))))))))
+ []))))))))))))))))))))))
,(L
(EpAnn
(EpaSpan { <no location info> })
@@ -2221,14 +2141,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -2269,10 +2182,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "main")))))
- (L
- (NoTokenLoc)
- (HsTok))))))
+ "main")))))))))
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -2281,14 +2191,7 @@
(EpaComments
[]))
(HsPar
- (EpAnn
- (EpaDelta (SameLine 0) [])
- (NoEpAnns)
- (EpaComments
- []))
- (L
- (NoTokenLoc)
- (HsTok))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { <no location info> })
@@ -2329,10 +2232,7 @@
[]))
(HsStringPrim
(NoSourceText)
- "DumpTypecheckedAst")))))
- (L
- (NoTokenLoc)
- (HsTok))))))))
+ "DumpTypecheckedAst")))))))))))
,(L
(EpAnn
(EpaSpan { DumpTypecheckedAst.hs:20:1-23 })
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 9bf89f79c620..78c758e2e634 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -114,6 +114,7 @@
(HsOuterImplicit
(NoExtField))
[(HsValArg
+ (NoExtField)
(L
(EpAnn
(EpaSpan { KindSigs.hs:12:7 })
@@ -222,7 +223,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { KindSigs.hs:11:17 })
@@ -282,7 +284,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { KindSigs.hs:15:10 })
@@ -525,7 +528,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { KindSigs.hs:16:11 })
@@ -885,10 +889,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { KindSigs.hs:22:22-23 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { KindSigs.hs:22:22-23 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:8-20 })
@@ -978,10 +981,9 @@
(EpaComments
[]))
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { KindSigs.hs:22:30-31 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { KindSigs.hs:22:30-31 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:25-28 })
@@ -1499,7 +1501,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { KindSigs.hs:28:12 })
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index b317a73ce46a..4390aa1841b7 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -52,11 +52,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T14189.hs:6:15-16 })
@@ -72,13 +68,7 @@
[]
[(HsScaled
(HsLinearArrow
- (HsPct1
- (L
- (NoTokenLoc)
- (HsTok))
- (L
- (NoTokenLoc)
- (HsNormalTok))))
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T14189.hs:6:18-20 })
@@ -111,11 +101,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T14189.hs:6:24-25 })
@@ -139,11 +125,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T14189.hs:6:29 })
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index 917c5dd7e9a2..12c154a7d6f4 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -73,7 +73,8 @@
[]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T15323.hs:5:19 })
@@ -99,11 +100,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T15323.hs:6:5-54 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T15323.hs:6:17-18 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T15323.hs:6:5-54 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -115,10 +120,6 @@
(Unqual
{OccName: TestParens}))
[])
- (L
- (TokenLoc
- (EpaSpan { T15323.hs:6:17-18 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T15323.hs:6:20-29 })
@@ -242,6 +243,7 @@
(Unqual
{OccName: v}))))))))]))
(PrefixConGADT
+ (NoExtField)
[])
(L
(EpAnn
diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr
index bcb698e2f63d..5f5fbd46214a 100644
--- a/testsuite/tests/parser/should_compile/T20452.stderr
+++ b/testsuite/tests/parser/should_compile/T20452.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -75,7 +75,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:5:21 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:5:15 })
@@ -190,7 +191,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:6:22 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:6:15 })
@@ -271,7 +273,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T20452.hs:8:1-85 })
[(AddEpAnn AnnClass (EpaSpan { T20452.hs:8:1-5 }))
@@ -280,16 +282,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T20452.hs:8:85 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T20452.hs:8:84 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T20452.hs:8:85 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T20452.hs:8:85 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -317,7 +315,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:8:26 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:8:16-18 })
@@ -365,7 +364,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:8:45 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:8:31-34 })
@@ -413,7 +413,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:8:75 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:8:50-52 })
@@ -521,7 +522,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,)
+ ((,,)
(EpAnn
(EpaSpan { T20452.hs:9:1-85 })
[(AddEpAnn AnnClass (EpaSpan { T20452.hs:9:1-5 }))
@@ -530,16 +531,12 @@
,(AddEpAnn AnnCloseC (EpaSpan { T20452.hs:9:85 }))]
(EpaComments
[]))
- (NoAnnSortKey))
- (ExplicitBraces
- (L
- (TokenLoc
+ (EpExplicitBraces
+ (EpTok
(EpaSpan { T20452.hs:9:84 }))
- (HsTok))
- (L
- (TokenLoc
- (EpaSpan { T20452.hs:9:85 }))
- (HsTok)))
+ (EpTok
+ (EpaSpan { T20452.hs:9:85 })))
+ (NoAnnSortKey))
(Nothing)
(L
(EpAnn
@@ -569,7 +566,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:9:27 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:9:16-18 })
@@ -619,7 +617,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:9:46 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:9:31-34 })
@@ -669,7 +668,8 @@
,(AddEpAnn AnnCloseP (EpaSpan { T20452.hs:9:76 }))]
(EpaComments
[]))
- (HsBndrRequired)
+ (HsBndrRequired
+ (NoExtField))
(L
(EpAnn
(EpaSpan { T20452.hs:9:50-52 })
diff --git a/testsuite/tests/parser/should_compile/T20718.stderr b/testsuite/tests/parser/should_compile/T20718.stderr
index b487bc0550de..21f52961b6f6 100644
--- a/testsuite/tests/parser/should_compile/T20718.stderr
+++ b/testsuite/tests/parser/should_compile/T20718.stderr
@@ -17,42 +17,48 @@
{ T20718.hs:11:1-8 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { T20718.hs:1:1-16 })
+ (EpaSpan
+ { T20718.hs:1:1-16 })
(EpaComment
(EpaLineComment
"-- top of file 1")
{ T20718.hs:1:1 }))
,(L
- (EpaSpan { T20718.hs:2:1-16 })
+ (EpaSpan
+ { T20718.hs:2:1-16 })
(EpaComment
(EpaLineComment
"-- top of file 2")
{ T20718.hs:1:1-16 }))
,(L
- (EpaSpan { T20718.hs:5:1-11 })
+ (EpaSpan
+ { T20718.hs:5:1-11 })
(EpaComment
(EpaLineComment
"-- before 1")
{ T20718.hs:3:15-19 }))
,(L
- (EpaSpan { T20718.hs:6:1-11 })
+ (EpaSpan
+ { T20718.hs:6:1-11 })
(EpaComment
(EpaLineComment
"-- before 2")
{ T20718.hs:5:1-11 }))]
[(L
- (EpaSpan { T20718.hs:10:1-8 })
+ (EpaSpan
+ { T20718.hs:10:1-8 })
(EpaComment
(EpaLineComment
"-- end 1")
{ T20718.hs:8:5 }))
,(L
- (EpaSpan { T20718.hs:11:1-8 })
+ (EpaSpan
+ { T20718.hs:11:1-8 })
(EpaComment
(EpaLineComment
"-- end 2")
{ T20718.hs:10:1-8 }))]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/parser/should_compile/T20718b.stderr b/testsuite/tests/parser/should_compile/T20718b.stderr
index 69fb41bcdced..b4c80196bb5f 100644
--- a/testsuite/tests/parser/should_compile/T20718b.stderr
+++ b/testsuite/tests/parser/should_compile/T20718b.stderr
@@ -17,31 +17,35 @@
{ T20718b.hs:7:1-21 })))
(EpaCommentsBalanced
[(L
- (EpaSpan { T20718b.hs:1:1-19 })
+ (EpaSpan
+ { T20718b.hs:1:1-19 })
(EpaComment
(EpaLineComment
"-- header comment 1")
{ T20718b.hs:1:1 }))
,(L
- (EpaSpan { T20718b.hs:2:1-19 })
+ (EpaSpan
+ { T20718b.hs:2:1-19 })
(EpaComment
(EpaLineComment
"-- header comment 2")
{ T20718b.hs:1:1-19 }))
,(L
- (EpaSpan { T20718b.hs:6:1-21 })
+ (EpaSpan
+ { T20718b.hs:6:1-21 })
(EpaComment
(EpaLineComment
"-- trailing comment 1")
{ T20718b.hs:4:16-20 }))
,(L
- (EpaSpan { T20718b.hs:7:1-21 })
+ (EpaSpan
+ { T20718b.hs:7:1-21 })
(EpaComment
(EpaLineComment
"-- trailing comment 2")
{ T20718b.hs:6:1-21 }))]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/parser/should_compile/T20846.stderr b/testsuite/tests/parser/should_compile/T20846.stderr
index b70174f6a32a..c05951ede47b 100644
--- a/testsuite/tests/parser/should_compile/T20846.stderr
+++ b/testsuite/tests/parser/should_compile/T20846.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/parser/should_compile/T23315/T23315.stderr b/testsuite/tests/parser/should_compile/T23315/T23315.stderr
index f11fba746400..2c649b51a7ff 100644
--- a/testsuite/tests/parser/should_compile/T23315/T23315.stderr
+++ b/testsuite/tests/parser/should_compile/T23315/T23315.stderr
@@ -14,7 +14,7 @@
(Nothing))
(EpaComments
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.hs b/testsuite/tests/perf/compiler/hard_hole_fits.hs
index 099a54675898..8a8cd0339485 100644
--- a/testsuite/tests/perf/compiler/hard_hole_fits.hs
+++ b/testsuite/tests/perf/compiler/hard_hole_fits.hs
@@ -19,10 +19,10 @@ testMe (HsOverLit xole hol) = _
testMe (HsLit xle hl) = _
testMe (HsLam xlc lc_variant mg) = _
testMe (HsApp xa gl gl') = _
-testMe (HsAppType xate gl at hwcb) = _
+testMe (HsAppType xate gl hwcb) = _
testMe (OpApp xoa gl gl' gl2) = _
testMe (NegApp xna gl se) = _
-testMe (HsPar xp gl ab ac) = _
+testMe (HsPar xp ab) = _
testMe (SectionL xsl gl gl') = _
testMe (SectionR xsr gl gl') = _
testMe (ExplicitTuple xet gls box) = _
@@ -30,7 +30,7 @@ testMe (ExplicitSum xes n i gl) = _
testMe (HsCase xc gl mg) = _
testMe (HsIf xi m_se gl gl' ) = _
testMe (HsMultiIf xmi gls) = _
-testMe (HsLet xl tkLet gl tkIn gl') = _
+testMe (HsLet xl gl gl') = _
testMe (HsDo xd hsc gl) = _
testMe (ExplicitList xel m_se) = _
testMe (RecordCon xrc gl hrf) = _
diff --git a/testsuite/tests/perf/compiler/hard_hole_fits.stderr b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
index 2f1ea991f9cc..52ce8554c10e 100644
--- a/testsuite/tests/perf/compiler/hard_hole_fits.stderr
+++ b/testsuite/tests/perf/compiler/hard_hole_fits.stderr
@@ -154,15 +154,12 @@ hard_hole_fits.hs:21:28: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
(and originally defined in ‘GHC.Enum’))
-hard_hole_fits.hs:22:38: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
+hard_hole_fits.hs:22:35: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (HsAppType xate gl at hwcb) = _
+ • In an equation for ‘testMe’: testMe (HsAppType xate gl hwcb) = _
• Relevant bindings include
hwcb :: Language.Haskell.Syntax.Type.LHsWcType
(Language.Haskell.Syntax.Extension.NoGhcTc GhcPs)
- (bound at hard_hole_fits.hs:22:30)
- at :: Language.Haskell.Syntax.Concrete.LHsToken "@" GhcPs
(bound at hard_hole_fits.hs:22:27)
gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:22:24)
xate :: Language.Haskell.Syntax.Extension.XAppTypeE GhcPs
@@ -217,15 +214,11 @@ hard_hole_fits.hs:24:29: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
(and originally defined in ‘GHC.Enum’))
-hard_hole_fits.hs:25:30: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
+hard_hole_fits.hs:25:24: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsPar xp gl ab ac) = _
+ • In an equation for ‘testMe’: testMe (HsPar xp ab) = _
• Relevant bindings include
- ac :: Language.Haskell.Syntax.Concrete.LHsToken ")" GhcPs
- (bound at hard_hole_fits.hs:25:24)
- ab :: LHsExpr GhcPs (bound at hard_hole_fits.hs:25:21)
- gl :: Language.Haskell.Syntax.Concrete.LHsToken "(" GhcPs
- (bound at hard_hole_fits.hs:25:18)
+ ab :: LHsExpr GhcPs (bound at hard_hole_fits.hs:25:18)
xp :: Language.Haskell.Syntax.Extension.XPar GhcPs
(bound at hard_hole_fits.hs:25:15)
testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
@@ -383,17 +376,12 @@ hard_hole_fits.hs:32:30: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
(imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
(and originally defined in ‘GHC.Enum’))
-hard_hole_fits.hs:33:39: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
+hard_hole_fits.hs:33:28: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (HsLet xl tkLet gl tkIn gl') = _
+ • In an equation for ‘testMe’: testMe (HsLet xl gl gl') = _
• Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:33:32)
- tkIn :: Language.Haskell.Syntax.Concrete.LHsToken "in" GhcPs
- (bound at hard_hole_fits.hs:33:27)
+ gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:33:21)
gl :: Language.Haskell.Syntax.Binds.HsLocalBinds GhcPs
- (bound at hard_hole_fits.hs:33:24)
- tkLet :: Language.Haskell.Syntax.Concrete.LHsToken "let" GhcPs
(bound at hard_hole_fits.hs:33:18)
xl :: Language.Haskell.Syntax.Extension.XLet GhcPs
(bound at hard_hole_fits.hs:33:15)
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 778d0974e0c1..6bb5a240bbb7 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 (XExpr (WrapExpr (HsWrap w (HsPar _ _ (L _ (HsApp noExt (L _ (HsVar _ (L _ id))) e)) _ )))))
+metaPlugin' [name, "meta"] (L l (XExpr (WrapExpr (HsWrap w (HsPar _ (L _ (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/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr
index 30ddab250d95..1b577b48147d 100644
--- a/testsuite/tests/printer/T18791.stderr
+++ b/testsuite/tests/printer/T18791.stderr
@@ -18,7 +18,7 @@
(EpaCommentsBalanced
[]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -77,11 +77,15 @@
(EpaComments
[]))
(ConDeclGADT
- (EpAnn
- (EpaSpan { T18791.hs:5:3-17 })
- []
- (EpaComments
- []))
+ ((,)
+ (EpUniTok
+ (EpaSpan { T18791.hs:5:7-8 })
+ (NormalSyntax))
+ (EpAnn
+ (EpaSpan { T18791.hs:5:3-17 })
+ []
+ (EpaComments
+ [])))
(:|
(L
(EpAnn
@@ -93,10 +97,6 @@
(Unqual
{OccName: MkT}))
[])
- (L
- (TokenLoc
- (EpaSpan { T18791.hs:5:7-8 }))
- (HsNormalTok))
(L
(EpAnn
(EpaSpan { T18791.hs:5:10-17 })
@@ -108,12 +108,12 @@
(NoExtField)))
(Nothing)
(PrefixConGADT
+ (NoExtField)
[(HsScaled
(HsUnrestrictedArrow
- (L
- (TokenLoc
- (EpaSpan { T18791.hs:5:14-15 }))
- (HsNormalTok)))
+ (EpUniTok
+ (EpaSpan { T18791.hs:5:14-15 })
+ (NormalSyntax)))
(L
(EpAnn
(EpaSpan { T18791.hs:5:10-12 })
diff --git a/testsuite/tests/printer/Test20297.stdout b/testsuite/tests/printer/Test20297.stdout
index 234e36b3f9de..415f5d725ff7 100644
--- a/testsuite/tests/printer/Test20297.stdout
+++ b/testsuite/tests/printer/Test20297.stdout
@@ -24,7 +24,7 @@
"{-# OPTIONS -ddump-parsed-ast #-}")
{ Test20297.hs:1:1 }))]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
@@ -447,7 +447,7 @@
"{-# OPTIONS -ddump-parsed-ast #-}")
{ Test20297.ppr.hs:1:1 }))]
[]))
- (VirtualBraces
+ (EpVirtualBraces
(1))
(Nothing)
(Nothing))
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 82f45854edd9..17f2eed527ba 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -784,49 +784,40 @@ markEpAnnLMS' (EpAnn anc a cs) l kw (Just str) = do
-- ---------------------------------------------------------------------
-markLToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
- => Located (HsToken tok) -> EP w m (Located (HsToken tok))
-markLToken (L (RealSrcSpan aa mb) t) = do
- epaLoc'<- printStringAtAA (EpaSpan (RealSrcSpan aa mb)) (symbolVal (Proxy @tok))
- case epaLoc' of
- EpaSpan (RealSrcSpan aa' mb') -> return (L (RealSrcSpan aa' mb') t)
- _ -> return (L (RealSrcSpan aa mb ) t)
-markLToken (L lt t) = return (L lt t)
-
-markToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
- => LHsToken tok GhcPs -> EP w m (LHsToken tok GhcPs)
-markToken (L NoTokenLoc t) = return (L NoTokenLoc t)
-markToken (L (TokenLoc aa) t) = do
+markEpToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
+ => EpToken tok -> EP w m (EpToken tok)
+markEpToken NoEpTok = return NoEpTok
+markEpToken (EpTok aa) = do
aa' <- printStringAtAA aa (symbolVal (Proxy @tok))
- return (L (TokenLoc aa') t)
+ return (EpTok aa')
-markUniToken :: forall m w tok utok. (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)
- => LHsUniToken tok utok GhcPs -> EP w m (LHsUniToken tok utok GhcPs)
-markUniToken (L l HsNormalTok) = do
- (L l' _) <- markToken (L l (HsTok @tok))
- return (L l' HsNormalTok)
-markUniToken (L l HsUnicodeTok) = do
- (L l' _) <- markToken (L l (HsTok @utok))
- return (L l' HsUnicodeTok)
+markEpUniToken :: forall m w tok utok . (Monad m, Monoid w, KnownSymbol tok, KnownSymbol utok)
+ => EpUniToken tok utok -> EP w m (EpUniToken tok utok)
+markEpUniToken NoEpUniTok = return NoEpUniTok
+markEpUniToken (EpUniTok aa isUnicode) = do
+ aa' <- case isUnicode of
+ NormalSyntax -> printStringAtAA aa (symbolVal (Proxy @tok))
+ UnicodeSyntax -> printStringAtAA aa (symbolVal (Proxy @utok))
+ return (EpUniTok aa' isUnicode)
-- ---------------------------------------------------------------------
markArrow :: (Monad m, Monoid w) => HsArrow GhcPs -> EP w m (HsArrow GhcPs)
markArrow (HsUnrestrictedArrow arr) = do
- arr' <- markUniToken arr
+ arr' <- markEpUniToken arr
return (HsUnrestrictedArrow arr')
-markArrow (HsLinearArrow (HsPct1 pct1 arr)) = do
- pct1' <- markToken pct1
- arr' <- markUniToken arr
- return (HsLinearArrow (HsPct1 pct1' arr'))
-markArrow (HsLinearArrow (HsLolly arr)) = do
- arr' <- markToken arr
- return (HsLinearArrow (HsLolly arr'))
-markArrow (HsExplicitMult pct t arr) = do
- pct' <- markToken pct
+markArrow (HsLinearArrow (EpPct1 pct1 arr)) = do
+ pct1' <- markEpToken pct1
+ arr' <- markEpUniToken arr
+ return (HsLinearArrow (EpPct1 pct1' arr'))
+markArrow (HsLinearArrow (EpLolly arr)) = do
+ arr' <- markEpToken arr
+ return (HsLinearArrow (EpLolly arr'))
+markArrow (HsExplicitMult (pct, arr) t) = do
+ pct' <- markEpToken pct
t' <- markAnnotated t
- arr' <- markUniToken arr
- return (HsExplicitMult pct' t' arr')
+ arr' <- markEpUniToken arr
+ return (HsExplicitMult (pct', arr') t')
-- ---------------------------------------------------------------------
@@ -1544,16 +1535,16 @@ instance ExactPrint (HsModule GhcPs) where
return (an1, Just m', mdeprec', mexports')
lo0 <- case lo of
- ExplicitBraces open close -> do
- open' <- markToken open
- return (ExplicitBraces open' close)
+ EpExplicitBraces open close -> do
+ open' <- markEpToken open
+ return (EpExplicitBraces open' close)
_ -> return lo
am_decls' <- markTrailing (am_decls $ anns an0)
imports' <- markTopLevelList imports
case lo of
- ExplicitBraces _ _ -> return ()
+ EpExplicitBraces _ _ -> return ()
_ -> do
-- Get rid of the balance of the preceding comments before starting on the decls
flushComments []
@@ -1562,9 +1553,9 @@ instance ExactPrint (HsModule GhcPs) where
decls' <- markTopLevelList (filter removeDocDecl decls)
lo1 <- case lo0 of
- ExplicitBraces open close -> do
- close' <- markToken close
- return (ExplicitBraces open close')
+ EpExplicitBraces open close -> do
+ close' <- markEpToken close
+ return (EpExplicitBraces open close')
_ -> return lo
-- Print EOF
@@ -1622,7 +1613,7 @@ instance ExactPrint InWarningCategory where
setAnnotationAnchor a _ _ _ = a
exact (InWarningCategory tkIn source (L l wc)) = do
- tkIn' <- markLToken tkIn
+ tkIn' <- markEpToken tkIn
L _ (_,wc') <- markAnnotated (L l (source, wc))
return (InWarningCategory tkIn' source (L l wc'))
@@ -2214,9 +2205,9 @@ instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact a@(HsValArg tm) = markAnnotated tm >> return a
- exact a@(HsTypeArg at ty) = markToken at >> markAnnotated ty >> return a
- exact x@(HsArgPar _sp) = withPpr x -- Does not appear in original source
+ exact a@(HsValArg _ tm) = markAnnotated tm >> return a
+ exact a@(HsTypeArg at ty) = markEpToken at >> markAnnotated ty >> return a
+ exact x@(HsArgPar _sp) = withPpr x -- Does not appear in original source
-- ---------------------------------------------------------------------
@@ -2850,10 +2841,10 @@ instance ExactPrint (HsExpr GhcPs) where
getAnnotationEntry (HsLit an _) = fromAnn an
getAnnotationEntry (HsLam an _ _) = fromAnn an
getAnnotationEntry (HsApp an _ _) = fromAnn an
- getAnnotationEntry (HsAppType _ _ _ _) = NoEntryVal
+ getAnnotationEntry (HsAppType _ _ _) = NoEntryVal
getAnnotationEntry (OpApp an _ _ _) = fromAnn an
getAnnotationEntry (NegApp an _ _) = fromAnn an
- getAnnotationEntry (HsPar an _ _ _) = fromAnn an
+ getAnnotationEntry (HsPar{}) = NoEntryVal
getAnnotationEntry (SectionL an _ _) = fromAnn an
getAnnotationEntry (SectionR an _ _) = fromAnn an
getAnnotationEntry (ExplicitTuple an _ _) = fromAnn an
@@ -2861,7 +2852,7 @@ instance ExactPrint (HsExpr GhcPs) where
getAnnotationEntry (HsCase an _ _) = fromAnn an
getAnnotationEntry (HsIf an _ _ _) = fromAnn an
getAnnotationEntry (HsMultiIf an _) = fromAnn an
- getAnnotationEntry (HsLet an _ _ _ _) = fromAnn an
+ getAnnotationEntry (HsLet _ _ _) = NoEntryVal
getAnnotationEntry (HsDo an _ _) = fromAnn an
getAnnotationEntry (ExplicitList an _) = fromAnn an
getAnnotationEntry (RecordCon an _ _) = fromAnn an
@@ -2891,7 +2882,7 @@ instance ExactPrint (HsExpr GhcPs) where
setAnnotationAnchor a@(HsAppType {}) _ _ _s = a
setAnnotationAnchor (OpApp an a b c) anc ts cs = (OpApp (setAnchorEpa an anc ts cs) a b c)
setAnnotationAnchor (NegApp an a b) anc ts cs = (NegApp (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsPar an a b c) anc ts cs = (HsPar (setAnchorEpa an anc ts cs) a b c)
+ setAnnotationAnchor a@(HsPar {}) _ _ _s = a
setAnnotationAnchor (SectionL an a b) anc ts cs = (SectionL (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (SectionR an a b) anc ts cs = (SectionR (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (ExplicitTuple an a b) anc ts cs = (ExplicitTuple (setAnchorEpa an anc ts cs) a b)
@@ -2899,7 +2890,7 @@ instance ExactPrint (HsExpr GhcPs) where
setAnnotationAnchor (HsCase an a b) anc ts cs = (HsCase (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (HsIf an a b c) anc ts cs = (HsIf (setAnchorEpa an anc ts cs) a b c)
setAnnotationAnchor (HsMultiIf an a) anc ts cs = (HsMultiIf (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (HsLet an a b c d) anc ts cs = (HsLet (setAnchorEpa an anc ts cs) a b c d)
+ setAnnotationAnchor a@(HsLet{}) _ _ _s = a
setAnnotationAnchor (HsDo an a b) anc ts cs = (HsDo (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (ExplicitList an a) anc ts cs = (ExplicitList (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor (RecordCon an a b) anc ts cs = (RecordCon (setAnchorEpa an anc ts cs) a b)
@@ -2974,11 +2965,11 @@ instance ExactPrint (HsExpr GhcPs) where
e1' <- markAnnotated e1
e2' <- markAnnotated e2
return (HsApp an e1' e2')
- exact (HsAppType ss fun at arg) = do
+ exact (HsAppType at fun arg) = do
fun' <- markAnnotated fun
- at' <- markToken at
+ at' <- markEpToken at
arg' <- markAnnotated arg
- return (HsAppType ss fun' at' arg')
+ return (HsAppType at' fun' arg')
exact (OpApp an e1 e2 e3) = do
e1' <- markAnnotated e1
e2' <- markAnnotated e2
@@ -2990,13 +2981,13 @@ instance ExactPrint (HsExpr GhcPs) where
e' <- markAnnotated e
return (NegApp an0 e' s)
- exact (HsPar an lpar e rpar) = do
- lpar' <- markToken lpar
+ exact (HsPar (lpar, rpar) e) = do
+ lpar' <- markEpToken lpar
e' <- markAnnotated e
debugM $ "HsPar closing paren"
- rpar' <- markToken rpar
+ rpar' <- markEpToken rpar
debugM $ "HsPar done"
- return (HsPar an lpar' e' rpar')
+ return (HsPar (lpar', rpar') e')
exact (SectionL an expr op) = do
expr' <- markAnnotated expr
@@ -3055,16 +3046,13 @@ instance ExactPrint (HsExpr GhcPs) where
an2 <- markEpAnnL an1 lidl AnnCloseC -- optional
return (HsMultiIf an2 mg')
- exact (HsLet an tkLet binds tkIn e) = do
+ exact (HsLet (tkLet, tkIn) binds e) = do
setLayoutBoth $ do -- Make sure the 'in' gets indented too
- tkLet' <- markToken tkLet
- debugM $ "HSlet:binds coming"
+ tkLet' <- markEpToken tkLet
binds' <- setLayoutBoth $ markAnnotated binds
- debugM $ "HSlet:binds done"
- tkIn' <- markToken tkIn
- debugM $ "HSlet:expr coming"
+ tkIn' <- markEpToken tkIn
e' <- markAnnotated e
- return (HsLet an tkLet' binds' tkIn' e')
+ return (HsLet (tkLet',tkIn') binds' e')
exact (HsDo an do_or_list_comp stmts) = do
debugM $ "HsDo"
@@ -3206,6 +3194,12 @@ instance ExactPrint (HsExpr GhcPs) where
prag' <- markAnnotated prag
e' <- markAnnotated e
return (HsPragE a prag' e')
+
+ exact (HsEmbTy toktype t) = do
+ toktype' <- markEpToken toktype
+ t' <- markAnnotated t
+ return (HsEmbTy toktype' t')
+
exact x = error $ "exact HsExpr for:" ++ showAst x
-- ---------------------------------------------------------------------
@@ -3423,21 +3417,21 @@ instance ExactPrint (HsCmd GhcPs) where
getAnnotationEntry (HsCmdArrApp an _ _ _ _) = fromAnn an
getAnnotationEntry (HsCmdArrForm an _ _ _ _ ) = fromAnn an
getAnnotationEntry (HsCmdApp an _ _ ) = fromAnn an
- getAnnotationEntry (HsCmdPar an _ _ _) = fromAnn an
+ getAnnotationEntry (HsCmdPar _ _) = NoEntryVal
getAnnotationEntry (HsCmdCase an _ _) = fromAnn an
getAnnotationEntry (HsCmdLam an _ _) = fromAnn an
getAnnotationEntry (HsCmdIf an _ _ _ _) = fromAnn an
- getAnnotationEntry (HsCmdLet an _ _ _ _) = fromAnn an
+ getAnnotationEntry (HsCmdLet _ _ _) = NoEntryVal
getAnnotationEntry (HsCmdDo an _) = fromAnn an
setAnnotationAnchor (HsCmdArrApp an a b c d) anc ts cs = (HsCmdArrApp (setAnchorEpa an anc ts cs) a b c d)
setAnnotationAnchor (HsCmdArrForm an a b c d ) anc ts cs = (HsCmdArrForm (setAnchorEpa an anc ts cs) a b c d )
setAnnotationAnchor (HsCmdApp an a b ) anc ts cs = (HsCmdApp (setAnchorEpa an anc ts cs) a b )
setAnnotationAnchor (HsCmdLam an a b) anc ts cs = (HsCmdLam (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsCmdPar an a b c) anc ts cs = (HsCmdPar (setAnchorEpa an anc ts cs) a b c)
+ setAnnotationAnchor a@(HsCmdPar _ _) _ _ _s = a
setAnnotationAnchor (HsCmdCase an a b) anc ts cs = (HsCmdCase (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor (HsCmdIf an a b c d) anc ts cs = (HsCmdIf (setAnchorEpa an anc ts cs) a b c d)
- setAnnotationAnchor (HsCmdLet an a b c d) anc ts cs = (HsCmdLet (setAnchorEpa an anc ts cs) a b c d)
+ setAnnotationAnchor a@(HsCmdLet _ _ _) _ _ _s = a
setAnnotationAnchor (HsCmdDo an a) anc ts cs = (HsCmdDo (setAnchorEpa an anc ts cs) a)
exact (HsCmdArrApp an arr arg o isRightToLeft) = do
@@ -3485,11 +3479,11 @@ instance ExactPrint (HsCmd GhcPs) where
matches' <- markAnnotated matches
return (HsCmdLam an1 lam_variant matches')
- exact (HsCmdPar an lpar e rpar) = do
- lpar' <- markToken lpar
+ exact (HsCmdPar (lpar, rpar) e) = do
+ lpar' <- markEpToken lpar
e' <- markAnnotated e
- rpar' <- markToken rpar
- return (HsCmdPar an lpar' e' rpar')
+ rpar' <- markEpToken rpar
+ return (HsCmdPar (lpar', rpar') e')
exact (HsCmdCase an e alts) = do
an0 <- markLensKw an lhsCaseAnnCase AnnCase
@@ -3512,13 +3506,13 @@ instance ExactPrint (HsCmd GhcPs) where
e3' <- markAnnotated e3
return (HsCmdIf an4 a e1' e2' e3')
- exact (HsCmdLet an tkLet binds tkIn e) = do
+ exact (HsCmdLet (tkLet, tkIn) binds e) = do
setLayoutBoth $ do -- Make sure the 'in' gets indented too
- tkLet' <- markToken tkLet
+ tkLet' <- markEpToken tkLet
binds' <- setLayoutBoth $ markAnnotated binds
- tkIn' <- markToken tkIn
+ tkIn' <- markEpToken tkIn
e' <- markAnnotated e
- return (HsCmdLet an tkLet' binds' tkIn' e')
+ return (HsCmdLet (tkLet', tkIn') binds' e')
exact (HsCmdDo an es) = do
debugM $ "HsCmdDo"
@@ -3641,14 +3635,14 @@ instance ExactPrint (TyClDecl GhcPs) where
getAnnotationEntry (FamDecl { }) = NoEntryVal
getAnnotationEntry (SynDecl { tcdSExt = an }) = fromAnn an
getAnnotationEntry (DataDecl { tcdDExt = an }) = fromAnn an
- getAnnotationEntry (ClassDecl { tcdCExt = (an, _) }) = fromAnn an
+ getAnnotationEntry (ClassDecl { tcdCExt = (an, _, _) }) = fromAnn an
setAnnotationAnchor a@FamDecl{} _ _ _s = a
setAnnotationAnchor x@SynDecl{} anc ts cs = x { tcdSExt = setAnchorEpa (tcdSExt x) anc ts cs }
setAnnotationAnchor x@DataDecl{} anc ts cs = x { tcdDExt = setAnchorEpa (tcdDExt x) anc ts cs }
- setAnnotationAnchor x@ClassDecl{} anc ts cs = x { tcdCExt = (setAnchorEpa an anc ts cs, a) }
+ setAnnotationAnchor x@ClassDecl{} anc ts cs = x { tcdCExt = (setAnchorEpa an anc ts cs, layout, a) }
where
- (an,a) = tcdCExt x
+ (an,layout,a) = tcdCExt x
exact (FamDecl a decl) = do
decl' <- markAnnotated decl
@@ -3680,8 +3674,7 @@ instance ExactPrint (TyClDecl GhcPs) where
-- -----------------------------------
- exact (ClassDecl {tcdCExt = (an, sortKey),
- tcdLayout = lo,
+ exact (ClassDecl {tcdCExt = (an, lo, sortKey),
tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdFDs = fds,
@@ -3694,8 +3687,7 @@ instance ExactPrint (TyClDecl GhcPs) where
(an0, fds', lclas', tyvars',context') <- top_matter
an1 <- markEpAnnL an0 lidl AnnOpenC
an2 <- markEpAnnL an1 lidl AnnCloseC
- return (ClassDecl {tcdCExt = (an2, sortKey),
- tcdLayout = lo,
+ return (ClassDecl {tcdCExt = (an2, lo, sortKey),
tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
tcdFixity = fixity,
tcdFDs = fds',
@@ -3721,8 +3713,7 @@ instance ExactPrint (TyClDecl GhcPs) where
methods' = listToBag $ undynamic ds
ats' = undynamic ds
at_defs' = undynamic ds
- return (ClassDecl {tcdCExt = (an3, sortKey),
- tcdLayout = lo,
+ return (ClassDecl {tcdCExt = (an3, lo, sortKey),
tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
tcdFixity = fixity,
tcdFDs = fds',
@@ -3967,8 +3958,8 @@ instance ExactPrintTVFlag Specificity where
instance ExactPrintTVFlag (HsBndrVis GhcPs) where
exactTVDelimiters an0 bvis thing_inside = do
case bvis of
- HsBndrRequired -> return ()
- HsBndrInvisible at -> markToken at >> return ()
+ HsBndrRequired _ -> return ()
+ HsBndrInvisible at -> markEpToken at >> return ()
an1 <- markEpAnnAllL an0 lid AnnOpenP
r <- thing_inside
an2 <- markEpAnnAllL an1 lid AnnCloseP
@@ -4005,7 +3996,7 @@ instance ExactPrint (HsType GhcPs) where
getAnnotationEntry (HsQualTy _ _ _) = NoEntryVal
getAnnotationEntry (HsTyVar an _ _) = fromAnn an
getAnnotationEntry (HsAppTy _ _ _) = NoEntryVal
- getAnnotationEntry (HsAppKindTy _ _ _ _) = NoEntryVal
+ getAnnotationEntry (HsAppKindTy _ _ _) = NoEntryVal
getAnnotationEntry (HsFunTy an _ _ _) = fromAnn an
getAnnotationEntry (HsListTy an _) = fromAnn an
getAnnotationEntry (HsTupleTy an _ _) = fromAnn an
@@ -4029,7 +4020,7 @@ instance ExactPrint (HsType GhcPs) where
setAnnotationAnchor a@(HsQualTy _ _ _) _ _ _s = a
setAnnotationAnchor (HsTyVar an a b) anc ts cs = (HsTyVar (setAnchorEpa an anc ts cs) a b)
setAnnotationAnchor a@(HsAppTy _ _ _) _ _ _s = a
- setAnnotationAnchor a@(HsAppKindTy _ _ _ _) _ _ _s = a
+ setAnnotationAnchor a@(HsAppKindTy _ _ _) _ _ _s = a
setAnnotationAnchor (HsFunTy an a b c) anc ts cs = (HsFunTy (setAnchorEpa an anc ts cs) a b c)
setAnnotationAnchor (HsListTy an a) anc ts cs = (HsListTy (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor (HsTupleTy an a b) anc ts cs = (HsTupleTy (setAnchorEpa an anc ts cs) a b)
@@ -4070,11 +4061,11 @@ instance ExactPrint (HsType GhcPs) where
t1' <- markAnnotated t1
t2' <- markAnnotated t2
return (HsAppTy an t1' t2')
- exact (HsAppKindTy ss ty at ki) = do
+ exact (HsAppKindTy at ty ki) = do
ty' <- markAnnotated ty
- at' <- markToken at
+ at' <- markEpToken at
ki' <- markAnnotated ki
- return (HsAppKindTy ss ty' at' ki')
+ return (HsAppKindTy at' ty' ki')
exact (HsFunTy an mult ty1 ty2) = do
ty1' <- markAnnotated ty1
mult' <- markArrow mult
@@ -4399,10 +4390,10 @@ exact_condecls an cs
-- ---------------------------------------------------------------------
instance ExactPrint (ConDecl GhcPs) where
- getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (con_g_ext x)
+ getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (snd (con_g_ext x))
getAnnotationEntry x@(ConDeclH98{}) = fromAnn (con_ext x)
- setAnnotationAnchor x@ConDeclGADT{} anc ts cs = x { con_g_ext = setAnchorEpa (con_g_ext x) anc ts cs}
+ setAnnotationAnchor x@ConDeclGADT{} anc ts cs = x { con_g_ext = fmap (\an -> setAnchorEpa an anc ts cs) (con_g_ext x) }
setAnnotationAnchor x@ConDeclH98{} anc ts cs = x { con_ext = setAnchorEpa (con_ext x) anc ts cs}
-- based on pprConDecl
@@ -4454,14 +4445,13 @@ instance ExactPrint (ConDecl GhcPs) where
-- -----------------------------------
- exact (ConDeclGADT { con_g_ext = an
+ exact (ConDeclGADT { con_g_ext = (dcol, an)
, con_names = cons
- , con_dcolon = dcol
, con_bndrs = bndrs
, con_mb_cxt = mcxt, con_g_args = args
, con_res_ty = res_ty, con_doc = doc }) = do
cons' <- mapM markAnnotated cons
- dcol' <- markUniToken dcol
+ dcol' <- markEpUniToken dcol
an1 <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]
-- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
@@ -4475,17 +4465,16 @@ instance ExactPrint (ConDecl GhcPs) where
else return an1
args' <-
case args of
- (PrefixConGADT args0) -> do
+ (PrefixConGADT x args0) -> do
args0' <- mapM markAnnotated args0
- return (PrefixConGADT args0')
- (RecConGADT fields rarr) -> do
+ return (PrefixConGADT x args0')
+ (RecConGADT rarr fields) -> do
fields' <- markAnnotated fields
- rarr' <- markUniToken rarr
- return (RecConGADT fields' rarr')
+ rarr' <- markEpUniToken rarr
+ return (RecConGADT rarr' fields')
res_ty' <- markAnnotated res_ty
- return (ConDeclGADT { con_g_ext = an2
+ return (ConDeclGADT { con_g_ext = (dcol', an2)
, con_names = cons'
- , con_dcolon = dcol'
, con_bndrs = bndrs'
, con_mb_cxt = mcxt', con_g_args = args'
, con_res_ty = res_ty', con_doc = doc })
@@ -4756,8 +4745,8 @@ instance ExactPrint (Pat GhcPs) where
getAnnotationEntry (WildPat _) = NoEntryVal
getAnnotationEntry (VarPat _ _) = NoEntryVal
getAnnotationEntry (LazyPat an _) = fromAnn an
- getAnnotationEntry (AsPat an _ _ _) = fromAnn an
- getAnnotationEntry (ParPat an _ _ _) = fromAnn an
+ getAnnotationEntry (AsPat _ _ _) = NoEntryVal
+ getAnnotationEntry (ParPat _ _) = NoEntryVal
getAnnotationEntry (BangPat an _) = fromAnn an
getAnnotationEntry (ListPat an _) = fromAnn an
getAnnotationEntry (TuplePat an _ _) = fromAnn an
@@ -4769,13 +4758,13 @@ instance ExactPrint (Pat GhcPs) where
getAnnotationEntry (NPat an _ _ _) = fromAnn an
getAnnotationEntry (NPlusKPat an _ _ _ _ _) = fromAnn an
getAnnotationEntry (SigPat an _ _) = fromAnn an
- getAnnotationEntry (EmbTyPat _ _ _) = NoEntryVal
+ getAnnotationEntry (EmbTyPat _ _) = NoEntryVal
setAnnotationAnchor a@(WildPat _) _ _ _s = a
setAnnotationAnchor a@(VarPat _ _) _ _ _s = a
setAnnotationAnchor (LazyPat an a) anc ts cs = (LazyPat (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (AsPat an a at b) anc ts cs = (AsPat (setAnchorEpa an anc ts cs) a at b)
- setAnnotationAnchor (ParPat an a b c) anc ts cs = (ParPat (setAnchorEpa an anc ts cs) a b c)
+ setAnnotationAnchor a@(AsPat _ _ _) _ _ _s = a
+ setAnnotationAnchor a@(ParPat _ _) _ _ _s = a
setAnnotationAnchor (BangPat an a) anc ts cs = (BangPat (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor (ListPat an a) anc ts cs = (ListPat (setAnchorEpa an anc ts cs) a)
setAnnotationAnchor (TuplePat an a b) anc ts cs = (TuplePat (setAnchorEpa an anc ts cs) a b)
@@ -4787,7 +4776,7 @@ instance ExactPrint (Pat GhcPs) where
setAnnotationAnchor (NPat an a b c) anc ts cs = (NPat (setAnchorEpa an anc ts cs) a b c)
setAnnotationAnchor (NPlusKPat an a b c d e) anc ts cs = (NPlusKPat (setAnchorEpa an anc ts cs) a b c d e)
setAnnotationAnchor (SigPat an a b) anc ts cs = (SigPat (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(EmbTyPat _ _ _) _ _ _s = a
+ setAnnotationAnchor a@(EmbTyPat _ _) _ _ _s = a
exact (WildPat w) = do
anchor' <- getAnchorU
@@ -4806,16 +4795,16 @@ instance ExactPrint (Pat GhcPs) where
an0 <- markEpAnnL an lidl AnnTilde
pat' <- markAnnotated pat
return (LazyPat an0 pat')
- exact (AsPat an n at pat) = do
+ exact (AsPat at n pat) = do
n' <- markAnnotated n
- at' <- markToken at
+ at' <- markEpToken at
pat' <- markAnnotated pat
- return (AsPat an n' at' pat')
- exact (ParPat an lpar pat rpar) = do
- lpar' <- markToken lpar
+ return (AsPat at' n' pat')
+ exact (ParPat (lpar, rpar) pat) = do
+ lpar' <- markEpToken lpar
pat' <- markAnnotated pat
- rpar' <- markToken rpar
- return (ParPat an lpar' pat' rpar')
+ rpar' <- markEpToken rpar
+ return (ParPat (lpar', rpar') pat')
exact (BangPat an pat) = do
an0 <- markEpAnnL an lidl AnnBang
@@ -4875,10 +4864,10 @@ instance ExactPrint (Pat GhcPs) where
sig' <- markAnnotated sig
return (SigPat an0 pat' sig')
- exact (EmbTyPat x toktype tp) = do
- toktype' <- markToken toktype
+ exact (EmbTyPat toktype tp) = do
+ toktype' <- markEpToken toktype
tp' <- markAnnotated tp
- return (EmbTyPat x toktype' tp')
+ return (EmbTyPat toktype' tp')
-- ---------------------------------------------------------------------
@@ -4968,7 +4957,7 @@ instance ExactPrint (HsConPatTyArg GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
exact (HsConPatTyArg at tyarg) = do
- at' <- markToken at
+ at' <- markEpToken at
tyarg' <- markAnnotated tyarg
return (HsConPatTyArg at' tyarg')
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 36e486d272f1..570f2790ec04 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -444,7 +444,7 @@ changeLetIn1 _libdir parsed
= return (everywhere (mkT replace) parsed)
where
replace :: HsExpr GhcPs -> HsExpr GhcPs
- replace (HsLet an tkLet localDecls _ expr)
+ replace (HsLet (tkLet, _) localDecls expr)
=
let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls
[l2,_l1] = map wrapDecl $ bagToList bagDecls
@@ -452,9 +452,9 @@ changeLetIn1 _libdir parsed
(L _ e) = expr
a = EpAnn (EpaDelta (SameLine 1) []) noAnn emptyComments
expr' = L a e
- tkIn' = L (TokenLoc (EpaDelta (DifferentLine 1 0) [])) HsTok
- in (HsLet an tkLet
- (HsValBinds x (ValBinds xv bagDecls' sigs)) tkIn' expr')
+ tkIn' = EpTok (EpaDelta (DifferentLine 1 0) [])
+ in (HsLet (tkLet, tkIn')
+ (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
replace x = x
@@ -802,13 +802,13 @@ rmDecl5 _libdir lp = do
doRmDecl = do
let
go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
- go (HsLet a tkLet lb tkIn expr) = do
+ go (HsLet (tkLet, tkIn) lb expr) = do
let decs = hsDeclsLocalBinds lb
let hdecs : _ = decs
let dec = last decs
_ <- transferEntryDP hdecs dec
lb' <- replaceDeclsValbinds WithoutWhere lb [dec]
- return (HsLet a tkLet lb' tkIn expr)
+ return (HsLet (tkLet, tkIn) lb' expr)
go x = return x
everywhereM (mkM go) lp
diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs
index 6cfd614aae21..39e3d0250fc3 100644
--- a/utils/check-exact/Parsers.hs
+++ b/utils/check-exact/Parsers.hs
@@ -283,7 +283,7 @@ fixModuleTrailingComments (GHC.L l p) = GHC.L l p'
rebalance cs = cs'
where
cs' = case GHC.hsmodLayout $ GHC.hsmodExt p of
- GHC.ExplicitBraces _ (GHC.L (GHC.TokenLoc (GHC.EpaSpan (GHC.RealSrcSpan ss _))) _) ->
+ GHC.EpExplicitBraces _ (GHC.EpTok (GHC.EpaSpan (GHC.RealSrcSpan ss _))) ->
let
pc = GHC.priorComments cs
fc = GHC.getFollowingComments cs
diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs
index 885156301ca7..c12b1624d858 100644
--- a/utils/check-exact/Transform.hs
+++ b/utils/check-exact/Transform.hs
@@ -875,16 +875,16 @@ instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
-- ---------------------------------------------------------------------
instance HasDecls (LocatedA (HsExpr GhcPs)) where
- hsDecls (L _ (HsLet _ _ decls _ _ex)) = return $ hsDeclsLocalBinds decls
- hsDecls _ = return []
+ hsDecls (L _ (HsLet _ decls _ex)) = return $ hsDeclsLocalBinds decls
+ hsDecls _ = return []
- replaceDecls (L ll (HsLet x tkLet binds tkIn ex)) newDecls
+ replaceDecls (L ll (HsLet (tkLet, tkIn) binds ex)) newDecls
= do
logTr "replaceDecls HsLet"
let lastAnc = realSrcSpan $ spanHsLocaLBinds binds
-- TODO: may be an intervening comment, take account for lastAnc
let (tkLet', tkIn', ex',newDecls') = case (tkLet, tkIn) of
- (L (TokenLoc l) ls, L (TokenLoc i) is) ->
+ (EpTok l, EpTok i) ->
let
off = case l of
(EpaSpan (RealSrcSpan r _)) -> LayoutStartCol $ snd $ ss2pos r
@@ -895,20 +895,20 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where
newDecls'' = case newDecls of
[] -> newDecls
(d:ds) -> setEntryDPDecl d (SameLine 0) : ds
- in ( L (TokenLoc l) ls
- , L (TokenLoc (addEpaLocationDelta off lastAnc i)) is
+ in ( EpTok l
+ , EpTok (addEpaLocationDelta off lastAnc i)
, ex''
, newDecls'')
(_,_) -> (tkLet, tkIn, ex, newDecls)
binds' <- replaceDeclsValbinds WithoutWhere binds newDecls'
- return (L ll (HsLet x tkLet' binds' tkIn' ex'))
+ return (L ll (HsLet (tkLet', tkIn') binds' ex'))
-- TODO: does this make sense? Especially as no hsDecls for HsPar
- replaceDecls (L l (HsPar x lpar e rpar)) newDecls
+ replaceDecls (L l (HsPar x e)) newDecls
= do
logTr "replaceDecls HsPar"
e' <- replaceDecls e newDecls
- return (L l (HsPar x lpar e' rpar))
+ return (L l (HsPar x e'))
replaceDecls old _new = error $ "replaceDecls (LHsExpr GhcPs) undefined for:" ++ showGhc old
-- ---------------------------------------------------------------------
diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs
index 89f8aecbc093..13958966244f 100644
--- a/utils/check-exact/Utils.hs
+++ b/utils/check-exact/Utils.hs
@@ -476,7 +476,7 @@ orderedDecls sortKey declGroup =
hsDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs]
hsDeclsClassDecl dec = case dec of
- ClassDecl { tcdCExt = (_an2, sortKey),
+ ClassDecl { tcdCExt = (_an2, _layout, sortKey),
tcdSigs = sigs,tcdMeths = methods,
tcdATs = ats, tcdATDefs = at_defs
} -> map snd decls
@@ -494,10 +494,10 @@ hsDeclsClassDecl dec = case dec of
replaceDeclsClassDecl :: TyClDecl GhcPs -> [LHsDecl GhcPs] -> TyClDecl GhcPs
replaceDeclsClassDecl decl decls = case decl of
- ClassDecl { tcdCExt = (an2, _) } -> decl'
+ ClassDecl { tcdCExt = (an2, layout, _) } -> decl'
where
(tags, methods', sigs', ats', at_defs', _, _docs) = partitionWithSortKey decls
- decl' = decl { tcdCExt = (an2, AnnSortKey tags),
+ decl' = decl { tcdCExt = (an2, layout, AnnSortKey tags),
tcdSigs = sigs',tcdMeths = methods',
tcdATs = ats', tcdATDefs = at_defs'
}
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index 29505817b6fe..fb99008b50a7 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -46,7 +46,7 @@ testOneFile libdir fileName = do
let
origAst = showPprUnsafe
$ showAstData BlankSrcSpan BlankEpAnnotations
- $ eraseLayoutInfo (pm_parsed_source p)
+ $ eraseEpLayout (pm_parsed_source p)
pped = pragmas ++ "\n" ++ pp (pm_parsed_source p)
pragmas = getPragmas (pm_parsed_source p)
@@ -62,7 +62,7 @@ testOneFile libdir fileName = do
let newAstStr :: String
newAstStr = showPprUnsafe
$ showAstData BlankSrcSpan BlankEpAnnotations
- $ eraseLayoutInfo (pm_parsed_source p')
+ $ eraseEpLayout (pm_parsed_source p')
writeBinFile newAstFile newAstStr
if origAst == newAstStr
@@ -105,14 +105,14 @@ getPragmas (L _ (HsModule { hsmodExt = XModulePs { hsmodAnn = anns' } })) = prag
pp :: (Outputable a) => a -> String
pp a = showPprUnsafe a
-eraseLayoutInfo :: ParsedSource -> ParsedSource
-eraseLayoutInfo = everywhere go
+eraseEpLayout :: ParsedSource -> ParsedSource
+eraseEpLayout = everywhere go
where
go :: forall a. Typeable a => a -> a
go x =
- case eqT @a @(LayoutInfo GhcPs) of
+ case eqT @a @EpLayout of
Nothing -> x
- Just Refl -> NoLayoutInfo
+ Just Refl -> EpNoLayout
-- ---------------------------------------------------------------------
diff --git a/utils/haddock b/utils/haddock
index a7eae7da6868..b0b0e0366457 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit a7eae7da6868b22dc7109142475b228c60509812
+Subproject commit b0b0e0366457c9aefebcc94df74e5de4d00e17b7
--
GitLab