[Git][ghc/ghc][wip/az/epa-remove-addepann-4] EPA: Remove [AddEpAnn] Commit 4
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Fri Oct 18 17:12:26 UTC 2024
Alan Zimmerman pushed to branch wip/az/epa-remove-addepann-4 at Glasgow Haskell Compiler / GHC
Commits:
d783489b by Alan Zimmerman at 2024-10-18T18:11:33+01:00
EPA: Remove [AddEpAnn] Commit 4
EPA: Remove [AddEpAnn] from DataDecl
This is quite a big change.
The most important part is moving the annotations into HsDataDefn,
using a specific annotation data type.
It has a knock-on to everything that uses HsDataDefn
EPA: Remove [AddEpAnn] for FunDep
EPA: Remove [AddEpann] from FamilyDecl
EPA: Remove [AddEpAnn] From InjectivityAnn
EPA: Remove [AddEpAnn] from DefaultDecl
EPA: Remove [AddEpAnn] from RuleDecls
EPA: Remove [AddEpAnn] from Warnings
- - - - -
22 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/ThToHs.hs
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/printer/T18791.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
Changes:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -31,8 +31,10 @@ module GHC.Hs.Decls (
-- ** Class or type declarations
TyClDecl(..), LTyClDecl, DataDeclRn(..),
+ AnnDataDefn(..),
AnnClassDecl(..),
AnnSynDecl(..),
+ AnnFamilyDecl(..),
TyClGroup(..),
tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,
tyClGroupKindSigs,
@@ -359,7 +361,7 @@ type instance XSynDecl GhcPs = AnnSynDecl
type instance XSynDecl GhcRn = NameSet -- FVs
type instance XSynDecl GhcTc = NameSet -- FVs
-type instance XDataDecl GhcPs = [AddEpAnn]
+type instance XDataDecl GhcPs = NoExtField
type instance XDataDecl GhcRn = DataDeclRn
type instance XDataDecl GhcTc = DataDeclRn
@@ -379,9 +381,27 @@ type instance XClassDecl GhcTc = NameSet -- FVs
type instance XXTyClDecl (GhcPass _) = DataConCantHappen
-type instance XCTyFamInstDecl (GhcPass _) = [AddEpAnn]
+type instance XCTyFamInstDecl (GhcPass _) = (EpToken "type", EpToken "instance")
type instance XXTyFamInstDecl (GhcPass _) = DataConCantHappen
+data AnnDataDefn
+ = AnnDataDefn {
+ andd_openp :: [EpToken "("],
+ andd_closep :: [EpToken ")"],
+ andd_type :: EpToken "type",
+ andd_newtype :: EpToken "newtype",
+ andd_data :: EpToken "data",
+ andd_instance :: EpToken "instance",
+ andd_dcolon :: TokDcolon,
+ andd_where :: EpToken "where",
+ andd_openc :: EpToken "{",
+ andd_closec :: EpToken "}",
+ andd_equal :: EpToken "="
+ } deriving Data
+
+instance NoAnn AnnDataDefn where
+ noAnn = AnnDataDefn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn
+
data AnnClassDecl
= AnnClassDecl {
acd_class :: EpToken "class",
@@ -559,7 +579,7 @@ pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = nd } })
instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where
ppr = pprFunDep
-type instance XCFunDep (GhcPass _) = [AddEpAnn]
+type instance XCFunDep (GhcPass _) = TokRarrow
type instance XXFunDep (GhcPass _) = DataConCantHappen
pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc
@@ -593,9 +613,27 @@ type instance XCKindSig (GhcPass _) = NoExtField
type instance XTyVarSig (GhcPass _) = NoExtField
type instance XXFamilyResultSig (GhcPass _) = DataConCantHappen
-type instance XCFamilyDecl (GhcPass _) = [AddEpAnn]
+type instance XCFamilyDecl (GhcPass _) = AnnFamilyDecl
type instance XXFamilyDecl (GhcPass _) = DataConCantHappen
+data AnnFamilyDecl
+ = AnnFamilyDecl {
+ afd_openp :: [EpToken "("],
+ afd_closep :: [EpToken ")"],
+ afd_type :: EpToken "type",
+ afd_data :: EpToken "data",
+ afd_family :: EpToken "family",
+ afd_dcolon :: TokDcolon,
+ afd_equal :: EpToken "=",
+ afd_vbar :: EpToken "|",
+ afd_where :: EpToken "where",
+ afd_openc :: EpToken "{",
+ afd_dotdot :: EpToken "..",
+ afd_closec :: EpToken "}"
+ } deriving Data
+
+instance NoAnn AnnFamilyDecl where
+ noAnn = AnnFamilyDecl noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn noAnn
------------- Functions over FamilyDecls -----------
@@ -620,7 +658,7 @@ resultVariableName _ = Nothing
------------- Pretty printing FamilyDecls -----------
-type instance XCInjectivityAnn (GhcPass _) = [AddEpAnn]
+type instance XCInjectivityAnn (GhcPass _) = TokRarrow
type instance XXInjectivityAnn (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -664,7 +702,7 @@ instance OutputableBndrId p
* *
********************************************************************* -}
-type instance XCHsDataDefn (GhcPass _) = NoExtField
+type instance XCHsDataDefn (GhcPass _) = AnnDataDefn
type instance XXHsDataDefn (GhcPass _) = DataConCantHappen
type instance XCHsDerivingClause (GhcPass _) = [AddEpAnn]
@@ -854,7 +892,7 @@ ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
************************************************************************
-}
-type instance XCFamEqn (GhcPass _) r = [AddEpAnn]
+type instance XCFamEqn (GhcPass _) r = ([EpToken "("], [EpToken ")"], EpToken "=")
type instance XXFamEqn (GhcPass _) r = DataConCantHappen
----------------- Class instances -------------
@@ -1145,7 +1183,7 @@ mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds
************************************************************************
-}
-type instance XCDefaultDecl GhcPs = [AddEpAnn]
+type instance XCDefaultDecl GhcPs = (EpToken "default", EpToken "(", EpToken ")")
type instance XCDefaultDecl GhcRn = NoExtField
type instance XCDefaultDecl GhcTc = NoExtField
@@ -1233,7 +1271,7 @@ instance OutputableBndrId p
************************************************************************
-}
-type instance XCRuleDecls GhcPs = ([AddEpAnn], SourceText)
+type instance XCRuleDecls GhcPs = ((EpaLocation, EpaLocation), SourceText)
type instance XCRuleDecls GhcRn = SourceText
type instance XCRuleDecls GhcTc = SourceText
@@ -1318,7 +1356,7 @@ pprFullRuleName st (L _ n) = pprWithSourceText st (doubleQuotes $ ftext n)
************************************************************************
-}
-type instance XWarnings GhcPs = ([AddEpAnn], SourceText)
+type instance XWarnings GhcPs = ((EpaLocation, EpaLocation), SourceText)
type instance XWarnings GhcRn = SourceText
type instance XWarnings GhcTc = SourceText
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -61,6 +61,8 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`ext1Q` list
`extQ` list_addEpAnn
`extQ` list_epaLocation
+ `extQ` list_epTokenOpenP
+ `extQ` list_epTokenCloseP
`extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan
`extQ` annotationModule
`extQ` annotationGrhsAnn
@@ -72,9 +74,13 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`extQ` addEpAnn
`extQ` epTokenOC
`extQ` epTokenCC
+ `extQ` epTokenInstance
+ `extQ` epTokenForall
`extQ` annParen
`extQ` annClassDecl
`extQ` annSynDecl
+ `extQ` annDataDefn
+ `extQ` annFamilyDecl
`extQ` lit `extQ` litr `extQ` litt
`extQ` sourceText
`extQ` deltaPos
@@ -118,6 +124,18 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
$ text "blanked:" <+> text "[EpaLocation]"
NoBlankEpAnnotations -> list ls
+ list_epTokenOpenP :: [EpToken "("] -> SDoc
+ list_epTokenOpenP ls = case ba of
+ BlankEpAnnotations -> parens
+ $ text "blanked:" <+> text "[EpToken \"(\"]"
+ NoBlankEpAnnotations -> list ls
+
+ list_epTokenCloseP :: [EpToken ")"] -> SDoc
+ list_epTokenCloseP ls = case ba of
+ BlankEpAnnotations -> parens
+ $ text "blanked:" <+> text "[EpToken \"(\"]"
+ NoBlankEpAnnotations -> list ls
+
list [] = brackets empty
list [x] = brackets (showAstData' x)
list (x1 : x2 : xs) = (text "[" <> showAstData' x1)
@@ -224,6 +242,26 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
$$ vcat [showAstData' ops, showAstData' cps,
showAstData' t, showAstData' e]
+ annDataDefn :: AnnDataDefn -> SDoc
+ annDataDefn (AnnDataDefn a b c d e f g h i j k) = case ba of
+ BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnDataDefn"
+ NoBlankEpAnnotations ->
+ parens $ text "AnnDataDefn"
+ $$ vcat [showAstData' a, showAstData' b, showAstData' c,
+ showAstData' d, showAstData' e, showAstData' f,
+ showAstData' g, showAstData' h, showAstData' i,
+ showAstData' j, showAstData' k]
+
+ annFamilyDecl :: AnnFamilyDecl -> SDoc
+ annFamilyDecl (AnnFamilyDecl a b c d e f g h i j k l) = case ba of
+ BlankEpAnnotations -> parens $ text "blanked:" <+> text "AnnFamilyDecl"
+ NoBlankEpAnnotations ->
+ parens $ text "AnnFamilyDecl"
+ $$ vcat [showAstData' a, showAstData' b, showAstData' c,
+ showAstData' d, showAstData' e, showAstData' f,
+ showAstData' g, showAstData' h, showAstData' i,
+ showAstData' j, showAstData' k, showAstData' l]
+
addEpAnn :: AddEpAnn -> SDoc
addEpAnn (AddEpAnn a s) = case ba of
BlankEpAnnotations -> parens
@@ -253,6 +291,12 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
epTokenCC :: EpToken "}" -> SDoc
epTokenCC = epToken'
+ epTokenInstance :: EpToken "instance" -> SDoc
+ epTokenInstance = epToken'
+
+ epTokenForall :: EpUniToken "forall" "∀" -> SDoc
+ epTokenForall = epUniToken'
+
epToken' :: KnownSymbol sym => EpToken sym -> SDoc
epToken' (EpTok s) = case ba of
BlankEpAnnotations -> parens
@@ -265,6 +309,18 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
NoBlankEpAnnotations ->
parens $ text "NoEpTok"
+ epUniToken' :: EpUniToken sym1 sym2 -> SDoc
+ epUniToken' (EpUniTok s f) = case ba of
+ BlankEpAnnotations -> parens
+ $ text "blanked:" <+> text "EpUniToken"
+ NoBlankEpAnnotations ->
+ parens $ text "EpUniTok" <+> epaLocation s <+> ppr f
+ epUniToken' NoEpUniTok = case ba of
+ BlankEpAnnotations -> parens
+ $ text "blanked:" <+> text "EpUniToken"
+ NoBlankEpAnnotations ->
+ parens $ text "NoEpUniTok"
+
var :: Var -> SDoc
var v = braces $ text "Var:" <+> ppr v
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -31,7 +31,7 @@ module GHC.Hs.Type (
pprHsArrow,
HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
- HsForAllTelescope(..), EpAnnForallTy,
+ HsForAllTelescope(..), EpAnnForallVis, EpAnnForallInvis,
HsTyVarBndr(..), LHsTyVarBndr, AnnTyVarBndr(..),
HsBndrKind(..),
HsBndrVar(..),
@@ -163,16 +163,15 @@ getBangStrictness _ = (mkHsSrcBang NoSourceText NoSrcUnpack NoSrcStrict)
fromMaybeContext :: Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext mctxt = unLoc $ fromMaybe (noLocA []) mctxt
-type instance XHsForAllVis (GhcPass _) = EpAnnForallTy
+type instance XHsForAllVis (GhcPass _) = EpAnn (EpUniToken "forall" "∀", EpUniToken "->" "→")
-- Location of 'forall' and '->'
-type instance XHsForAllInvis (GhcPass _) = EpAnnForallTy
+type instance XHsForAllInvis (GhcPass _) = EpAnn (EpUniToken "forall" "∀", EpToken ".")
-- Location of 'forall' and '.'
type instance XXHsForAllTelescope (GhcPass _) = DataConCantHappen
-type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn)
- -- ^ Location of 'forall' and '->' for HsForAllVis
- -- Location of 'forall' and '.' for HsForAllInvis
+type EpAnnForallVis = EpAnn (EpUniToken "forall" "∀", EpUniToken "->" "→")
+type EpAnnForallInvis = EpAnn (EpUniToken "forall" "∀", EpToken ".")
type HsQTvsRn = [Name] -- Implicit variables
-- For example, in data T (a :: k1 -> k2) = ...
@@ -184,12 +183,12 @@ type instance XHsQTvs GhcTc = HsQTvsRn
type instance XXLHsQTyVars (GhcPass _) = DataConCantHappen
-mkHsForAllVisTele ::EpAnnForallTy ->
+mkHsForAllVisTele ::EpAnnForallVis ->
[LHsTyVarBndr () (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllVisTele an vis_bndrs =
HsForAllVis { hsf_xvis = an, hsf_vis_bndrs = vis_bndrs }
-mkHsForAllInvisTele :: EpAnnForallTy
+mkHsForAllInvisTele :: EpAnnForallInvis
-> [LHsTyVarBndr Specificity (GhcPass p)] -> HsForAllTelescope (GhcPass p)
mkHsForAllInvisTele an invis_bndrs =
HsForAllInvis { hsf_xinvis = an, hsf_invis_bndrs = invis_bndrs }
@@ -207,7 +206,7 @@ type instance XHsOuterImplicit GhcPs = NoExtField
type instance XHsOuterImplicit GhcRn = [Name]
type instance XHsOuterImplicit GhcTc = [TyVar]
-type instance XHsOuterExplicit GhcPs _ = EpAnnForallTy
+type instance XHsOuterExplicit GhcPs _ = EpAnnForallInvis
type instance XHsOuterExplicit GhcRn _ = NoExtField
type instance XHsOuterExplicit GhcTc flag = [VarBndr TyVar flag]
@@ -323,7 +322,7 @@ hsOuterExplicitBndrs (HsOuterImplicit{}) = []
mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs
mkHsOuterImplicit = HsOuterImplicit{hso_ximplicit = noExtField}
-mkHsOuterExplicit :: EpAnnForallTy -> [LHsTyVarBndr flag GhcPs]
+mkHsOuterExplicit :: EpAnnForallInvis -> [LHsTyVarBndr flag GhcPs]
-> HsOuterTyVarBndrs flag GhcPs
mkHsOuterExplicit an bndrs = HsOuterExplicit { hso_xexplicit = an
, hso_bndrs = bndrs }
@@ -333,7 +332,7 @@ mkHsImplicitSigType body =
HsSig { sig_ext = noExtField
, sig_bndrs = mkHsOuterImplicit, sig_body = body }
-mkHsExplicitSigType :: EpAnnForallTy
+mkHsExplicitSigType :: EpAnnForallInvis
-> [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs
-> HsSigType GhcPs
mkHsExplicitSigType an bndrs body =
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1275,9 +1275,9 @@ topdecl :: { LHsDecl GhcPs }
| role_annot { L (getLoc $1) (RoleAnnotD noExtField (unLoc $1)) }
| default_decl { L (getLoc $1) (DefD noExtField (unLoc $1)) }
| 'foreign' fdecl {% amsA' (sLL $1 $> ((snd $ unLoc $2) (mj AnnForeign $1:(fst $ unLoc $2)))) }
- | '{-# DEPRECATED' deprecations '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getDEPRECATED_PRAGs $1)) (fromOL $2))) }
- | '{-# WARNING' warnings '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getWARNING_PRAGs $1)) (fromOL $2))) }
- | '{-# RULES' rules '#-}' {% amsA' (sLL $1 $> $ RuleD noExtField (HsRules ([mo $1,mc $3], (getRULES_PRAGs $1)) (reverse $2))) }
+ | '{-# DEPRECATED' deprecations '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ((glR $1,glR $3), (getDEPRECATED_PRAGs $1)) (fromOL $2))) }
+ | '{-# WARNING' warnings '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ((glR $1,glR $3), (getWARNING_PRAGs $1)) (fromOL $2))) }
+ | '{-# RULES' rules '#-}' {% amsA' (sLL $1 $> $ RuleD noExtField (HsRules ((glR $1,glR $3), (getRULES_PRAGs $1)) (reverse $2))) }
| annotation { $1 }
| decl_no_th { $1 }
@@ -1300,7 +1300,7 @@ cl_decl :: { LTyClDecl GhcPs }
--
default_decl :: { LDefaultDecl GhcPs }
: 'default' opt_class '(' comma_types0 ')'
- {% amsA' (sLL $1 $> (DefaultDecl [mj AnnDefault $1,mop $3,mcp $5] $2 $4)) }
+ {% amsA' (sLL $1 $> (DefaultDecl (epTok $1,epTok $3,epTok $5) $2 $4)) }
-- Type declarations (toplevel)
@@ -1322,17 +1322,22 @@ ty_decl :: { LTyClDecl GhcPs }
where_type_family
-- Note the use of type for the head; this allows
-- infix type constructors to be declared
- {% mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3
+ {% do { let { (tdcolon, tequal) = fst $ unLoc $4 }
+ ; let { tvbar = fst $ unLoc $5 }
+ ; let { (twhere, (toc, tdd, tcc)) = fst $ unLoc $6 }
+ ; mkFamDecl (comb5 $1 $3 $4 $5 $6) (snd $ unLoc $6) TopLevel $3
(snd $ unLoc $4) (snd $ unLoc $5)
- (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)
- ++ (fst $ unLoc $5) ++ (fst $ unLoc $6)) }
+ (AnnFamilyDecl [] [] (epTok $1) noAnn (epTok $2) tdcolon tequal tvbar twhere toc tdd tcc) }}
-- ordinary data type or newtype declaration
| type_data_or_newtype capi_ctype tycl_hdr constrs maybe_derivings
- {% mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
+ {% do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc $1}
+ ; let { tequal = fst $ unLoc $4 }
+ ; mkTyData (comb4 $1 $3 $4 $5) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
Nothing (reverse (snd $ unLoc $4))
(fmap reverse $5)
- ((fstOf3 $ unLoc $1)++(fst $ unLoc $4)) }
+ (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)
+ }}
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
@@ -1340,18 +1345,22 @@ ty_decl :: { LTyClDecl GhcPs }
| type_data_or_newtype capi_ctype tycl_hdr opt_kind_sig
gadt_constrlist
maybe_derivings
- {% mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
+ {% do { let { (tdata, tnewtype, ttype) = fstOf3 $ unLoc $1}
+ ; let { tdcolon = fst $ unLoc $4 }
+ ; let { (twhere, oc, cc) = fst $ unLoc $5 }
+ ; mkTyData (comb5 $1 $3 $4 $5 $6) (sndOf3 $ unLoc $1) (thdOf3 $ unLoc $1) $2 $3
(snd $ unLoc $4) (snd $ unLoc $5)
(fmap reverse $6)
- ((fstOf3 $ unLoc $1)++(fst $ unLoc $4)++(fst $ unLoc $5)) }
+ (AnnDataDefn [] [] ttype tnewtype tdata NoEpTok tdcolon twhere oc cc NoEpTok)}}
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
-- data/newtype family
| 'data' 'family' type opt_datafam_kind_sig
- {% mkFamDecl (comb4 $1 $2 $3 $4) DataFamily TopLevel $3
+ {% do { let { tdcolon = fst $ unLoc $4 }
+ ; mkFamDecl (comb4 $1 $2 $3 $4) DataFamily TopLevel $3
(snd $ unLoc $4) Nothing
- (mj AnnData $1:mj AnnFamily $2:(fst $ unLoc $4)) }
+ (AnnFamilyDecl [] [] noAnn (epTok $1) (epTok $2) tdcolon noAnn noAnn noAnn noAnn noAnn noAnn) }}
-- standalone kind signature
standalone_kind_sig :: { LStandaloneKindSig GhcPs }
@@ -1386,25 +1395,29 @@ inst_decl :: { LInstDecl GhcPs }
-- type instance declarations
| 'type' 'instance' ty_fam_inst_eqn
{% mkTyFamInst (comb2 $1 $3) (unLoc $3)
- (mj AnnType $1:mj AnnInstance $2:[]) }
+ (epTok $1) (epTok $2) }
-- data/newtype instance declaration
| data_or_newtype 'instance' capi_ctype datafam_inst_hdr constrs
maybe_derivings
- {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)
+ {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }
+ ; let { tequal = fst $ unLoc $5 }
+ ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)
Nothing (reverse (snd $ unLoc $5))
(fmap reverse $6)
- ((fst $ unLoc $1):mj AnnInstance $2:(fst $ unLoc $5)) }
+ (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)}}
-- GADT instance declaration
| data_or_newtype 'instance' capi_ctype datafam_inst_hdr opt_kind_sig
gadt_constrlist
maybe_derivings
- {% mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4)
+ {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }
+ ; let { dcolon = fst $ unLoc $5 }
+ ; let { (twhere, oc, cc) = fst $ unLoc $6 }
+ ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3 (unLoc $4)
(snd $ unLoc $5) (snd $ unLoc $6)
(fmap reverse $7)
- ((fst $ unLoc $1):mj AnnInstance $2
- :(fst $ unLoc $5)++(fst $ unLoc $6)) }
+ (AnnDataDefn [] [] NoEpTok tnewtype tdata (epTok $2) dcolon twhere oc cc NoEpTok)}}
overlap_pragma :: { Maybe (LocatedP OverlapMode) }
: '{-# OVERLAPPABLE' '#-}' {% fmap Just $ amsr (sLL $1 $> (Overlappable (getOVERLAPPABLE_PRAGs $1)))
@@ -1439,14 +1452,14 @@ opt_class :: { Maybe (LIdP GhcPs) }
-- Injective type families
-opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) }
- : {- empty -} { noLoc ([], Nothing) }
- | '|' injectivity_cond { sLL $1 $> ([mj AnnVbar $1]
+opt_injective_info :: { Located (EpToken "|", Maybe (LInjectivityAnn GhcPs)) }
+ : {- empty -} { noLoc (noAnn, Nothing) }
+ | '|' injectivity_cond { sLL $1 $> ((epTok $1)
, Just ($2)) }
injectivity_cond :: { LInjectivityAnn GhcPs }
: tyvarid '->' inj_varids
- {% amsA' (sLL $1 $> (InjectivityAnn [mu AnnRarrow $2] $1 (reverse (unLoc $3)))) }
+ {% amsA' (sLL $1 $> (InjectivityAnn (epUniTok $2) $1 (reverse (unLoc $3)))) }
inj_varids :: { Located [LocatedN RdrName] }
: inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) }
@@ -1454,21 +1467,20 @@ inj_varids :: { Located [LocatedN RdrName] }
-- Closed type families
-where_type_family :: { Located ([AddEpAnn],FamilyInfo GhcPs) }
- : {- empty -} { noLoc ([],OpenTypeFamily) }
+where_type_family :: { Located ((EpToken "where", (EpToken "{", EpToken "..", EpToken "}")),FamilyInfo GhcPs) }
+ : {- empty -} { noLoc (noAnn,OpenTypeFamily) }
| 'where' ty_fam_inst_eqn_list
- { sLL $1 $> (mj AnnWhere $1:(fst $ unLoc $2)
+ { sLL $1 $> ((epTok $1,(fst $ unLoc $2))
,ClosedTypeFamily (fmap reverse $ snd $ unLoc $2)) }
-ty_fam_inst_eqn_list :: { Located ([AddEpAnn],Maybe [LTyFamInstEqn GhcPs]) }
- : '{' ty_fam_inst_eqns '}' { sLL $1 $> ([moc $1,mcc $3]
+ty_fam_inst_eqn_list :: { Located ((EpToken "{", EpToken "..", EpToken "}"),Maybe [LTyFamInstEqn GhcPs]) }
+ : '{' ty_fam_inst_eqns '}' { sLL $1 $> ((epTok $1,noAnn, epTok $3)
,Just (unLoc $2)) }
| vocurly ty_fam_inst_eqns close { let (L loc _) = $2 in
- L loc ([],Just (unLoc $2)) }
- | '{' '..' '}' { sLL $1 $> ([moc $1,mj AnnDotdot $2
- ,mcc $3],Nothing) }
+ L loc (noAnn,Just (unLoc $2)) }
+ | '{' '..' '}' { sLL $1 $> ((epTok $1,epTok $2 ,epTok $3),Nothing) }
| vocurly '..' close { let (L loc _) = $2 in
- L loc ([mj AnnDotdot $2],Nothing) }
+ L loc ((noAnn,epTok $2, noAnn),Nothing) }
ty_fam_inst_eqns :: { Located [LTyFamInstEqn GhcPs] }
: ty_fam_inst_eqns ';' ty_fam_inst_eqn
@@ -1492,9 +1504,9 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }
; tvbs <- fromSpecTyVarBndrs $2
; let loc = comb2 $1 $>
; !cs <- getCommentsFor loc
- ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) cs) tvbs) $4 $6 [mj AnnEqual $5] }}
+ ; mkTyFamInstEqn loc (mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) cs) tvbs) $4 $6 (epTok $5) }}
| type '=' ktype
- {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (mj AnnEqual $2:[]) }
+ {% mkTyFamInstEqn (comb2 $1 $>) mkHsOuterImplicit $1 $3 (epTok $2) }
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
@@ -1510,40 +1522,42 @@ ty_fam_inst_eqn :: { LTyFamInstEqn GhcPs }
at_decl_cls :: { LHsDecl GhcPs }
: -- data family declarations, with optional 'family' keyword
'data' opt_family type opt_datafam_kind_sig
- {% liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3
+ {% do { let { tdcolon = fst $ unLoc $4 }
+ ; liftM mkTyClD (mkFamDecl (comb3 $1 $3 $4) DataFamily NotTopLevel $3
(snd $ unLoc $4) Nothing
- (mj AnnData $1:$2++(fst $ unLoc $4))) }
+ (AnnFamilyDecl [] [] noAnn (epTok $1) $2 tdcolon noAnn noAnn noAnn noAnn noAnn noAnn)) }}
-- type family declarations, with optional 'family' keyword
-- (can't use opt_instance because you get shift/reduce errors
| 'type' type opt_at_kind_inj_sig
- {% liftM mkTyClD
+ {% do { let { (tdcolon, tequal, tvbar) = fst $ unLoc $3 }
+ ; liftM mkTyClD
(mkFamDecl (comb3 $1 $2 $3) OpenTypeFamily NotTopLevel $2
(fst . snd $ unLoc $3)
(snd . snd $ unLoc $3)
- (mj AnnType $1:(fst $ unLoc $3)) )}
+ (AnnFamilyDecl [] [] (epTok $1) noAnn noAnn tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) }}
| 'type' 'family' type opt_at_kind_inj_sig
- {% liftM mkTyClD
+ {% do { let { (tdcolon, tequal, tvbar) = fst $ unLoc $4 }
+ ; liftM mkTyClD
(mkFamDecl (comb3 $1 $3 $4) OpenTypeFamily NotTopLevel $3
(fst . snd $ unLoc $4)
(snd . snd $ unLoc $4)
- (mj AnnType $1:mj AnnFamily $2:(fst $ unLoc $4)))}
-
+ (AnnFamilyDecl [] [] (epTok $1) noAnn (epTok $2) tdcolon tequal tvbar noAnn noAnn noAnn noAnn)) }}
-- default type instances, with optional 'instance' keyword
| 'type' ty_fam_inst_eqn
{% liftM mkInstD (mkTyFamInst (comb2 $1 $2) (unLoc $2)
- [mj AnnType $1]) }
+ (epTok $1) NoEpTok) }
| 'type' 'instance' ty_fam_inst_eqn
{% liftM mkInstD (mkTyFamInst (comb2 $1 $3) (unLoc $3)
- (mj AnnType $1:mj AnnInstance $2:[]) )}
+ (epTok $1) (epTok $2) )}
-opt_family :: { [AddEpAnn] }
- : {- empty -} { [] }
- | 'family' { [mj AnnFamily $1] }
+opt_family :: { EpToken "family" }
+ : {- empty -} { noAnn }
+ | 'family' { (epTok $1) }
-opt_instance :: { [AddEpAnn] }
- : {- empty -} { [] }
- | 'instance' { [mj AnnInstance $1] }
+opt_instance :: { EpToken "instance" }
+ : {- empty -} { NoEpTok }
+ | 'instance' { epTok $1 }
-- Associated type instances
--
@@ -1553,57 +1567,63 @@ at_decl_inst :: { LInstDecl GhcPs }
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
{% mkTyFamInst (comb2 $1 $3) (unLoc $3)
- (mj AnnType $1:$2) }
+ (epTok $1) $2 }
-- data/newtype instance declaration, with optional 'instance' keyword
| data_or_newtype opt_instance capi_ctype datafam_inst_hdr constrs maybe_derivings
- {% mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)
+ {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }
+ ; let { tequal = fst $ unLoc $5 }
+ ; mkDataFamInst (comb4 $1 $4 $5 $6) (snd $ unLoc $1) $3 (unLoc $4)
Nothing (reverse (snd $ unLoc $5))
- (fmap reverse $6)
- ((fst $ unLoc $1):$2++(fst $ unLoc $5)) }
+ (fmap reverse $6)
+ (AnnDataDefn [] [] NoEpTok tnewtype tdata $2 NoEpUniTok NoEpTok NoEpTok NoEpTok tequal)}}
-- GADT instance declaration, with optional 'instance' keyword
| data_or_newtype opt_instance capi_ctype datafam_inst_hdr opt_kind_sig
gadt_constrlist
maybe_derivings
- {% mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3
+ {% do { let { (tdata, tnewtype) = fst $ unLoc $1 }
+ ; let { dcolon = fst $ unLoc $5 }
+ ; let { (twhere, oc, cc) = fst $ unLoc $6 }
+ ; mkDataFamInst (comb4 $1 $4 $6 $7) (snd $ unLoc $1) $3
(unLoc $4) (snd $ unLoc $5) (snd $ unLoc $6)
(fmap reverse $7)
- ((fst $ unLoc $1):$2++(fst $ unLoc $5)++(fst $ unLoc $6)) }
+ (AnnDataDefn [] [] NoEpTok tnewtype tdata $2 dcolon twhere oc cc NoEpTok)}}
-type_data_or_newtype :: { Located ([AddEpAnn], Bool, NewOrData) }
- : 'data' { sL1 $1 ([mj AnnData $1], False,DataType) }
- | 'newtype' { sL1 $1 ([mj AnnNewtype $1], False,NewType) }
- | 'type' 'data' { sL1 $1 ([mj AnnType $1, mj AnnData $2],True ,DataType) }
+type_data_or_newtype :: { Located ((EpToken "data", EpToken "newtype", EpToken "type")
+ , Bool, NewOrData) }
+ : 'data' { sL1 $1 ((epTok $1, NoEpTok, NoEpTok), False,DataType) }
+ | 'newtype' { sL1 $1 ((NoEpTok, epTok $1, NoEpTok), False,NewType) }
+ | 'type' 'data' { sL1 $1 ((epTok $2, NoEpTok, epTok $1), True ,DataType) }
-data_or_newtype :: { Located (AddEpAnn, NewOrData) }
- : 'data' { sL1 $1 (mj AnnData $1,DataType) }
- | 'newtype' { sL1 $1 (mj AnnNewtype $1,NewType) }
+data_or_newtype :: { Located ((EpToken "data", EpToken "newtype"), NewOrData) }
+ : 'data' { sL1 $1 ((epTok $1, NoEpTok), DataType) }
+ | 'newtype' { sL1 $1 ((NoEpTok, epTok $1),NewType) }
-- Family result/return kind signatures
-opt_kind_sig :: { Located ([AddEpAnn], Maybe (LHsKind GhcPs)) }
- : { noLoc ([] , Nothing) }
- | '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
+opt_kind_sig :: { Located (TokDcolon, Maybe (LHsKind GhcPs)) }
+ : { noLoc (NoEpUniTok , Nothing) }
+ | '::' kind { sLL $1 $> (epUniTok $1, Just $2) }
-opt_datafam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) }
- : { noLoc ([] , noLocA (NoSig noExtField) )}
- | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))}
+opt_datafam_kind_sig :: { Located (TokDcolon, LFamilyResultSig GhcPs) }
+ : { noLoc (noAnn, noLocA (NoSig noExtField) )}
+ | '::' kind { sLL $1 $> (epUniTok $1, sLLa $1 $> (KindSig noExtField $2))}
-opt_tyfam_kind_sig :: { Located ([AddEpAnn], LFamilyResultSig GhcPs) }
- : { noLoc ([] , noLocA (NoSig noExtField) )}
- | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLLa $1 $> (KindSig noExtField $2))}
+opt_tyfam_kind_sig :: { Located ((TokDcolon, EpToken "="), LFamilyResultSig GhcPs) }
+ : { noLoc (noAnn , noLocA (NoSig noExtField) )}
+ | '::' kind { sLL $1 $> ((epUniTok $1, noAnn), sLLa $1 $> (KindSig noExtField $2))}
| '=' tv_bndr {% do { tvb <- fromSpecTyVarBndr $2
- ; return $ sLL $1 $> ([mj AnnEqual $1], sLLa $1 $> (TyVarSig noExtField tvb))} }
+ ; return $ sLL $1 $> ((noAnn, epTok $1), sLLa $1 $> (TyVarSig noExtField tvb))} }
-opt_at_kind_inj_sig :: { Located ([AddEpAnn], ( LFamilyResultSig GhcPs
+opt_at_kind_inj_sig :: { Located ((TokDcolon, EpToken "=", EpToken "|"), ( LFamilyResultSig GhcPs
, Maybe (LInjectivityAnn GhcPs)))}
- : { noLoc ([], (noLocA (NoSig noExtField), Nothing)) }
- | '::' kind { sLL $1 $> ( [mu AnnDcolon $1]
+ : { noLoc (noAnn, (noLocA (NoSig noExtField), Nothing)) }
+ | '::' kind { sLL $1 $> ( (epUniTok $1, noAnn, noAnn)
, (sL1a $> (KindSig noExtField $2), Nothing)) }
| '=' tv_bndr_no_braces '|' injectivity_cond
{% do { tvb <- fromSpecTyVarBndr $2
- ; return $ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]
+ ; return $ sLL $1 $> ((noAnn, epTok $1, epTok $3)
, (sLLa $1 $2 (TyVarSig noExtField tvb), Just $4))} }
-- tycl_hdr parses the header of a class or data type decl,
@@ -1623,13 +1643,13 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs
>>= \tvbs ->
(acs (comb2 $1 $>) (\loc cs -> (L loc
(Just ( addTrailingDarrowC $4 $5 cs)
- , mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6))))
+ , mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) emptyComments) tvbs, $6))))
}
| 'forall' tv_bndrs '.' type {% do { hintExplicitForall $1
; tvbs <- fromSpecTyVarBndrs $2
; let loc = comb2 $1 $>
; !cs <- getCommentsFor loc
- ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE $1 $3) (mu AnnForall $1, mj AnnDot $3) cs) tvbs, $4))
+ ; return (sL loc (Nothing, mkHsOuterExplicit (EpAnn (glEE $1 $3) (epUniTok $1, epTok $3) cs) tvbs, $4))
} }
| context '=>' type {% acs (comb2 $1 $>) (\loc cs -> (L loc (Just (addTrailingDarrowC $1 $2 cs), mkHsOuterImplicit, $3))) }
| type { sL1 $1 (Nothing, mkHsOuterImplicit, $1) }
@@ -2184,11 +2204,11 @@ unpackedness :: { Located UnpackednessPragma }
forall_telescope :: { Located (HsForAllTelescope GhcPs) }
: 'forall' tv_bndrs '.' {% do { hintExplicitForall $1
; acs (comb2 $1 $>) (\loc cs -> (L loc $
- mkHsForAllInvisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnDot $3) cs) $2 )) }}
+ mkHsForAllInvisTele (EpAnn (glEE $1 $>) (epUniTok $1,epTok $3) cs) $2 )) }}
| 'forall' tv_bndrs '->' {% do { hintExplicitForall $1
; req_tvbs <- fromSpecTyVarBndrs $2
; acs (comb2 $1 $>) (\loc cs -> (L loc $
- mkHsForAllVisTele (EpAnn (glEE $1 $>) (mu AnnForall $1,mu AnnRarrow $3) cs) req_tvbs )) }}
+ mkHsForAllVisTele (EpAnn (glEE $1 $>) (epUniTok $1,epUniTok $3) cs) req_tvbs )) }}
-- A ktype is a ctype, possibly with a kind annotation
ktype :: { LHsType GhcPs }
@@ -2434,7 +2454,7 @@ fds1 :: { Located [LHsFunDep GhcPs] }
fd :: { LHsFunDep GhcPs }
: varids0 '->' varids0 {% amsA' (L (comb3 $1 $2 $3)
- (FunDep [mu AnnRarrow $2]
+ (FunDep (epUniTok $2)
(reverse (unLoc $1))
(reverse (unLoc $3)))) }
@@ -2478,20 +2498,20 @@ constructors.
-----------------------------------------------------------------------------
-- Datatype declarations
-gadt_constrlist :: { Located ([AddEpAnn]
+gadt_constrlist :: { Located ((EpToken "where", EpToken "{", EpToken "}")
,[LConDecl GhcPs]) } -- Returned in order
: 'where' '{' gadt_constrs '}' {% checkEmptyGADTs $
L (comb2 $1 $4)
- ([mj AnnWhere $1
- ,moc $2
- ,mcc $4]
+ ((epTok $1
+ ,epTok $2
+ ,epTok $4)
, unLoc $3) }
| 'where' vocurly gadt_constrs close {% checkEmptyGADTs $
L (comb2 $1 $3)
- ([mj AnnWhere $1]
+ ((epTok $1, NoEpTok, NoEpTok)
, unLoc $3) }
- | {- empty -} { noLoc ([],[]) }
+ | {- empty -} { noLoc (noAnn,[]) }
gadt_constrs :: { Located [LConDecl GhcPs] }
: gadt_constr ';' gadt_constrs
@@ -2525,8 +2545,8 @@ consequence, GADT constructor names are restricted (names like '(*)' are
allowed in usual data constructors, but not in GADTs).
-}
-constrs :: { Located ([AddEpAnn],[LConDecl GhcPs]) }
- : '=' constrs1 { sLL $1 $2 ([mj AnnEqual $1],unLoc $2)}
+constrs :: { Located (EpToken "=",[LConDecl GhcPs]) }
+ : '=' constrs1 { sLL $1 $2 (epTok $1,unLoc $2)}
constrs1 :: { Located [LConDecl GhcPs] }
: constrs1 '|' constr
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.Parser.Annotation (
AnnKeywordId(..),
EpToken(..), EpUniToken(..),
getEpTokenSrcSpan, getEpTokenLocs, getEpTokenLoc,
- TokDcolon,
+ TokDcolon, TokRarrow,
EpLayout(..),
EpaComment(..), EpaCommentTok(..),
IsUnicodeSyntax(..),
@@ -411,6 +411,7 @@ getEpTokenLoc NoEpTok = noAnn
getEpTokenLoc (EpTok l) = l
type TokDcolon = EpUniToken "::" "∷"
+type TokRarrow = EpUniToken "->" "→"
-- | Layout information for declarations.
data EpLayout =
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -231,41 +231,32 @@ mkTyData :: SrcSpan
-> Maybe (LHsKind GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
- -> [AddEpAnn]
+ -> AnnDataDefn
-> P (LTyClDecl GhcPs)
mkTyData loc' is_type_data new_or_data cType (L _ (mcxt, tycl_hdr))
ksig data_cons (L _ maybe_deriv) annsIn
= do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False tycl_hdr
; tyvars <- checkTyVars (ppr new_or_data) equalsDots tc tparams
- ; let anns' = annsIn Semi.<>
- concatMap openParen2AddEpAnn ops Semi.<> concatMap closeParen2AddEpAnn cps
+ ; let anns = annsIn {andd_openp = ops, andd_closep = cps}
; data_cons <- checkNewOrData loc' (unLoc tc) is_type_data new_or_data data_cons
- ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
+ ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv anns
; !cs' <- getCommentsFor loc'
; let loc = EpAnn (spanAsAnchor loc') noAnn (cs' Semi.<> cs)
- ; return (L loc (DataDecl { tcdDExt = anns',
+ ; return (L loc (DataDecl { tcdDExt = noExtField,
tcdLName = tc, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdDataDefn = defn })) }
--- TODO:AZ:temporary
-openParen2AddEpAnn :: EpToken "(" -> [AddEpAnn]
-openParen2AddEpAnn (EpTok l) = [AddEpAnn AnnOpenP l]
-openParen2AddEpAnn NoEpTok = []
-
-closeParen2AddEpAnn :: EpToken ")" -> [AddEpAnn]
-closeParen2AddEpAnn (EpTok l) = [AddEpAnn AnnCloseP l]
-closeParen2AddEpAnn NoEpTok = []
-
mkDataDefn :: Maybe (LocatedP CType)
-> Maybe (LHsContext GhcPs)
-> Maybe (LHsKind GhcPs)
-> DataDefnCons (LConDecl GhcPs)
-> HsDeriving GhcPs
+ -> AnnDataDefn
-> P (HsDataDefn GhcPs)
-mkDataDefn cType mcxt ksig data_cons maybe_deriv
+mkDataDefn cType mcxt ksig data_cons maybe_deriv anns
= do { checkDatatypeContext mcxt
- ; return (HsDataDefn { dd_ext = noExtField
+ ; return (HsDataDefn { dd_ext = anns
, dd_cType = cType
, dd_ctxt = mcxt
, dd_cons = data_cons
@@ -316,15 +307,13 @@ mkTyFamInstEqn :: SrcSpan
-> HsOuterFamEqnTyVarBndrs GhcPs
-> LHsType GhcPs
-> LHsType GhcPs
- -> [AddEpAnn]
+ -> EpToken "="
-> P (LTyFamInstEqn GhcPs)
-mkTyFamInstEqn loc bndrs lhs rhs anns
+mkTyFamInstEqn loc bndrs lhs rhs annEq
= do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False lhs
; let loc' = EpAnn (spanAsAnchor loc) noAnn cs
- ; let anns' = anns Semi.<>
- concatMap openParen2AddEpAnn ops Semi.<> concatMap closeParen2AddEpAnn cps
; return (L loc' $ FamEqn
- { feqn_ext = anns'
+ { feqn_ext = (ops, cps, annEq)
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
@@ -339,18 +328,17 @@ mkDataFamInst :: SrcSpan
-> Maybe (LHsKind GhcPs)
-> [LConDecl GhcPs]
-> Located (HsDeriving GhcPs)
- -> [AddEpAnn]
+ -> AnnDataDefn
-> P (LInstDecl GhcPs)
mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
ksig data_cons (L _ maybe_deriv) anns
= do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False tycl_hdr
; data_cons <- checkNewOrData loc (unLoc tc) False new_or_data data_cons
- ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv
+ ; let anns' = anns {andd_openp = ops, andd_closep = cps}
+ ; defn <- mkDataDefn cType mcxt ksig data_cons maybe_deriv anns'
; let loc' = EpAnn (spanAsAnchor loc) noAnn cs
- ; let anns' = anns Semi.<>
- concatMap openParen2AddEpAnn ops Semi.<> concatMap closeParen2AddEpAnn cps
; return (L loc' (DataFamInstD noExtField (DataFamInstDecl
- (FamEqn { feqn_ext = anns'
+ (FamEqn { feqn_ext = ([], [], NoEpTok)
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
@@ -361,11 +349,12 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
mkTyFamInst :: SrcSpan
-> TyFamInstEqn GhcPs
- -> [AddEpAnn]
+ -> EpToken "type"
+ -> EpToken "instance"
-> P (LInstDecl GhcPs)
-mkTyFamInst loc eqn anns = do
+mkTyFamInst loc eqn t i = do
return (L (noAnnSrcSpan loc) (TyFamInstD noExtField
- (TyFamInstDecl anns eqn)))
+ (TyFamInstDecl (t,i) eqn)))
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
@@ -373,14 +362,13 @@ mkFamDecl :: SrcSpan
-> LHsType GhcPs -- LHS
-> LFamilyResultSig GhcPs -- Optional result signature
-> Maybe (LInjectivityAnn GhcPs) -- Injectivity annotation
- -> [AddEpAnn]
+ -> AnnFamilyDecl
-> P (LTyClDecl GhcPs)
mkFamDecl loc info topLevel lhs ksig injAnn annsIn
= do { (tc, tparams, fixity, ops, cps, cs) <- checkTyClHdr False lhs
; tyvars <- checkTyVars (ppr info) equals_or_where tc tparams
; let loc' = EpAnn (spanAsAnchor loc) noAnn cs
- ; let anns' = annsIn Semi.<>
- concatMap openParen2AddEpAnn ops Semi.<> concatMap closeParen2AddEpAnn cps
+ ; let anns' = annsIn { afd_openp = ops, afd_closep = cps }
; return (L loc' (FamDecl noExtField (FamilyDecl
{ fdExt = anns'
, fdTopLevel = topLevel
@@ -1050,8 +1038,8 @@ checkRecordSyntax lr@(L loc r)
-- | Check if the gadt_constrlist is empty. Only raise parse error for
-- `data T where` to avoid affecting existing error message, see #8258.
-checkEmptyGADTs :: Located ([AddEpAnn], [LConDecl GhcPs])
- -> P (Located ([AddEpAnn], [LConDecl GhcPs]))
+checkEmptyGADTs :: Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs])
+ -> P (Located ((EpToken "where", EpToken "{", EpToken "}"), [LConDecl GhcPs]))
checkEmptyGADTs gadts@(L span (_, [])) -- Empty GADT declaration.
= do gadtSyntax <- getBit GadtSyntaxBit -- GADTs implies GADTSyntax
unless gadtSyntax $ addError $ mkPlainErrorMsgEnvelope span $
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1883,7 +1883,7 @@ rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = cond
; let all_fvs = fvs1 `plusFV` fvs3 `plusFV`
con_fvs `plusFV` sig_fvs
- ; return ( HsDataDefn { dd_ext = noExtField, dd_cType = cType
+ ; return ( HsDataDefn { dd_ext = noAnn, dd_cType = cType
, dd_ctxt = context', dd_kindSig = m_sig'
, dd_cons = condecls'
, dd_derivs = derivs' }
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -291,14 +291,14 @@ cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
+ ; let defn = HsDataDefn { dd_ext = noAnn
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
, dd_cons = con'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
- DataDecl { tcdDExt = noAnn
+ DataDecl { tcdDExt = noExtField
, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdDataDefn = defn } }
@@ -363,7 +363,7 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
; ksig' <- cvtKind `traverse` ksig
; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
+ ; let defn = HsDataDefn { dd_ext = noAnn
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
@@ -385,7 +385,7 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
+ ; let defn = HsDataDefn { dd_ext = noAnn
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
@@ -504,14 +504,14 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs
; cons' <- cvtDataDefnCons type_data ksig $
DataTypeCons type_data constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExtField
+ ; let defn = HsDataDefn { dd_ext = noAnn
, dd_cType = Nothing
, dd_ctxt = mkHsContextMaybe ctxt'
, dd_kindSig = ksig'
, dd_cons = cons'
, dd_derivs = derivs' }
; returnJustLA $ TyClD noExtField $
- DataDecl { tcdDExt = noAnn
+ DataDecl { tcdDExt = noExtField
, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdDataDefn = defn } }
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -76,9 +76,10 @@
(NoExtField)
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { Test20239.hs:5:1-4 }))
- ,(AddEpAnn AnnInstance (EpaSpan { Test20239.hs:5:6-13 }))
- ,(AddEpAnn AnnEqual (EpaSpan { Test20239.hs:5:34 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { Test20239.hs:5:15-20 })
@@ -113,7 +114,20 @@
{OccName: PGMigration})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test20239.hs:5:1-4 }))
+ (EpTok (EpaSpan { Test20239.hs:5:6-13 }))
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test20239.hs:5:34 })))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -891,7 +891,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:22:20-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:22:20-23 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -1032,8 +1045,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:24:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:24:15-19 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:24:8-9 })
@@ -1068,7 +1083,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:24:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:24:15-19 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -1239,7 +1267,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:28:20-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:28:20-23 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -1380,8 +1421,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:30:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:30:15-19 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:30:8-9 })
@@ -1416,7 +1459,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:30:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:30:15-19 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -1587,7 +1643,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:34:20-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:34:20-23 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -1728,8 +1797,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:36:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:36:15-19 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:36:8-9 })
@@ -1764,7 +1835,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:36:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:36:15-19 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -1935,7 +2019,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:40:20-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:40:20-23 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -2076,8 +2173,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:42:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:42:15-19 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:42:8-9 })
@@ -2112,7 +2211,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:42:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:42:15-19 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -2283,7 +2395,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:46:20-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:46:20-23 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -2424,8 +2549,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:48:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:48:15-19 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:48:8-9 })
@@ -2460,7 +2587,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:48:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:48:15-19 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -2631,7 +2771,20 @@
(EpaComments
[]))
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:52:21-24 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:52:21-24 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(NotTopLevel)
(L
@@ -2772,8 +2925,10 @@
[]))
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:54:3-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:54:16-20 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { T17544.hs:54:8-10 })
@@ -2808,7 +2963,20 @@
{OccName: Int})))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:54:3-6 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544.hs:54:16-20 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -59,8 +59,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T17544_kw.hs:15:1-4 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:16:3-7 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544_kw.hs:15:6-8 })
@@ -75,7 +74,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544_kw.hs:15:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544_kw.hs:16:3-7 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -161,8 +173,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnNewtype (EpaSpan { T17544_kw.hs:18:1-7 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:19:3-7 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T17544_kw.hs:18:9-11 })
@@ -177,7 +188,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544_kw.hs:18:1-7 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T17544_kw.hs:19:3-7 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
=====================================
@@ -47,8 +47,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:3:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:5:3 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:3:6-9 })
@@ -63,7 +62,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:3:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:5:3 })))
(Nothing)
(Nothing)
(Nothing)
@@ -285,8 +297,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:11:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:11:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:11:6-9 })
@@ -301,7 +312,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:11:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:11:11 })))
(Nothing)
(Nothing)
(Nothing)
@@ -401,8 +425,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:14:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:14:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:14:6-9 })
@@ -417,7 +440,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:14:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:14:11 })))
(Nothing)
(Nothing)
(Nothing)
@@ -559,8 +595,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:19:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:19:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:19:6-9 })
@@ -575,7 +610,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:19:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:19:11 })))
(Nothing)
(Nothing)
(Nothing)
@@ -717,8 +765,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:27:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:27:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:27:6-9 })
@@ -733,7 +780,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:27:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:27:11 })))
(Nothing)
(Nothing)
(Nothing)
@@ -906,8 +966,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:31:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:31:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:31:6-9 })
@@ -922,7 +981,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:31:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:31:11 })))
(Nothing)
(Nothing)
(Nothing)
@@ -1107,8 +1179,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T24221.hs:36:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T24221.hs:36:11 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T24221.hs:36:6-9 })
@@ -1123,7 +1194,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:36:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:36:11 })))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -82,8 +82,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:7:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:7:12 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:6-10 })
@@ -98,7 +97,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:7:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:7:12 })))
(Nothing)
(Nothing)
(Nothing)
@@ -286,10 +298,24 @@
(FamDecl
(NoExtField)
(FamilyDecl
- [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:10:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:10:6-11 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:10:32-33 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:10:41-45 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:10:1-4 }))
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:10:6-11 }))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:10:32-33 })
+ (NormalSyntax))
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:10:41-45 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(ClosedTypeFamily
(Just
[(L
@@ -300,7 +326,11 @@
(EpaComments
[]))
(FamEqn
- [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:11:19 }))]
+ ((,,)
+ []
+ []
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:11:19 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:3-8 })
@@ -479,7 +509,11 @@
(EpaComments
[]))
(FamEqn
- [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:12:19 }))]
+ ((,,)
+ []
+ []
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:12:19 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:12:3-8 })
@@ -642,8 +676,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:15:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:15:19 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:6 })
@@ -734,7 +767,20 @@
{OccName: k})))))))])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:15:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:15:19 })))
(Nothing)
(Nothing)
(Nothing)
@@ -1000,10 +1046,24 @@
(FamDecl
(NoExtField)
(FamilyDecl
- [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:18:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:18:6-11 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:18:42-43 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:18:50-54 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:18:1-4 }))
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:18:6-11 }))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:18:42-43 })
+ (NormalSyntax))
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:18:50-54 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(ClosedTypeFamily
(Just
[(L
@@ -1014,7 +1074,11 @@
(EpaComments
[]))
(FamEqn
- [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:19:17 }))]
+ ((,,)
+ []
+ []
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:19:17 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:19:3-4 })
@@ -1378,9 +1442,23 @@
(FamDecl
(NoExtField)
(FamilyDecl
- [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:21:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:21:6-11 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:17-18 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:21:1-4 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:21:6-11 }))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:21:17-18 })
+ (NormalSyntax))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(TopLevel)
(L
@@ -1501,10 +1579,10 @@
(NoExtField)
(DataFamInstDecl
(FamEqn
- [(AddEpAnn AnnNewtype (EpaSpan { DumpParsedAst.hs:22:1-7 }))
- ,(AddEpAnn AnnInstance (EpaSpan { DumpParsedAst.hs:22:9-16 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:22:39-40 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:22:62-66 }))]
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:18-20 })
@@ -1613,7 +1691,22 @@
{OccName: Type})))))))))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:1-7 }))
+ (NoEpTok)
+ (EpTok (EpaSpan { DumpParsedAst.hs:22:9-16 }))
+ (EpUniTok
+ (EpaSpan { DumpParsedAst.hs:22:39-40 })
+ (NormalSyntax))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:62-66 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Just
@@ -1779,8 +1872,9 @@
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:11-20 })
((,)
- (AddEpAnn AnnForall (EpaSpan { DumpParsedAst.hs:23:11-16 }))
- (AddEpAnn AnnDot (EpaSpan { DumpParsedAst.hs:23:20 })))
+ (EpUniTok (EpaSpan { DumpParsedAst.hs:23:11-16 }) NormalSyntax)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:23:20 })))
(EpaComments
[]))
[(L
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -154,7 +154,18 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -245,7 +256,19 @@
(FamDecl
(NoExtField)
(FamilyDecl
- []
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(ClosedTypeFamily
(Just
[(L
@@ -256,7 +279,10 @@
(EpaComments
[]))
(FamEqn
- []
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:3-8 })
@@ -429,7 +455,10 @@
(EpaComments
[]))
(FamEqn
- []
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:14:3-8 })
@@ -671,7 +700,19 @@
(FamDecl
(NoExtField)
(FamilyDecl
- []
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(DataFamily)
(TopLevel)
(L
@@ -784,7 +825,10 @@
(NoExtField)
(DataFamInstDecl
(FamEqn
- []
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:18-20 })
@@ -888,7 +932,18 @@
{Name: GHC.Types.Type}))))))))))]
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Just
@@ -1041,8 +1096,8 @@
(EpAnn
(EpaDelta { <no location info> } (SameLine 0) [])
((,)
- (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) []))
- (AddEpAnn Annlarrowtail (EpaDelta { <no location info> } (SameLine 0) [])))
+ (NoEpUniTok)
+ (NoEpTok))
(EpaComments
[]))
[(L
@@ -1347,7 +1402,18 @@
{Name: k}))))))])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -1452,7 +1518,19 @@
(FamDecl
(NoExtField)
(FamilyDecl
- []
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(ClosedTypeFamily
(Just
[(L
@@ -1463,7 +1541,10 @@
(EpaComments
[]))
(FamEqn
- []
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:26:3-4 })
@@ -2006,7 +2087,19 @@
(EpaComments
[]))
(FamilyDecl
- []
+ (AnnFamilyDecl
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(OpenTypeFamily)
(NotTopLevel)
(L
@@ -2176,9 +2269,15 @@
(EpaComments
[]))
(TyFamInstDecl
- [(AddEpAnn AnnType (EpaSpan { DumpRenamedAst.hs:32:3-6 }))]
+ ((,)
+ (EpTok
+ (EpaSpan { DumpRenamedAst.hs:32:3-6 }))
+ (NoEpTok))
(FamEqn
- []
+ ((,,)
+ []
+ []
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:32:8 })
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -84,9 +84,22 @@
(FamDecl
(NoExtField)
(FamilyDecl
- [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:11:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { KindSigs.hs:11:6-11 }))
- ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:11:19-23 }))]
+ (AnnFamilyDecl
+ []
+ []
+ (EpTok
+ (EpaSpan { KindSigs.hs:11:1-4 }))
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { KindSigs.hs:11:6-11 }))
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { KindSigs.hs:11:19-23 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(ClosedTypeFamily
(Just
[(L
@@ -97,7 +110,11 @@
(EpaComments
[]))
(FamEqn
- [(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:12:9 }))]
+ ((,,)
+ []
+ []
+ (EpTok
+ (EpaSpan { KindSigs.hs:12:9 })))
(L
(EpAnn
(EpaSpan { KindSigs.hs:12:3-5 })
=====================================
testsuite/tests/parser/should_compile/T14189.stderr
=====================================
@@ -37,7 +37,18 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -47,8 +47,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T15323.hs:5:1-4 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:5:21-25 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T15323.hs:5:6-17 })
@@ -90,7 +89,20 @@
(NoExtField))))])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T15323.hs:5:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T15323.hs:5:21-25 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
@@ -131,8 +143,9 @@
(EpAnn
(EpaSpan { T15323.hs:6:20-29 })
((,)
- (AddEpAnn AnnForall (EpaSpan { T15323.hs:6:20-25 }))
- (AddEpAnn AnnDot (EpaSpan { T15323.hs:6:29 })))
+ (EpUniTok (EpaSpan { T15323.hs:6:20-25 }) NormalSyntax)
+ (EpTok
+ (EpaSpan { T15323.hs:6:29 })))
(EpaComments
[]))
[(L
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -47,8 +47,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T20452.hs:5:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T20452.hs:5:24 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T20452.hs:5:6-11 })
@@ -111,7 +110,20 @@
{OccName: k})))))))])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20452.hs:5:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20452.hs:5:24 })))
(Nothing)
(Nothing)
(Nothing)
@@ -153,8 +165,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T20452.hs:6:1-4 }))
- ,(AddEpAnn AnnEqual (EpaSpan { T20452.hs:6:24 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T20452.hs:6:6-11 })
@@ -219,7 +230,20 @@
{OccName: k})))))))])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20452.hs:6:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20452.hs:6:24 })))
(Nothing)
(Nothing)
(Nothing)
=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -47,8 +47,7 @@
(TyClD
(NoExtField)
(DataDecl
- [(AddEpAnn AnnData (EpaSpan { T18791.hs:4:1-4 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:4:8-12 }))]
+ (NoExtField)
(L
(EpAnn
(EpaSpan { T18791.hs:4:6 })
@@ -63,7 +62,20 @@
[])
(Prefix)
(HsDataDefn
- (NoExtField)
+ (AnnDataDefn
+ []
+ []
+ (NoEpTok)
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T18791.hs:4:1-4 }))
+ (NoEpTok)
+ (NoEpUniTok)
+ (EpTok
+ (EpaSpan { T18791.hs:4:8-12 }))
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok))
(Nothing)
(Nothing)
(Nothing)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -363,6 +363,14 @@ instance HasTrailing Bool where
trailing _ = []
setTrailing a _ = a
+instance HasTrailing (EpUniToken "forall" "∀", EpUniToken "->" "→") where
+ trailing _ = []
+ setTrailing a _ = a
+
+instance HasTrailing (EpUniToken "forall" "∀", EpToken ".") where
+ trailing _ = []
+ setTrailing a _ = a
+
-- ---------------------------------------------------------------------
fromAnn' :: (HasEntry a) => a -> Entry
@@ -918,10 +926,6 @@ markAnnOpenP' :: (Monad m, Monoid w) => AnnPragma -> SourceText -> String -> EP
markAnnOpenP' an NoSourceText txt = markEpAnnLMS0 an lapr_open AnnOpen (Just txt)
markAnnOpenP' an (SourceText txt) _ = markEpAnnLMS0 an lapr_open AnnOpen (Just $ unpackFS txt)
-markAnnOpen :: (Monad m, Monoid w) => [AddEpAnn] -> SourceText -> String -> EP w m [AddEpAnn]
-markAnnOpen an NoSourceText txt = markEpAnnLMS'' an lidl AnnOpen (Just txt)
-markAnnOpen an (SourceText txt) _ = markEpAnnLMS'' an lidl AnnOpen (Just $ unpackFS txt)
-
markAnnOpen' :: (Monad m, Monoid w)
=> Maybe EpaLocation -> SourceText -> String -> EP w m (Maybe EpaLocation)
markAnnOpen' ms NoSourceText txt = printStringAtMLoc' ms txt
@@ -2004,17 +2008,17 @@ exactDataFamInstDecl :: (Monad m, Monoid w)
=> [AddEpAnn] -> TopLevelFlag -> DataFamInstDecl GhcPs
-> EP w m ([AddEpAnn], DataFamInstDecl GhcPs)
exactDataFamInstDecl an top_lvl
- (DataFamInstDecl (FamEqn { feqn_ext = an2
+ (DataFamInstDecl (FamEqn { feqn_ext = (ops, cps, eq)
, feqn_tycon = tycon
, feqn_bndrs = bndrs
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = defn })) = do
- (an', an2', tycon', bndrs', pats', defn') <- exactDataDefn an2 pp_hdr defn
+ ((ops', cps', an'), tycon', bndrs', pats', defn') <- exactDataDefn pp_hdr defn
-- See Note [an and an2 in exactDataFamInstDecl]
return
(an',
- DataFamInstDecl ( FamEqn { feqn_ext = an2'
+ DataFamInstDecl ( FamEqn { feqn_ext = (ops', cps', eq)
, feqn_tycon = tycon'
, feqn_bndrs = bndrs'
, feqn_pats = pats'
@@ -2024,7 +2028,7 @@ exactDataFamInstDecl an top_lvl
where
pp_hdr :: (Monad m, Monoid w)
=> Maybe (LHsContext GhcPs)
- -> EP w m ( [AddEpAnn]
+ -> EP w m ( ([EpToken "("], [EpToken ")"], [AddEpAnn])
, LocatedN RdrName
, HsOuterTyVarBndrs () GhcPs
, HsFamEqnPats GhcPs
@@ -2033,7 +2037,7 @@ exactDataFamInstDecl an top_lvl
an0 <- case top_lvl of
TopLevel -> markEpAnnL an lidl AnnInstance -- TODO: maybe in toplevel
NotTopLevel -> return an
- exactHsFamInstLHS an0 tycon bndrs pats fixity mctxt
+ exactHsFamInstLHS ops cps an0 tycon bndrs pats fixity mctxt
{-
Note [an and an2 in exactDataFamInstDecl]
@@ -2146,11 +2150,11 @@ instance ExactPrint (WarnDecls GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (Warnings (an,src) warns) = do
- an0 <- markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED
+ exact (Warnings ((o,c),src) warns) = do
+ o' <- markAnnOpen'' o src "{-# WARNING" -- Note: might be {-# DEPRECATED
warns' <- markAnnotated warns
- an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
- return (Warnings (an1,src) warns')
+ c' <- printStringAtAA c "#-}"
+ return (Warnings ((o',c'),src) warns')
-- ---------------------------------------------------------------------
@@ -2212,14 +2216,14 @@ instance ExactPrint FastString where
instance ExactPrint (RuleDecls GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (HsRules (an, src) rules) = do
- an0 <-
+ exact (HsRules ((o,c), src) rules) = do
+ o' <-
case src of
- NoSourceText -> markEpAnnLMS'' an lidl AnnOpen (Just "{-# RULES")
- SourceText srcTxt -> markEpAnnLMS'' an lidl AnnOpen (Just $ unpackFS srcTxt)
+ NoSourceText -> printStringAtAA o "{-# RULES"
+ SourceText srcTxt -> printStringAtAA o (unpackFS srcTxt)
rules' <- markAnnotated rules
- an1 <- markEpAnnLMS'' an0 lidl AnnClose (Just "#-}")
- return (HsRules (an1,src) rules')
+ c' <- printStringAtAA c "#-}"
+ return (HsRules ((o',c'),src) rules')
-- ---------------------------------------------------------------------
@@ -2344,16 +2348,16 @@ instance ExactPrint (RuleBndr GhcPs) where
instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor fe _ _ _s = fe
- exact (FamEqn { feqn_ext = an
+ exact (FamEqn { feqn_ext = (ops, cps, eq)
, feqn_tycon = tycon
, feqn_bndrs = bndrs
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = rhs }) = do
- (an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS an tycon bndrs pats fixity Nothing
- an1 <- markEpAnnL an0 lidl AnnEqual
+ (_an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS ops cps [] tycon bndrs pats fixity Nothing
+ eq' <- markEpToken eq
rhs' <- markAnnotated rhs
- return (FamEqn { feqn_ext = an1
+ return (FamEqn { feqn_ext = ([], [], eq')
, feqn_tycon = tycon'
, feqn_bndrs = bndrs'
, feqn_pats = pats'
@@ -2364,48 +2368,52 @@ instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where
exactHsFamInstLHS ::
(Monad m, Monoid w)
- => [AddEpAnn]
+ => [EpToken "("]
+ -> [EpToken ")"]
+ -> [AddEpAnn]
-> LocatedN RdrName
-> HsOuterTyVarBndrs () GhcPs
-> HsFamEqnPats GhcPs
-> LexicalFixity
-> Maybe (LHsContext GhcPs)
- -> EP w m ( [AddEpAnn]
+ -> EP w m ( ([EpToken "("], [EpToken ")"], [AddEpAnn])
, LocatedN RdrName
, HsOuterTyVarBndrs () GhcPs
, HsFamEqnPats GhcPs, Maybe (LHsContext GhcPs))
-exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do
+exactHsFamInstLHS ops cps an thing bndrs typats fixity mb_ctxt = do
+ -- TODO:AZ: do these ans exist? They are in the binders now
an0 <- markEpAnnL an lidl AnnForall
bndrs' <- markAnnotated bndrs
an1 <- markEpAnnL an0 lidl AnnDot
mb_ctxt' <- mapM markAnnotated mb_ctxt
- (an2, thing', typats') <- exact_pats an1 typats
- return (an2, thing', bndrs', typats', mb_ctxt')
+ (ops', cps', thing', typats') <- exact_pats ops cps typats
+ return ((ops', cps', an1), thing', bndrs', typats', mb_ctxt')
where
exact_pats :: (Monad m, Monoid w)
- => [AddEpAnn] -> HsFamEqnPats GhcPs -> EP w m ([AddEpAnn], LocatedN RdrName, HsFamEqnPats GhcPs)
- exact_pats an' (patl:patr:pats)
+ => [EpToken "("] -> [EpToken ")"] -> HsFamEqnPats GhcPs
+ -> EP w m ([EpToken "("], [EpToken ")"], LocatedN RdrName, HsFamEqnPats GhcPs)
+ exact_pats ops1 cps1 (patl:patr:pats)
| Infix <- fixity
= let exact_op_app = do
- an0 <- markEpAnnAllL' an' lidl AnnOpenP
+ ops' <- mapM markEpToken ops1
patl' <- markAnnotated patl
thing' <- markAnnotated thing
patr' <- markAnnotated patr
- an1 <- markEpAnnAllL' an0 lidl AnnCloseP
- return (an1, thing', [patl',patr'])
+ cps' <- mapM markEpToken cps1
+ return (ops', cps', thing', [patl',patr'])
in case pats of
[] -> exact_op_app
_ -> do
- (an0, thing', p) <- exact_op_app
+ (ops', cps', thing', p) <- exact_op_app
pats' <- mapM markAnnotated pats
- return (an0, thing', p++pats')
+ return (ops', cps', thing', p++pats')
- exact_pats an' pats = do
- an0 <- markEpAnnAllL' an' lidl AnnOpenP
+ exact_pats ops0 cps0 pats = do
+ ops' <- mapM markEpToken ops0
thing' <- markAnnotated thing
pats' <- markAnnotated pats
- an1 <- markEpAnnAllL' an0 lidl AnnCloseP
- return (an1, thing', pats')
+ cps' <- mapM markEpToken cps0
+ return (ops', cps', thing', pats')
-- ---------------------------------------------------------------------
@@ -2471,11 +2479,11 @@ instance ExactPrint (TyFamInstDecl GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact d@(TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do
- an0 <- markEpAnnL an lidl AnnType
- an1 <- markEpAnnL an0 lidl AnnInstance
+ exact d@(TyFamInstDecl { tfid_xtn = (tt,ti), tfid_eqn = eqn }) = do
+ tt' <- markEpToken tt
+ ti' <- markEpToken ti
eqn' <- markAnnotated eqn
- return (d { tfid_xtn = an1, tfid_eqn = eqn' })
+ return (d { tfid_xtn = (tt',ti'), tfid_eqn = eqn' })
-- ---------------------------------------------------------------------
@@ -2967,13 +2975,13 @@ instance ExactPrint (DefaultDecl GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (DefaultDecl an cl tys) = do
- an0 <- markEpAnnL an lidl AnnDefault
- an1 <- markEpAnnL an0 lidl AnnOpenP
+ exact (DefaultDecl (d,op,cp) cl tys) = do
+ d' <- markEpToken d
+ op' <- markEpToken op
cl' <- markAnnotated cl
tys' <- markAnnotated tys
- an2 <- markEpAnnL an1 lidl AnnCloseP
- return (DefaultDecl an2 cl' tys')
+ cp' <- markEpToken cp
+ return (DefaultDecl (d',op',cp') cl' tys')
-- ---------------------------------------------------------------------
@@ -3773,11 +3781,11 @@ instance ExactPrint (TyClDecl GhcPs) where
, tcdLName = ltycon', tcdTyVars = tyvars', tcdFixity = fixity
, tcdRhs = rhs' })
- exact (DataDecl { tcdDExt = an, tcdLName = ltycon, tcdTyVars = tyvars
+ exact (DataDecl { tcdDExt = x, tcdLName = ltycon, tcdTyVars = tyvars
, tcdFixity = fixity, tcdDataDefn = defn }) = do
- (_, an', ltycon', tyvars', _, defn') <-
- exactDataDefn an (exactVanillaDeclHead ltycon tyvars fixity) defn
- return (DataDecl { tcdDExt = an', tcdLName = ltycon', tcdTyVars = tyvars'
+ (_, ltycon', tyvars', _, defn') <-
+ exactDataDefn (exactVanillaDeclHead ltycon tyvars fixity) defn
+ return (DataDecl { tcdDExt = x, tcdLName = ltycon', tcdTyVars = tyvars'
, tcdFixity = fixity, tcdDataDefn = defn' })
-- -----------------------------------
@@ -3852,7 +3860,7 @@ instance ExactPrint (FunDep GhcPs) where
exact (FunDep an ls rs') = do
ls' <- markAnnotated ls
- an0 <- markEpAnnL an lidl AnnRarrow
+ an0 <- markEpUniToken an
rs'' <- markAnnotated rs'
return (FunDep an0 ls' rs'')
@@ -3862,7 +3870,7 @@ instance ExactPrint (FamilyDecl GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (FamilyDecl { fdExt = an
+ exact (FamilyDecl { fdExt = AnnFamilyDecl ops cps t d f dc eq vb w oc dd cc
, fdInfo = info
, fdTopLevel = top_level
, fdLName = ltycon
@@ -3870,35 +3878,37 @@ instance ExactPrint (FamilyDecl GhcPs) where
, fdFixity = fixity
, fdResultSig = L lr result
, fdInjectivityAnn = mb_inj }) = do
- an0 <- exactFlavour an info
- an1 <- exact_top_level an0
- an2 <- annotationsToComments an1 lidl [AnnOpenP,AnnCloseP]
+ (d',t') <- exactFlavour (d,t) info
+ f' <- exact_top_level f
+
+ epTokensToComments AnnOpenP ops
+ epTokensToComments AnnCloseP cps
(_, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
- (an3, result') <- exact_kind an2
- (an4, mb_inj') <-
+ (dc', eq', result') <- exact_kind (dc, eq)
+ (vb', mb_inj') <-
case mb_inj of
- Nothing -> return (an3, mb_inj)
+ Nothing -> return (vb, mb_inj)
Just inj -> do
- an4 <- markEpAnnL an3 lidl AnnVbar
+ vb' <- markEpToken vb
inj' <- markAnnotated inj
- return (an4, Just inj')
- (an5, info') <-
+ return (vb', Just inj')
+ (w', oc', dd', cc', info') <-
case info of
ClosedTypeFamily mb_eqns -> do
- an5 <- markEpAnnL an4 lidl AnnWhere
- an6 <- markEpAnnL an5 lidl AnnOpenC
- (an7, mb_eqns') <-
+ w' <- markEpToken w
+ oc' <- markEpToken oc
+ (dd', mb_eqns') <-
case mb_eqns of
Nothing -> do
- an7 <- markEpAnnL an6 lidl AnnDotdot
- return (an7, mb_eqns)
+ dd' <- markEpToken dd
+ return (dd', mb_eqns)
Just eqns -> do
eqns' <- markAnnotated eqns
- return (an6, Just eqns')
- an8 <- markEpAnnL an7 lidl AnnCloseC
- return (an8, ClosedTypeFamily mb_eqns')
- _ -> return (an4, info)
- return (FamilyDecl { fdExt = an5
+ return (dd, Just eqns')
+ cc' <- markEpToken cc
+ return (w',oc',dd',cc', ClosedTypeFamily mb_eqns')
+ _ -> return (w,oc,dd,cc, info)
+ return (FamilyDecl { fdExt = AnnFamilyDecl [] [] t' d' f' dc' eq' vb' w' oc' dd' cc'
, fdInfo = info'
, fdTopLevel = top_level
, fdLName = ltycon'
@@ -3907,86 +3917,91 @@ instance ExactPrint (FamilyDecl GhcPs) where
, fdResultSig = L lr result'
, fdInjectivityAnn = mb_inj' })
where
- exact_top_level an' =
+ exact_top_level tfamily =
case top_level of
- TopLevel -> markEpAnnL an' lidl AnnFamily
+ TopLevel -> markEpToken tfamily
NotTopLevel -> do
-- It seems that in some kind of legacy
-- mode the 'family' keyword is still
-- accepted.
- markEpAnnL an' lidl AnnFamily
+ markEpToken tfamily
- exact_kind an' =
+ exact_kind (tdcolon, tequal) =
case result of
- NoSig _ -> return (an', result)
+ NoSig _ -> return (tdcolon, tequal, result)
KindSig x kind -> do
- an0 <- markEpAnnL an' lidl AnnDcolon
+ tdcolon' <- markEpUniToken tdcolon
kind' <- markAnnotated kind
- return (an0, KindSig x kind')
+ return (tdcolon', tequal, KindSig x kind')
TyVarSig x tv_bndr -> do
- an0 <- markEpAnnL an' lidl AnnEqual
+ tequal' <- markEpToken tequal
tv_bndr' <- markAnnotated tv_bndr
- return (an0, TyVarSig x tv_bndr')
+ return (tdcolon, tequal', TyVarSig x tv_bndr')
-exactFlavour :: (Monad m, Monoid w) => [AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
-exactFlavour an DataFamily = markEpAnnL an lidl AnnData
-exactFlavour an OpenTypeFamily = markEpAnnL an lidl AnnType
-exactFlavour an (ClosedTypeFamily {}) = markEpAnnL an lidl AnnType
+exactFlavour :: (Monad m, Monoid w) => (EpToken "data", EpToken "type") -> FamilyInfo GhcPs -> EP w m (EpToken "data", EpToken "type")
+exactFlavour (td,tt) DataFamily = (\td' -> (td',tt)) <$> markEpToken td
+exactFlavour (td,tt) OpenTypeFamily = (td,) <$> markEpToken tt
+exactFlavour (td,tt) (ClosedTypeFamily {}) = (td,) <$> markEpToken tt
-- ---------------------------------------------------------------------
exactDataDefn
:: (Monad m, Monoid w)
- => [AddEpAnn]
- -> (Maybe (LHsContext GhcPs) -> EP w m ([AddEpAnn]
+ => (Maybe (LHsContext GhcPs) -> EP w m (r
, LocatedN RdrName
, a
, b
, Maybe (LHsContext GhcPs))) -- Printing the header
-> HsDataDefn GhcPs
- -> EP w m ( [AddEpAnn] -- ^ from exactHdr
- , [AddEpAnn] -- ^ updated one passed in
+ -> EP w m ( r -- ^ from exactHdr
, LocatedN RdrName, a, b, HsDataDefn GhcPs)
-exactDataDefn an exactHdr
- (HsDataDefn { dd_ext = x, dd_ctxt = context
+exactDataDefn exactHdr
+ (HsDataDefn { dd_ext = AnnDataDefn ops cps t nt d i dc w oc cc eq
+ , dd_ctxt = context
, dd_cType = mb_ct
, dd_kindSig = mb_sig
, dd_cons = condecls, dd_derivs = derivings }) = do
- an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]
- an0 <- case condecls of
- DataTypeCons is_type_data _ -> do
- an0' <- if is_type_data
- then markEpAnnL an' lidl AnnType
- else return an'
- markEpAnnL an0' lidl AnnData
- NewTypeCon _ -> markEpAnnL an' lidl AnnNewtype
+ epTokensToComments AnnOpenP ops
+ epTokensToComments AnnCloseP cps
- an1 <- markEpAnnL an0 lidl AnnInstance -- optional
+ (t',nt',d') <- case condecls of
+ DataTypeCons is_type_data _ -> do
+ t' <- if is_type_data
+ then markEpToken t
+ else return t
+ d' <- markEpToken d
+ return (t',nt,d')
+ NewTypeCon _ -> do
+ nt' <- markEpToken nt
+ return (t, nt', d)
+
+ i' <- markEpToken i -- optional
mb_ct' <- mapM markAnnotated mb_ct
(anx, ln', tvs', b, mctxt') <- exactHdr context
- (an2, mb_sig') <- case mb_sig of
- Nothing -> return (an1, Nothing)
+ (dc', mb_sig') <- case mb_sig of
+ Nothing -> return (dc, Nothing)
Just kind -> do
- an2 <- markEpAnnL an1 lidl AnnDcolon
+ dc' <- markEpUniToken dc
kind' <- markAnnotated kind
- return (an2, Just kind')
- an3 <- if (needsWhere condecls)
- then markEpAnnL an2 lidl AnnWhere
- else return an2
- an4 <- markEpAnnL an3 lidl AnnOpenC
- (an5, condecls') <- exact_condecls an4 (toList condecls)
+ return (dc', Just kind')
+ w' <- if (needsWhere condecls)
+ then markEpToken w
+ else return w
+ oc' <- markEpToken oc
+ (eq', condecls') <- exact_condecls eq (toList condecls)
let condecls'' = case condecls of
- DataTypeCons d _ -> DataTypeCons d condecls'
+ DataTypeCons td _ -> DataTypeCons td condecls'
NewTypeCon _ -> case condecls' of
[decl] -> NewTypeCon decl
_ -> panic "exacprint NewTypeCon"
- an6 <- markEpAnnL an5 lidl AnnCloseC
+ cc' <- markEpToken cc
derivings' <- mapM markAnnotated derivings
- return (anx, an6, ln', tvs', b,
- (HsDataDefn { dd_ext = x, dd_ctxt = mctxt'
+ return (anx, ln', tvs', b,
+ (HsDataDefn { dd_ext = AnnDataDefn [] [] t' nt' d' i' dc' w' oc' cc' eq'
+ , dd_ctxt = mctxt'
, dd_cType = mb_ct'
, dd_kindSig = mb_sig'
, dd_cons = condecls'', dd_derivs = derivings' }))
@@ -4032,12 +4047,11 @@ exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context
instance ExactPrint (InjectivityAnn GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (InjectivityAnn an lhs rhs) = do
- an0 <- markEpAnnL an lidl AnnVbar
+ exact (InjectivityAnn rarrow lhs rhs) = do
lhs' <- markAnnotated lhs
- an1 <- markEpAnnL an0 lidl AnnRarrow
+ rarrow' <- markEpUniToken rarrow
rhs' <- mapM markAnnotated rhs
- return (InjectivityAnn an1 lhs' rhs')
+ return (InjectivityAnn rarrow' lhs' rhs')
-- ---------------------------------------------------------------------
@@ -4238,17 +4252,17 @@ instance ExactPrint (HsForAllTelescope GhcPs) where
setAnnotationAnchor (HsForAllVis an a) anc ts cs = HsForAllVis (setAnchorEpa an anc ts cs) a
setAnnotationAnchor (HsForAllInvis an a) anc ts cs = HsForAllInvis (setAnchorEpa an anc ts cs) a
- exact (HsForAllVis an bndrs) = do
- an0 <- markLensAA an lfst -- AnnForall
+ exact (HsForAllVis (EpAnn l (f,r) cs) bndrs) = do
+ f' <- markEpUniToken f
bndrs' <- markAnnotated bndrs
- an1 <- markLensAA an0 lsnd -- AnnRarrow
- return (HsForAllVis an1 bndrs')
+ r' <- markEpUniToken r
+ return (HsForAllVis (EpAnn l (f',r') cs) bndrs')
- exact (HsForAllInvis an bndrs) = do
- an0 <- markLensAA an lfst -- AnnForall
+ exact (HsForAllInvis (EpAnn l (f,d) cs) bndrs) = do
+ f' <- markEpUniToken f
bndrs' <- markAnnotated bndrs
- an1 <- markLensAA an0 lsnd -- AnnDot
- return (HsForAllInvis an1 bndrs')
+ d' <- markEpToken d
+ return (HsForAllInvis (EpAnn l (f',d') cs) bndrs')
-- ---------------------------------------------------------------------
@@ -4430,17 +4444,17 @@ markTrailing ts = do
-- based on pp_condecls in Decls.hs
exact_condecls :: (Monad m, Monoid w)
- => [AddEpAnn] -> [LConDecl GhcPs] -> EP w m ([AddEpAnn],[LConDecl GhcPs])
-exact_condecls an cs
+ => EpToken "=" -> [LConDecl GhcPs] -> EP w m (EpToken "=",[LConDecl GhcPs])
+exact_condecls eq cs
| gadt_syntax -- In GADT syntax
= do
cs' <- mapM markAnnotated cs
- return (an, cs')
+ return (eq, cs')
| otherwise -- In H98 syntax
= do
- an0 <- markEpAnnL an lidl AnnEqual
+ eq0 <- markEpToken eq
cs' <- mapM markAnnotated cs
- return (an0, cs')
+ return (eq0, cs')
where
gadt_syntax = case cs of
[] -> False
@@ -4553,11 +4567,11 @@ instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) wher
setAnnotationAnchor (HsOuterExplicit an a) anc ts cs = HsOuterExplicit (setAnchorEpa an anc ts cs) a
exact b@(HsOuterImplicit _) = pure b
- exact (HsOuterExplicit an bndrs) = do
- an0 <- markLensAA an lfst -- "forall"
+ exact (HsOuterExplicit (EpAnn l (f,d) cs) bndrs) = do
+ f' <- markEpUniToken f
bndrs' <- markAnnotated bndrs
- an1 <- markLensAA an0 lsnd -- "."
- return (HsOuterExplicit an1 bndrs')
+ d' <- markEpToken d
+ return (HsOuterExplicit (EpAnn l (f',d') cs) bndrs')
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Main.hs
=====================================
@@ -209,10 +209,10 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/
-- "../../testsuite/tests/printer/PprParenFunBind.hs" Nothing
-- "../../testsuite/tests/printer/Test16279.hs" Nothing
-- "../../testsuite/tests/printer/HsDocTy.hs" Nothing
- "../../testsuite/tests/printer/Test21355.hs" Nothing
+ -- "../../testsuite/tests/printer/Test21355.hs" Nothing
-- "../../testsuite/tests/printer/Test22765.hs" Nothing
-- "../../testsuite/tests/printer/Test22771.hs" Nothing
- -- "../../testsuite/tests/printer/Test23465.hs" Nothing
+ "../../testsuite/tests/printer/Test23465.hs" Nothing
-- cloneT does not need a test, function can be retired
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -269,7 +269,7 @@ synifyTyCon prr _coax tc
, tcdFixity = synifyFixity tc
, tcdDataDefn =
HsDataDefn
- { dd_ext = noExtField
+ { dd_ext = noAnn
, dd_cons = DataTypeCons False [] -- No constructors; arbitrary lie, they are neither
-- algebraic data nor newtype:
, dd_ctxt = Nothing
@@ -401,7 +401,7 @@ synifyTyCon _prr coax tc
alg_deriv = []
defn =
HsDataDefn
- { dd_ext = noExtField
+ { dd_ext = noAnn
, dd_ctxt = alg_ctx
, dd_cType = Nothing
, dd_kindSig = kindSig
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d783489be83063c8c6b761d1a528f2eca60ed707
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d783489be83063c8c6b761d1a528f2eca60ed707
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241018/966945a6/attachment-0001.html>
More information about the ghc-commits
mailing list