[Git][ghc/ghc][wip/az/epa-remove-addepann-5] 4 commits: EPA: Remove [AddEpAnn] From HsDeriving
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sat Oct 19 14:41:54 UTC 2024
Alan Zimmerman pushed to branch wip/az/epa-remove-addepann-5 at Glasgow Haskell Compiler / GHC
Commits:
1e096aed by Alan Zimmerman at 2024-10-19T10:33:32+01:00
EPA: Remove [AddEpAnn] From HsDeriving
- - - - -
557387a2 by Alan Zimmerman at 2024-10-19T11:08:56+01:00
EPA: Remove [AddEpAnn] from ConDeclField
- - - - -
78c5782b by Alan Zimmerman at 2024-10-19T14:40:02+01:00
EPA: Remove [AddEpAnn] from ConDeclGADT
- - - - -
e44633ef by Alan Zimmerman at 2024-10-19T15:41:07+01:00
EPA: Remove [AddEpAnn] from ConDeclH98
- - - - -
20 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/JS/Ppr.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.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/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -59,7 +59,7 @@ module GHC.Hs.Decls (
LClsInstDecl, ClsInstDecl(..),
-- ** Standalone deriving declarations
- DerivDecl(..), LDerivDecl,
+ DerivDecl(..), LDerivDecl, AnnDerivDecl,
-- ** Deriving strategies
DerivStrategy(..), LDerivStrategy,
derivStrategyName, foldDerivStrategy, mapDerivStrategy,
@@ -80,7 +80,9 @@ module GHC.Hs.Decls (
CImportSpec(..),
-- ** Data-constructor declarations
ConDecl(..), LConDecl,
- HsConDeclH98Details, HsConDeclGADTDetails(..), hsConDeclTheta,
+ HsConDeclH98Details, HsConDeclGADTDetails(..),
+ AnnConDeclH98(..), AnnConDeclGADT(..),
+ hsConDeclTheta,
getConNames, getRecConArgs_maybe,
-- ** Document comments
DocDecl(..), LDocDecl, docDeclDoc,
@@ -705,7 +707,7 @@ instance OutputableBndrId p
type instance XCHsDataDefn (GhcPass _) = AnnDataDefn
type instance XXHsDataDefn (GhcPass _) = DataConCantHappen
-type instance XCHsDerivingClause (GhcPass _) = [AddEpAnn]
+type instance XCHsDerivingClause (GhcPass _) = EpToken "deriving"
type instance XXHsDerivingClause (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -750,11 +752,11 @@ type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen
standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
-type instance XConDeclGADT GhcPs = (TokDcolon, [AddEpAnn])
+type instance XConDeclGADT GhcPs = AnnConDeclGADT
type instance XConDeclGADT GhcRn = NoExtField
type instance XConDeclGADT GhcTc = NoExtField
-type instance XConDeclH98 GhcPs = [AddEpAnn]
+type instance XConDeclH98 GhcPs = AnnConDeclH98
type instance XConDeclH98 GhcRn = NoExtField
type instance XConDeclH98 GhcTc = NoExtField
@@ -768,6 +770,26 @@ type instance XRecConGADT GhcTc = NoExtField
type instance XXConDeclGADTDetails (GhcPass _) = DataConCantHappen
+data AnnConDeclH98
+ = AnnConDeclH98 {
+ acdh_forall :: TokForall,
+ acdh_dot :: EpToken ".",
+ acdh_darrow :: TokDarrow
+ } deriving Data
+
+instance NoAnn AnnConDeclH98 where
+ noAnn = AnnConDeclH98 noAnn noAnn noAnn
+
+data AnnConDeclGADT
+ = AnnConDeclGADT {
+ acdg_openp :: [EpToken "("],
+ acdg_closep :: [EpToken ")"],
+ acdg_dcolon :: TokDcolon
+ } deriving Data
+
+instance NoAnn AnnConDeclGADT where
+ noAnn = AnnConDeclGADT noAnn noAnn noAnn
+
-- Codomain could be 'NonEmpty', but at the moment all users need a list.
getConNames :: ConDecl GhcRn -> [LocatedN Name]
getConNames ConDeclH98 {con_name = name} = [name]
@@ -1086,15 +1108,17 @@ type instance XCDerivDecl GhcPs = ( Maybe (LWarningTxt GhcPs)
-- The warning of the deprecated derivation
-- See Note [Implementation of deprecated instances]
-- in GHC.Tc.Solver.Dict
- , [AddEpAnn] )
+ , AnnDerivDecl )
type instance XCDerivDecl GhcRn = ( Maybe (LWarningTxt GhcRn)
-- The warning of the deprecated derivation
-- See Note [Implementation of deprecated instances]
-- in GHC.Tc.Solver.Dict
- , [AddEpAnn] )
-type instance XCDerivDecl GhcTc = [AddEpAnn]
+ , AnnDerivDecl )
+type instance XCDerivDecl GhcTc = AnnDerivDecl
type instance XXDerivDecl (GhcPass _) = DataConCantHappen
+type AnnDerivDecl = (EpToken "deriving", EpToken "instance")
+
derivDeprecation :: forall p. IsPass p
=> DerivDecl (GhcPass p)
-> Maybe (WarningTxt (GhcPass p))
@@ -1128,15 +1152,15 @@ instance OutputableBndrId p
************************************************************************
-}
-type instance XStockStrategy GhcPs = [AddEpAnn]
+type instance XStockStrategy GhcPs = EpToken "stock"
type instance XStockStrategy GhcRn = NoExtField
type instance XStockStrategy GhcTc = NoExtField
-type instance XAnyClassStrategy GhcPs = [AddEpAnn]
+type instance XAnyClassStrategy GhcPs = EpToken "anyclass"
type instance XAnyClassStrategy GhcRn = NoExtField
type instance XAnyClassStrategy GhcTc = NoExtField
-type instance XNewtypeStrategy GhcPs = [AddEpAnn]
+type instance XNewtypeStrategy GhcPs = EpToken "newtype"
type instance XNewtypeStrategy GhcRn = NoExtField
type instance XNewtypeStrategy GhcTc = NoExtField
@@ -1144,7 +1168,7 @@ type instance XViaStrategy GhcPs = XViaStrategyPs
type instance XViaStrategy GhcRn = LHsSigType GhcRn
type instance XViaStrategy GhcTc = Type
-data XViaStrategyPs = XViaStrategyPs [AddEpAnn] (LHsSigType GhcPs)
+data XViaStrategyPs = XViaStrategyPs (EpToken "via") (LHsSigType GhcPs)
instance OutputableBndrId p
=> Outputable (DerivStrategy (GhcPass p)) where
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -294,7 +294,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
epTokenInstance :: EpToken "instance" -> SDoc
epTokenInstance = epToken'
- epTokenForall :: EpUniToken "forall" "∀" -> SDoc
+ epTokenForall :: TokForall -> SDoc
epTokenForall = epUniToken'
epToken' :: KnownSymbol sym => EpToken sym -> SDoc
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -163,15 +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 _) = EpAnn (EpUniToken "forall" "∀", EpUniToken "->" "→")
+type instance XHsForAllVis (GhcPass _) = EpAnn (TokForall, EpUniToken "->" "→")
-- Location of 'forall' and '->'
-type instance XHsForAllInvis (GhcPass _) = EpAnn (EpUniToken "forall" "∀", EpToken ".")
+type instance XHsForAllInvis (GhcPass _) = EpAnn (TokForall, EpToken ".")
-- Location of 'forall' and '.'
type instance XXHsForAllTelescope (GhcPass _) = DataConCantHappen
-type EpAnnForallVis = EpAnn (EpUniToken "forall" "∀", EpUniToken "->" "→")
-type EpAnnForallInvis = EpAnn (EpUniToken "forall" "∀", EpToken ".")
+type EpAnnForallVis = EpAnn (TokForall, TokRarrow)
+type EpAnnForallInvis = EpAnn (TokForall, EpToken ".")
type HsQTvsRn = [Name] -- Implicit variables
-- For example, in data T (a :: k1 -> k2) = ...
@@ -461,7 +461,7 @@ type instance XListTy (GhcPass _) = AnnParen
type instance XTupleTy (GhcPass _) = AnnParen
type instance XSumTy (GhcPass _) = AnnParen
type instance XOpTy (GhcPass _) = NoExtField
-type instance XParTy (GhcPass _) = AnnParen
+type instance XParTy (GhcPass _) = (EpToken "(", EpToken ")")
type instance XIParamTy (GhcPass _) = TokDcolon
type instance XStarTy (GhcPass _) = NoExtField
type instance XKindSig (GhcPass _) = TokDcolon
@@ -572,7 +572,7 @@ pprHsArrow (HsUnrestrictedArrow _) = pprArrowWithMultiplicity visArgTypeLike (Le
pprHsArrow (HsLinearArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left True)
pprHsArrow (HsExplicitMult _ p) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p))
-type instance XConDeclField (GhcPass _) = [AddEpAnn]
+type instance XConDeclField (GhcPass _) = TokDcolon
type instance XXConDeclField (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -710,23 +710,22 @@ mkHsAppKindTy at ty k = addCLocA ty k (HsAppKindTy at ty k)
-- It returns API Annotations for any parens removed
splitHsFunType ::
LHsType (GhcPass p)
- -> ( [AddEpAnn], EpAnnComments -- The locations of any parens and
+ -> ( ([EpToken "("], [EpToken ")"]) , EpAnnComments -- The locations of any parens and
-- comments discarded
, [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
splitHsFunType ty = go ty
where
- go (L l (HsParTy an ty))
+ go (L l (HsParTy (op,cp) ty))
= let
- (anns, cs, args, res) = splitHsFunType ty
- anns' = anns ++ annParen2AddEpAnn an
+ ((ops, cps), cs, args, res) = splitHsFunType ty
cs' = cs S.<> epAnnComments l
- in (anns', cs', args, res)
+ in ((ops++[op], cps ++ [cp]), cs', args, res)
go (L ll (HsFunTy _ mult x y))
| (anns, csy, args, res) <- splitHsFunType y
= (anns, csy S.<> epAnnComments ll, HsScaled mult x:args, res)
- go other = ([], emptyComments, [], other)
+ go other = (noAnn, emptyComments, [], other)
-- | Retrieve the name of the \"head\" of a nested type application.
-- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more
=====================================
compiler/GHC/JS/Ppr.hs
=====================================
@@ -33,7 +33,7 @@
-- * Design
--
-- This module follows the architecture and style of the other backends in
--- GHC: it intances Outputable for the relevant types, creates a class that
+-- GHC: it instances Outputable for the relevant types, creates a class that
-- describes a morphism from the IR domain to JavaScript concrete Syntax and
-- then generates that syntax on a case by case basis.
--
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1431,17 +1431,17 @@ overlap_pragma :: { Maybe (LocatedP OverlapMode) }
| {- empty -} { Nothing }
deriv_strategy_no_via :: { LDerivStrategy GhcPs }
- : 'stock' {% amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }
- | 'anyclass' {% amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }
- | 'newtype' {% amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }
+ : 'stock' {% amsA' (sL1 $1 (StockStrategy (epTok $1))) }
+ | 'anyclass' {% amsA' (sL1 $1 (AnyclassStrategy (epTok $1))) }
+ | 'newtype' {% amsA' (sL1 $1 (NewtypeStrategy (epTok $1))) }
deriv_strategy_via :: { LDerivStrategy GhcPs }
- : 'via' sigktype {% amsA' (sLL $1 $> (ViaStrategy (XViaStrategyPs [mj AnnVia $1] $2))) }
+ : 'via' sigktype {% amsA' (sLL $1 $> (ViaStrategy (XViaStrategyPs (epTok $1) $2))) }
deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }
- : 'stock' {% fmap Just $ amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }
- | 'anyclass' {% fmap Just $ amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }
- | 'newtype' {% fmap Just $ amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }
+ : 'stock' {% fmap Just $ amsA' (sL1 $1 (StockStrategy (epTok $1))) }
+ | 'anyclass' {% fmap Just $ amsA' (sL1 $1 (AnyclassStrategy (epTok $1))) }
+ | 'newtype' {% fmap Just $ amsA' (sL1 $1 (NewtypeStrategy (epTok $1))) }
| deriv_strategy_via { Just $1 }
| {- empty -} { Nothing }
@@ -1676,7 +1676,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs }
{% do { let { err = text "in the stand-alone deriving instance"
<> colon <+> quotes (ppr $6) }
; amsA' (sLL $1 $>
- (DerivDecl ($4, [mj AnnDeriving $1, mj AnnInstance $3]) (mkHsWildCardBndrs $6) $2 $5)) }}
+ (DerivDecl ($4, (epTok $1, epTok $3)) (mkHsWildCardBndrs $6) $2 $5)) }}
-----------------------------------------------------------------------------
-- Role annotations
@@ -2343,7 +2343,7 @@ atype :: { LHsType GhcPs }
| '(#' bar_types2 '#)' {% do { requireLTPuns PEP_SumSyntaxType $1 $>
; amsA' (sLL $1 $> $ HsSumTy (AnnParen AnnParensHash (glR $1) (glR $3)) $2) } }
| '[' ktype ']' {% amsA' . sLL $1 $> =<< (mkListSyntaxTy1 (glR $1) $2 (glR $3)) }
- | '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (AnnParen AnnParens (glR $1) (glR $3)) $2) }
+ | '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE '(' ')' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) []) }}
@@ -2559,22 +2559,22 @@ constr :: { LConDecl GhcPs }
: forall context '=>' constr_stuff
{% amsA' (let (con,details) = unLoc $4 in
(L (comb4 $1 $2 $3 $4) (mkConDeclH98
- (mu AnnDarrow $3:(fst $ unLoc $1))
+ (epUniTok $3,(fst $ unLoc $1))
con
(snd $ unLoc $1)
(Just $2)
details))) }
| forall constr_stuff
{% amsA' (let (con,details) = unLoc $2 in
- (L (comb2 $1 $2) (mkConDeclH98 (fst $ unLoc $1)
+ (L (comb2 $1 $2) (mkConDeclH98 (noAnn, fst $ unLoc $1)
con
(snd $ unLoc $1)
Nothing -- No context
details))) }
-forall :: { Located ([AddEpAnn], Maybe [LHsTyVarBndr Specificity GhcPs]) }
- : 'forall' tv_bndrs '.' { sLL $1 $> ([mu AnnForall $1,mj AnnDot $3], Just $2) }
- | {- empty -} { noLoc ([], Nothing) }
+forall :: { Located ((TokForall, EpToken "."), Maybe [LHsTyVarBndr Specificity GhcPs]) }
+ : 'forall' tv_bndrs '.' { sLL $1 $> ((epUniTok $1,epTok $3), Just $2) }
+ | {- empty -} { noLoc (noAnn, Nothing) }
constr_stuff :: { Located (LocatedN RdrName, HsConDeclH98Details GhcPs) }
: infixtype {% do { b <- runPV $1
@@ -2599,7 +2599,7 @@ fielddecl :: { LConDeclField GhcPs }
-- A list because of f,g :: Int
: sig_vars '::' ctype
{% amsA' (L (comb2 $1 $3)
- (ConDeclField [mu AnnDcolon $2]
+ (ConDeclField (epUniTok $2)
(reverse (map (\ln@(L l n)
-> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc $1))) $3 Nothing))}
@@ -2618,15 +2618,15 @@ derivings :: { Located (HsDeriving GhcPs) }
deriving :: { LHsDerivingClause GhcPs }
: 'deriving' deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] Nothing $2) }
+ in amsA' (L full_loc $ HsDerivingClause (epTok $1) Nothing $2) }
| 'deriving' deriv_strategy_no_via deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $2) $3) }
+ in amsA' (L full_loc $ HsDerivingClause (epTok $1) (Just $2) $3) }
| 'deriving' deriv_clause_types deriv_strategy_via
{% let { full_loc = comb2 $1 $> }
- in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $3) $2) }
+ in amsA' (L full_loc $ HsDerivingClause (epTok $1) (Just $3) $2) }
deriv_clause_types :: { LDerivClauseTys GhcPs }
: qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.Parser.Annotation (
AnnKeywordId(..),
EpToken(..), EpUniToken(..),
getEpTokenSrcSpan, getEpTokenLocs, getEpTokenLoc,
- TokDcolon, TokRarrow,
+ TokDcolon, TokDarrow, TokRarrow, TokForall,
EpLayout(..),
EpaComment(..), EpaCommentTok(..),
IsUnicodeSyntax(..),
@@ -410,8 +410,11 @@ getEpTokenLoc :: EpToken tok -> EpaLocation
getEpTokenLoc NoEpTok = noAnn
getEpTokenLoc (EpTok l) = l
+-- TODO:AZ: check we have all of the unicode tokens
type TokDcolon = EpUniToken "::" "∷"
+type TokDarrow = EpUniToken "=>" "⇒"
type TokRarrow = EpUniToken "->" "→"
+type TokForall = EpUniToken "forall" "∀"
-- | Layout information for declarations.
data EpLayout =
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -773,12 +773,12 @@ recordPatSynErr loc pat =
addFatalError $ mkPlainErrorMsgEnvelope loc $
(PsErrRecordSyntaxInPatSynDecl pat)
-mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
+mkConDeclH98 :: (TokDarrow, (TokForall, EpToken ".")) -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
-mkConDeclH98 ann name mb_forall mb_cxt args
- = ConDeclH98 { con_ext = ann
+mkConDeclH98 (tdarrow, (tforall,tdot)) name mb_forall mb_cxt args
+ = ConDeclH98 { con_ext = AnnConDeclH98 tforall tdot tdarrow
, con_name = name
, con_forall = isJust mb_forall
, con_ex_tvs = mb_forall `orElse` []
@@ -795,12 +795,12 @@ mkConDeclH98 ann name mb_forall mb_cxt args
-- Note [GADT abstract syntax] in "GHC.Hs.Decls" for more details.
mkGadtDecl :: SrcSpan
-> NonEmpty (LocatedN RdrName)
- -> EpUniToken "::" "∷"
+ -> TokDcolon
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl loc names dcol ty = do
- (args, res_ty, annsa, csa) <-
+ (args, res_ty, (ops, cps), csa) <-
case body_ty of
L ll (HsFunTy _ hsArr (L (EpAnn anc _ cs) (HsRecTy an rf)) res_ty) -> do
arr <- case hsArr of
@@ -810,10 +810,10 @@ mkGadtDecl loc names dcol ty = do
return noAnn
return ( RecConGADT arr (L (EpAnn anc an cs) rf), res_ty
- , [], epAnnComments ll)
+ , ([], []), epAnnComments ll)
_ -> do
- let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
- return (PrefixConGADT noExtField arg_types, res_type, anns, cs)
+ let ((ops, cps), cs, arg_types, res_type) = splitHsFunType body_ty
+ return (PrefixConGADT noExtField arg_types, res_type, (ops,cps), cs)
let bndrs_loc = case outer_bndrs of
HsOuterImplicit{} -> getLoc ty
@@ -822,7 +822,7 @@ mkGadtDecl loc names dcol ty = do
let l = EpAnn (spanAsAnchor loc) noAnn csa
pure $ L l ConDeclGADT
- { con_g_ext = (dcol, annsa)
+ { con_g_ext = AnnConDeclGADT ops cps dcol
, con_names = names
, con_bndrs = L bndrs_loc outer_bndrs
, con_mb_cxt = mcxt
@@ -1079,9 +1079,7 @@ checkTyClHdr is_cls ty
| isRdrTc tc = return (ltc, lhs:rhs:acc, Infix, (reverse ops), cps, cs Semi.<> comments l)
where lhs = HsValArg noExtField t1
rhs = HsValArg noExtField t2
- go cs l (HsParTy _ ty) acc ops cps fix = goL (cs Semi.<> comments l) ty acc (o:ops) (c:cps) fix
- where
- (o,c) = mkParensEpToks (realSrcSpan (locA l))
+ go cs l (HsParTy (o,c) ty) acc ops cps fix = goL (cs Semi.<> comments l) ty acc (o:ops) (c:cps) fix
go cs l (HsAppTy _ t1 t2) acc ops cps fix = goL (cs Semi.<> comments l) t1 (HsValArg noExtField t2:acc) ops cps fix
go cs l (HsAppKindTy at ty ki) acc ops cps fix = goL (cs Semi.<> comments l) ty (HsTypeArg at ki:acc) ops cps fix
go cs l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix
@@ -1098,12 +1096,12 @@ checkTyClHdr is_cls ty
-- Combine the annotations from the HsParTy and HsStarTy into a
-- new one for the LocatedN RdrName
- newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> AnnParen -> SrcSpanAnnN
- newAnns l@(EpAnn _ (AnnListItem _) csp0) l1@(EpAnn ap (AnnListItem ta) csp) (AnnParen _ o c) =
+ newAnns :: SrcSpanAnnA -> SrcSpanAnnA -> (EpToken "(", EpToken ")") -> SrcSpanAnnN
+ newAnns l@(EpAnn _ (AnnListItem _) csp0) l1@(EpAnn ap (AnnListItem ta) csp) (o,c) =
let
lr = combineSrcSpans (locA l1) (locA l)
in
- EpAnn (EpaSpan lr) (NameAnn NameParens o ap c ta) (csp0 Semi.<> csp)
+ EpAnn (EpaSpan lr) (NameAnn NameParens (getEpTokenLoc o) ap (getEpTokenLoc c) ta) (csp0 Semi.<> csp)
-- | Yield a parse error if we have a function applied directly to a do block
-- etc. and BlockArguments is not enabled.
@@ -1171,9 +1169,9 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
EpTok ql -> ([AddEpAnn AnnSimpleQuote ql], [cl])
_ -> ([ol], [cl])
mkCTuple (oparens ++ (addLoc <$> op), (addLoc <$> cp) ++ cparens, cs) ts
- check (opi,cpi,csi) (L _lp1 (HsParTy ann' ty))
- -- to be sure HsParTy doesn't get into the way
- = check (ap_open ann':opi, ap_close ann':cpi, csi) ty
+ check (opi,cpi,csi) (L _lp1 (HsParTy (o,c) ty))
+ -- to be sure HsParTy doesn't get into the way
+ = check (getEpTokenLoc o:opi, getEpTokenLoc c:cpi, csi) ty
-- No need for anns, returning original
check (_opi,_cpi,_csi) _t = unprocessed
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -142,7 +142,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { Test20239.hs:5:36-49 })
@@ -190,7 +193,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:36-48 })
@@ -218,10 +224,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { Test20239.hs:7:50 })
- (EpaSpan { Test20239.hs:7:86 }))
+ ((,)
+ (EpTok
+ (EpaSpan { Test20239.hs:7:50 }))
+ (EpTok
+ (EpaSpan { Test20239.hs:7:86 })))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:51-85 })
@@ -290,10 +297,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { Test20239.hs:7:68 })
- (EpaSpan { Test20239.hs:7:85 }))
+ ((,)
+ (EpTok
+ (EpaSpan { Test20239.hs:7:68 }))
+ (EpTok
+ (EpaSpan { Test20239.hs:7:85 })))
(L
(EpAnn
(EpaSpan { Test20239.hs:7:69-84 })
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -1110,11 +1110,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:25:10-11 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -1486,11 +1487,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:31:10-11 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -1862,11 +1864,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:37:10-11 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -2238,11 +2241,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:43:10-11 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -2614,11 +2618,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:49:10-11 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -2990,11 +2995,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544.hs:55:11-12 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -101,11 +101,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544_kw.hs:16:15-16 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -214,11 +215,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T17544_kw.hs:19:15-16 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
=====================================
@@ -90,7 +90,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:5:5-8 })
@@ -151,7 +154,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:7:5-8 })
@@ -211,7 +217,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:9:9-10 })
@@ -339,7 +348,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:12:7-8 })
@@ -467,7 +479,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:16:3-4 })
@@ -637,7 +652,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:23:3-4 })
@@ -807,7 +825,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:28:3-8 })
@@ -844,7 +865,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:28:15-16 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:28:15-16 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:28:12-13 })
@@ -903,7 +926,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:29:15-16 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:29:15-16 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:29:12-13 })
@@ -1008,7 +1033,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:32:3-8 })
@@ -1045,7 +1073,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:33:10-11 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:33:10-11 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:33:7-8 })
@@ -1104,7 +1134,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:34:10-11 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:34:10-11 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:34:7-8 })
@@ -1221,7 +1253,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T24221.hs:38:3-8 })
@@ -1258,7 +1293,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:40:8-9 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:40:8-9 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:40:5-6 })
@@ -1317,7 +1354,9 @@
(EpaComments
[]))
(ConDeclField
- [(AddEpAnn AnnDcolon (EpaSpan { T24221.hs:42:8-9 }))]
+ (EpUniTok
+ (EpaSpan { T24221.hs:42:8-9 })
+ (NormalSyntax))
[(L
(EpAnn
(EpaSpan { T24221.hs:42:5-6 })
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -125,7 +125,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:14-17 })
@@ -150,7 +153,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:21-24 })
@@ -356,10 +362,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:11:10 })
- (EpaSpan { DumpParsedAst.hs:11:17 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:11:10 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:11:17 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:11-16 })
@@ -454,10 +461,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:11:26 })
- (EpaSpan { DumpParsedAst.hs:11:36 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:11:26 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:11:36 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:11:27-35 })
@@ -798,7 +806,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:21-23 })
@@ -826,10 +837,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:15:25 })
- (EpaSpan { DumpParsedAst.hs:15:29 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:15:25 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:15:29 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:26-28 })
@@ -968,10 +980,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:17:17 })
- (EpaSpan { DumpParsedAst.hs:17:27 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:17:17 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:17:27 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:17:18-26 })
@@ -1612,10 +1625,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:22:22 })
- (EpaSpan { DumpParsedAst.hs:22:37 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:22 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:37 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:23-36 })
@@ -1739,10 +1753,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:22:42 })
- (EpaSpan { DumpParsedAst.hs:22:52 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:42 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:22:52 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:22:43-51 })
@@ -1822,11 +1837,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { DumpParsedAst.hs:23:7-8 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -1863,10 +1879,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { DumpParsedAst.hs:23:10 })
- (EpaSpan { DumpParsedAst.hs:23:34 }))
+ ((,)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:23:10 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:23:34 })))
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:23:11-33 })
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -304,10 +304,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:11-16 })
@@ -398,10 +397,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:13:27-35 })
@@ -850,10 +848,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:23-36 })
@@ -966,10 +963,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:19:43-51 })
@@ -1079,10 +1075,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:20:11-33 })
@@ -1452,10 +1447,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:22:26-28 })
@@ -1955,10 +1949,9 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaDelta { <no location info> } (SameLine 0) [])
- (EpaDelta { <no location info> } (SameLine 0) []))
+ ((,)
+ (NoEpTok)
+ (NoEpTok))
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:24:18-26 })
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -831,10 +831,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { KindSigs.hs:22:8 })
- (EpaSpan { KindSigs.hs:22:20 }))
+ ((,)
+ (EpTok
+ (EpaSpan { KindSigs.hs:22:8 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:22:20 })))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:9-19 })
@@ -924,10 +925,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { KindSigs.hs:22:33 })
- (EpaSpan { KindSigs.hs:22:44 }))
+ ((,)
+ (EpTok
+ (EpaSpan { KindSigs.hs:22:33 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:22:44 })))
(L
(EpAnn
(EpaSpan { KindSigs.hs:22:34-43 })
@@ -1643,10 +1645,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { KindSigs.hs:34:9 })
- (EpaSpan { KindSigs.hs:34:22 }))
+ ((,)
+ (EpTok
+ (EpaSpan { KindSigs.hs:34:9 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:34:22 })))
(L
(EpAnn
(EpaSpan { KindSigs.hs:34:10-21 })
=====================================
testsuite/tests/parser/should_compile/T14189.stderr
=====================================
@@ -167,7 +167,7 @@
(EpaComments
[]))
(ConDeclField
- []
+ (NoEpUniTok)
[(L
(EpAnn
(EpaSpan { T14189.hs:6:33 })
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -116,11 +116,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T15323.hs:6:17-18 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
@@ -196,10 +197,11 @@
(EpaComments
[]))
(HsParTy
- (AnnParen
- AnnParens
- (EpaSpan { T15323.hs:6:31 })
- (EpaSpan { T15323.hs:6:36 }))
+ ((,)
+ (EpTok
+ (EpaSpan { T15323.hs:6:31 }))
+ (EpTok
+ (EpaSpan { T15323.hs:6:36 })))
(L
(EpAnn
(EpaSpan { T15323.hs:6:32-35 })
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -137,7 +137,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T20452.hs:5:26-31 })
@@ -257,7 +260,10 @@
(EpaComments
[]))
(ConDeclH98
- []
+ (AnnConDeclH98
+ (NoEpUniTok)
+ (NoEpTok)
+ (NoEpUniTok))
(L
(EpAnn
(EpaSpan { T20452.hs:6:26-31 })
=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -89,11 +89,12 @@
(EpaComments
[]))
(ConDeclGADT
- ((,)
+ (AnnConDeclGADT
+ []
+ []
(EpUniTok
(EpaSpan { T18791.hs:5:7-8 })
- (NormalSyntax))
- [])
+ (NormalSyntax)))
(:|
(L
(EpAnn
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -63,7 +63,6 @@ import Data.Data ( Data )
import Data.Dynamic
import Data.Foldable
import Data.Functor.Const
-import qualified Data.Set as Set
import Data.Typeable
import Data.List ( partition, sort, sortBy)
import qualified Data.List.NonEmpty as NE
@@ -363,11 +362,11 @@ instance HasTrailing Bool where
trailing _ = []
setTrailing a _ = a
-instance HasTrailing (EpUniToken "forall" "∀", EpUniToken "->" "→") where
+instance HasTrailing (TokForall, EpUniToken "->" "→") where
trailing _ = []
setTrailing a _ = a
-instance HasTrailing (EpUniToken "forall" "∀", EpToken ".") where
+instance HasTrailing (TokForall, EpToken ".") where
trailing _ = []
setTrailing a _ = a
@@ -646,23 +645,6 @@ flushComments !trailing_anns = do
-- ---------------------------------------------------------------------
--- |In order to interleave annotations into the stream, we turn them into
--- comments. They are removed from the annotation to avoid duplication.
-annotationsToComments :: (Monad m, Monoid w)
- => a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
-annotationsToComments a l kws = do
- let (newComments, newAnns) = go ([],[]) (view l a)
- addComments True newComments
- return (set l (reverse newAnns) a)
- where
- keywords = Set.fromList kws
-
- go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
- go acc [] = acc
- go (cs',ans) ((AddEpAnn k ss) : ls)
- | Set.member k keywords = go ((mkKWComment k (epaToNoCommentsLocation ss)):cs', ans) ls
- | otherwise = go (cs', (AddEpAnn k ss):ans) ls
-
epTokensToComments :: (Monad m, Monoid w)
=> AnnKeywordId -> [EpToken tok] -> EP w m ()
epTokensToComments kw toks
@@ -2004,14 +1986,14 @@ instance ExactPrint (DerivDecl GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (DerivDecl (mw, an) typ ms mov) = do
- an0 <- markEpAnnL an lidl AnnDeriving
+ exact (DerivDecl (mw, (td,ti)) typ ms mov) = do
+ td' <- markEpToken td
ms' <- mapM markAnnotated ms
- an1 <- markEpAnnL an0 lidl AnnInstance
+ ti' <- markEpToken ti
mw' <- mapM markAnnotated mw
mov' <- mapM markAnnotated mov
typ' <- markAnnotated typ
- return (DerivDecl (mw', an1) typ' ms' mov')
+ return (DerivDecl (mw', (td',ti')) typ' ms' mov')
-- ---------------------------------------------------------------------
@@ -2299,7 +2281,7 @@ instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where
, feqn_pats = pats
, feqn_fixity = fixity
, feqn_rhs = rhs }) = do
- (an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS ops cps [] tycon bndrs pats fixity Nothing
+ (_an0, tycon', bndrs', pats', _) <- exactHsFamInstLHS ops cps [] tycon bndrs pats fixity Nothing
eq' <- markEpToken eq
rhs' <- markAnnotated rhs
return (FamEqn { feqn_ext = ([], [], eq')
@@ -2337,14 +2319,14 @@ exactHsFamInstLHS ops cps an thing bndrs typats fixity mb_ctxt = do
exact_pats :: (Monad m, Monoid w)
=> [EpToken "("] -> [EpToken ")"] -> HsFamEqnPats GhcPs
-> EP w m ([EpToken "("], [EpToken ")"], LocatedN RdrName, HsFamEqnPats GhcPs)
- exact_pats ops cps (patl:patr:pats)
+ exact_pats ops1 cps1 (patl:patr:pats)
| Infix <- fixity
= let exact_op_app = do
- ops' <- mapM markEpToken ops
+ ops' <- mapM markEpToken ops1
patl' <- markAnnotated patl
thing' <- markAnnotated thing
patr' <- markAnnotated patr
- cps' <- mapM markEpToken cps
+ cps' <- mapM markEpToken cps1
return (ops', cps', thing', [patl',patr'])
in case pats of
[] -> exact_op_app
@@ -4121,11 +4103,11 @@ instance ExactPrint (HsType GhcPs) where
lo' <- markAnnotated lo
t2' <- markAnnotated t2
return (HsOpTy x promoted t1' lo' t2')
- exact (HsParTy an ty) = do
- an0 <- markOpeningParen an
+ exact (HsParTy (o,c) ty) = do
+ o' <- markEpToken o
ty' <- markAnnotated ty
- an1 <- markClosingParen an0
- return (HsParTy an1 ty')
+ c' <- markEpToken c
+ return (HsParTy (o',c') ty')
exact (HsIParamTy an n t) = do
n' <- markAnnotated n
an0 <- markEpUniToken an
@@ -4216,7 +4198,7 @@ instance ExactPrint (HsDerivingClause GhcPs) where
exact (HsDerivingClause { deriv_clause_ext = an
, deriv_clause_strategy = dcs
, deriv_clause_tys = dct }) = do
- an0 <- markEpAnnL an lidl AnnDeriving
+ an0 <- markEpToken an
dcs0 <- case dcs of
Just (L _ ViaStrategy{}) -> return dcs
_ -> mapM markAnnotated dcs
@@ -4235,16 +4217,16 @@ instance ExactPrint (DerivStrategy GhcPs) where
setAnnotationAnchor a _ _ _ = a
exact (StockStrategy an) = do
- an0 <- markEpAnnL an lid AnnStock
+ an0 <- markEpToken an
return (StockStrategy an0)
exact (AnyclassStrategy an) = do
- an0 <- markEpAnnL an lid AnnAnyclass
+ an0 <- markEpToken an
return (AnyclassStrategy an0)
exact (NewtypeStrategy an) = do
- an0 <- markEpAnnL an lid AnnNewtype
+ an0 <- markEpToken an
return (NewtypeStrategy an0)
exact (ViaStrategy (XViaStrategyPs an ty)) = do
- an0 <- markEpAnnL an lid AnnVia
+ an0 <- markEpToken an
ty' <- markAnnotated ty
return (ViaStrategy (XViaStrategyPs an0 ty'))
@@ -4411,27 +4393,27 @@ instance ExactPrint (ConDecl GhcPs) where
setAnnotationAnchor a _ _ _ = a
-- based on pprConDecl
- exact (ConDeclH98 { con_ext = an
+ exact (ConDeclH98 { con_ext = AnnConDeclH98 tforall tdot tdarrow
, con_name = con
, con_forall = has_forall
, con_ex_tvs = ex_tvs
, con_mb_cxt = mcxt
, con_args = args
, con_doc = doc }) = do
- an0 <- if has_forall
- then markEpAnnL an lidl AnnForall
- else return an
+ tforall' <- if has_forall
+ then markEpUniToken tforall
+ else return tforall
ex_tvs' <- mapM markAnnotated ex_tvs
- an1 <- if has_forall
- then markEpAnnL an0 lidl AnnDot
- else return an0
+ tdot' <- if has_forall
+ then markEpToken tdot
+ else return tdot
mcxt' <- mapM markAnnotated mcxt
- an2 <- if (isJust mcxt)
- then markEpAnnL an1 lidl AnnDarrow
- else return an1
+ tdarrow' <- if (isJust mcxt)
+ then markEpUniToken tdarrow
+ else return tdarrow
(con', args') <- exact_details args
- return (ConDeclH98 { con_ext = an2
+ return (ConDeclH98 { con_ext = AnnConDeclH98 tforall' tdot' tdarrow'
, con_name = con'
, con_forall = has_forall
, con_ex_tvs = ex_tvs'
@@ -4459,14 +4441,15 @@ instance ExactPrint (ConDecl GhcPs) where
-- -----------------------------------
- exact (ConDeclGADT { con_g_ext = (dcol, an)
+ exact (ConDeclGADT { con_g_ext = AnnConDeclGADT ops cps dcol
, con_names = cons
, 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' <- markEpUniToken dcol
- an1 <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]
+ epTokensToComments AnnOpenP ops
+ epTokensToComments AnnCloseP cps
-- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/20558
bndrs' <- case bndrs of
@@ -4474,9 +4457,6 @@ instance ExactPrint (ConDecl GhcPs) where
_ -> markAnnotated bndrs
mcxt' <- mapM markAnnotated mcxt
- an2 <- if (isJust mcxt)
- then markEpAnnL an1 lidl AnnDarrow
- else return an1
args' <-
case args of
(PrefixConGADT x args0) -> do
@@ -4487,7 +4467,7 @@ instance ExactPrint (ConDecl GhcPs) where
rarr' <- markEpUniToken rarr
return (RecConGADT rarr' fields')
res_ty' <- markAnnotated res_ty
- return (ConDeclGADT { con_g_ext = (dcol', an2)
+ return (ConDeclGADT { con_g_ext = AnnConDeclGADT [] [] dcol'
, con_names = cons'
, con_bndrs = bndrs'
, con_mb_cxt = mcxt', con_g_args = args'
@@ -4522,11 +4502,11 @@ instance ExactPrint (ConDeclField GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (ConDeclField an names ftype mdoc) = do
+ exact (ConDeclField td names ftype mdoc) = do
names' <- markAnnotated names
- an0 <- markEpAnnL an lidl AnnDcolon
+ td' <- markEpUniToken td
ftype' <- markAnnotated ftype
- return (ConDeclField an0 names' ftype' mdoc)
+ return (ConDeclField td' names' ftype' mdoc)
-- ---------------------------------------------------------------------
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
@@ -820,7 +821,7 @@ type instance Anno (HsOuterTyVarBndrs Specificity DocNameI) = SrcSpanAnnA
type instance Anno (HsSigType DocNameI) = SrcSpanAnnA
type XRecCond a =
- ( XParTy a ~ AnnParen
+ ( XParTy a ~ (EpToken "(", EpToken ")")
, NoGhcTc a ~ a
, MapXRec a
, UnXRec a
@@ -852,7 +853,7 @@ type instance XListTy DocNameI = EpAnn AnnParen
type instance XTupleTy DocNameI = EpAnn AnnParen
type instance XSumTy DocNameI = EpAnn AnnParen
type instance XOpTy DocNameI = EpAnn [AddEpAnn]
-type instance XParTy DocNameI = AnnParen
+type instance XParTy DocNameI = (EpToken "(", EpToken ")")
type instance XIParamTy DocNameI = EpAnn [AddEpAnn]
type instance XKindSig DocNameI = EpAnn [AddEpAnn]
type instance XSpliceTy DocNameI = DataConCantHappen
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/395c02ad803917d011050115cf9c152c05c0a58f...e44633ef60d86e33784e8198373f768d89e1882a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/395c02ad803917d011050115cf9c152c05c0a58f...e44633ef60d86e33784e8198373f768d89e1882a
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/20241019/94ce2505/attachment-0001.html>
More information about the ghc-commits
mailing list