[Git][ghc/ghc][wip/az/epa-last-eptokens] EPA: Bring in last EpToken usages
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Wed Oct 30 18:26:26 UTC 2024
Alan Zimmerman pushed to branch wip/az/epa-last-eptokens at Glasgow Haskell Compiler / GHC
Commits:
8b183191 by Alan Zimmerman at 2024-10-30T18:26:07+00:00
EPA: Bring in last EpToken usages
For import declarations, NameAnnCommas and NPlusKPat.
And remove anchor, it is the same as epaLocationRealSrcSpan.
- - - - -
19 changed files:
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Names.hs
- testsuite/tests/simplCore/should_compile/T23864.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Types.hs
- utils/check-exact/Utils.hs
- utils/check-ppr/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
Changes:
=====================================
compiler/GHC/Hs/ImpExp.hs
=====================================
@@ -194,9 +194,9 @@ instance (OutputableBndrId p
-}
type instance XIEName (GhcPass _) = NoExtField
-type instance XIEDefault (GhcPass _) = EpaLocation
-type instance XIEPattern (GhcPass _) = EpaLocation
-type instance XIEType (GhcPass _) = EpaLocation
+type instance XIEDefault (GhcPass _) = EpToken "default"
+type instance XIEPattern (GhcPass _) = EpToken "pattern"
+type instance XIEType (GhcPass _) = EpToken "type"
type instance XXIEWrappedName (GhcPass _) = DataConCantHappen
type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -158,7 +158,7 @@ type instance XNPat GhcPs = EpToken "-"
type instance XNPat GhcRn = EpToken "-"
type instance XNPat GhcTc = Type
-type instance XNPlusKPat GhcPs = EpaLocation -- Of the "+"
+type instance XNPlusKPat GhcPs = EpToken "+"
type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -340,7 +340,7 @@ mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpToken "-"
-> Pat GhcPs
-mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation
+mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpToken "+"
-> Pat GhcPs
-- NB: The following functions all use noSyntaxExpr: the generated expressions
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1040,9 +1040,9 @@ export :: { LIE GhcPs }
; locImpExp <- return (sL span (IEModuleContents ($1, (epTok $2)) $3))
; return $ reLoc $ locImpExp } }
| maybe_warning_pragma 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $>
- in reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glR $2) $3)) Nothing }
+ in reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (epTok $2) $3)) Nothing }
| maybe_warning_pragma 'default' qtycon {% do { let { span = (maybe comb2 comb3 $1) $2 $> }
- ; locImpExp <- return (sL span (IEThingAbs $1 (sLLa $2 $> (IEDefault (glR $2) $3)) Nothing))
+ ; locImpExp <- return (sL span (IEThingAbs $1 (sLLa $2 $> (IEDefault (epTok $2) $3)) Nothing))
; return $ reLoc $ locImpExp } }
@@ -1076,7 +1076,7 @@ qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec }
qcname_ext :: { LocatedA ImpExpQcSpec }
: qcname { sL1a $1 (ImpExpQcName $1) }
| 'type' oqtycon {% do { n <- mkTypeImpExp $2
- ; return $ sLLa $1 $> (ImpExpQcType (glR $1) n) }}
+ ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }}
qcname :: { LocatedN RdrName } -- Variable or type constructor
: qvar { $1 } -- Things which look like functions
@@ -1209,7 +1209,7 @@ importlist1 :: { OrdList (LIE GhcPs) }
import :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% fmap (unitOL . reLoc . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }
| 'module' modid {% fmap (unitOL . reLoc) $ return (sLL $1 $> (IEModuleContents (Nothing, (epTok $1)) $2)) }
- | 'pattern' qcon { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glR $1) $2)) Nothing }
+ | 'pattern' qcon { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (epTok $1) $2)) Nothing }
-----------------------------------------------------------------------------
-- Fixity Declarations
@@ -3776,10 +3776,10 @@ qcon_list : qcon { [$1] }
-- See Note [ExplicitTuple] in GHC.Hs.Expr
sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors
: '(' commas ')' {% amsr (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1))
- (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }
+ (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }
| '(#' '#)' {% amsr (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly (NameParensHash (epTok $1) (epTok $2)) []) }
| '(#' commas '#)' {% amsr (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1))
- (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }
+ (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }
syscon :: { LocatedN RdrName }
: sysdcon { L (getLoc $1) $ nameRdrName (dataConName (unLoc $1)) }
@@ -3820,9 +3820,9 @@ gtycon :: { LocatedN RdrName } -- A "general" qualified tycon, including unit t
ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit tuples
: oqtycon { $1 }
| '(' commas ')' {% do { n <- mkTupleSyntaxTycon Boxed (snd $2 + 1)
- ; amsr (sLL $1 $> n) (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }}
+ ; amsr (sLL $1 $> n) (NameAnnCommas (NameParens (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }}
| '(#' commas '#)' {% do { n <- mkTupleSyntaxTycon Unboxed (snd $2 + 1)
- ; amsr (sLL $1 $> n) (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }}
+ ; amsr (sLL $1 $> n) (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map (EpTok . srcSpan2e) (fst $2)) []) }}
| '(#' bars '#)' {% do { requireLTPuns PEP_SumSyntaxType $1 $>
; amsr (sLL $1 $> $ (getRdrName (sumTyCon (snd $2 + 1))))
(NameAnnBars (epTok $1, epTok $3) (fst $2) []) } }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -23,7 +23,6 @@ module GHC.Parser.Annotation (
DeltaPos(..), deltaPos, getDeltaLine,
EpAnn(..),
- anchor,
spanAsAnchor, realSpanAsAnchor,
noSpanAnchor,
NoAnn(..),
@@ -350,7 +349,7 @@ instance Outputable a => Outputable (GenLocated TokenLocation a) where
-- | Used in the parser only, extract the 'RealSrcSpan' from an
-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the
-- partial function is safe.
-epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
+epaLocationRealSrcSpan :: EpaLocation' a -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r
epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan"
@@ -401,9 +400,6 @@ data EpAnn ann
deriving (Data, Eq, Functor)
-- See Note [XRec and Anno in the AST]
-anchor :: (EpaLocation' a) -> RealSrcSpan
-anchor (EpaSpan (RealSrcSpan r _)) = r
-anchor _ = panic "anchor"
spanAsAnchor :: SrcSpan -> (EpaLocation' a)
spanAsAnchor ss = EpaSpan ss
@@ -602,7 +598,7 @@ data NameAnn
-- | Used for @(,,,)@, or @(#,,,#)@
| NameAnnCommas {
nann_adornment :: NameAdornment,
- nann_commas :: [EpaLocation],
+ nann_commas :: [EpToken ","],
nann_trailing :: [TrailingAnn]
}
-- | Used for @(# | | #)@
@@ -641,10 +637,10 @@ data NameAnn
-- such as parens or backquotes. This data type identifies what
-- particular pair are being used.
data NameAdornment
- = NameParens (EpToken "(") (EpToken ")") -- ^ '(' ')'
- | NameParensHash (EpToken "(#") (EpToken "#)")-- ^ '(#' '#)'
- | NameBackquotes (EpToken "`") (EpToken "`")-- ^ '`'
- | NameSquare (EpToken "[") (EpToken "]")-- ^ '[' ']'
+ = NameParens (EpToken "(") (EpToken ")")
+ | NameParensHash (EpToken "(#") (EpToken "#)")
+ | NameBackquotes (EpToken "`") (EpToken "`")
+ | NameSquare (EpToken "[") (EpToken "]")
| NameNoAdornment
deriving (Eq, Data)
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3672,8 +3672,8 @@ allocateComments
-> ([LEpaComment], [LEpaComment])
allocateComments ss comment_q =
let
- (before,rest) = break (\(L l _) -> isRealSubspanOf (anchor l) ss) comment_q
- (middle,after) = break (\(L l _) -> not (isRealSubspanOf (anchor l) ss)) rest
+ (before,rest) = break (\(L l _) -> isRealSubspanOf (epaLocationRealSrcSpan l) ss) comment_q
+ (middle,after) = break (\(L l _) -> not (isRealSubspanOf (epaLocationRealSrcSpan l) ss)) rest
comment_q' = before ++ after
newAnns = middle
in
@@ -3691,14 +3691,14 @@ splitPriorComments ss prior_comments =
-- And the token preceding the comment is on a different line
cmp :: RealSrcSpan -> LEpaComment -> Bool
cmp later (L l c)
- = srcSpanStartLine later - srcSpanEndLine (anchor l) == 1
- && srcSpanEndLine (ac_prior_tok c) /= srcSpanStartLine (anchor l)
+ = srcSpanStartLine later - srcSpanEndLine (epaLocationRealSrcSpan l) == 1
+ && srcSpanEndLine (ac_prior_tok c) /= srcSpanStartLine (epaLocationRealSrcSpan l)
go :: [LEpaComment] -> RealSrcSpan -> [LEpaComment]
-> ([LEpaComment], [LEpaComment])
go decl_comments _ [] = ([],decl_comments)
go decl_comments r (c@(L l _):cs) = if cmp r c
- then go (c:decl_comments) (anchor l) cs
+ then go (c:decl_comments) (epaLocationRealSrcSpan l) cs
else (reverse (c:cs), decl_comments)
in
go [] ss prior_comments
@@ -3710,7 +3710,7 @@ allocatePriorComments
-> (Strict.Maybe [LEpaComment], [LEpaComment], [LEpaComment])
allocatePriorComments ss comment_q mheader_comments =
let
- cmp (L l _) = anchor l <= ss
+ cmp (L l _) = epaLocationRealSrcSpan l <= ss
(newAnns,after) = partition cmp comment_q
comment_q'= after
(prior_comments, decl_comments) = splitPriorComments ss newAnns
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1312,7 +1312,7 @@ checkAPat loc e0 = do
_
| nPlusKPatterns && (plus == plus_RDR)
-> return (mkNPlusKPat (L nloc n) (L (l2l lloc) lit)
- (entry l))
+ (EpTok $ entry l))
-- Improve error messages for the @-operator when the user meant an @-pattern
PatBuilderOpApp _ op _ _ | opIsAt (unLoc op) -> do
@@ -3158,7 +3158,7 @@ data ImpExpSubSpec = ImpExpAbs
| ImpExpAllWith [LocatedA ImpExpQcSpec]
data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
- | ImpExpQcType EpaLocation (LocatedN RdrName)
+ | ImpExpQcType (EpToken "type") (LocatedN RdrName)
| ImpExpQcWildcard (EpToken "..") (EpToken ",")
mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -2107,13 +2107,13 @@ printMinimalImports hsc_src imports_w_usage
to_ie_post_rn_var :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn_var (L l n)
- | isDataOcc $ occName n = L l (IEPattern (entry l) (L (l2l l) n))
+ | isDataOcc $ occName n = L l (IEPattern noAnn (L (l2l l) n))
| otherwise = L l (IEName noExtField (L (l2l l) n))
to_ie_post_rn :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn
to_ie_post_rn (L l n)
- | isTcOcc occ && isSymOcc occ = L l (IEType (entry l) (L (l2l l) n))
+ | isTcOcc occ && isSymOcc occ = L l (IEType noAnn (L (l2l l) n))
| otherwise = L l (IEName noExtField (L (l2l l) n))
where occ = occName n
=====================================
testsuite/tests/simplCore/should_compile/T23864.hs
=====================================
@@ -49,7 +49,7 @@ insertCommentsByPos ::
-> (EpAnnComments -> [LEpaComment] -> EpAnnComments)
-> EpAnn a
-> WithComments (EpAnn a)
-insertCommentsByPos cond = insertComments (cond . anchor . getLoc)
+insertCommentsByPos cond = insertComments (cond . epaLocationRealSrcSpan . getLoc)
insertComments ::
(LEpaComment -> Bool)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -570,7 +570,7 @@ splitAfterTrailingAnns tas cs = (before, after)
(s:_) -> (b,a)
where
s_pos = ss2pos s
- (b,a) = break (\(L ll _) -> (ss2pos $ anchor ll) > s_pos)
+ (b,a) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > s_pos)
cs
-- ---------------------------------------------------------------------
@@ -731,12 +731,6 @@ printStringAtNC el str = do
el' <- printStringAtAAC NoCaptureComments (noCommentsToEpaLocation el) str
return (epaToNoCommentsLocation el')
-printStringAtAAL :: (Monad m, Monoid w)
- => a -> Lens a EpaLocation -> String -> EP w m a
-printStringAtAAL an l str = do
- r <- printStringAtAAC CaptureComments (view l an) str
- return (set l r an)
-
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
printStringAtAAC capture (EpaSpan (RealSrcSpan r _)) s = printStringAtRsC capture r s
@@ -1020,10 +1014,6 @@ lal_rest k parent = fmap (\new -> parent { al_rest = new })
-- -------------------------------------
-lid :: Lens a a
-lid k parent = fmap (\new -> new)
- (k parent)
-
lfst :: Lens (a,b) a
lfst k parent = fmap (\new -> (new, snd parent))
(k (fst parent))
@@ -4186,7 +4176,7 @@ instance ExactPrint (LocatedN RdrName) where
_ -> error "ExactPrint (LocatedN RdrName)"
NameAnnCommas a commas t -> do
a0 <- markNameAdornmentO a
- commas' <- forM commas (\loc -> printStringAtAAC NoCaptureComments loc ",")
+ commas' <- forM commas markEpToken
a1 <- markNameAdornmentC a0
return (NameAnnCommas a1 commas' t)
NameAnnBars (o,c) bars t -> do
@@ -4247,7 +4237,7 @@ printUnicode :: (Monad m, Monoid w) => EpaLocation -> RdrName -> EP w m EpaLocat
printUnicode anc n = do
let str = case (showPprUnsafe n) of
-- TODO: unicode support?
- "forall" -> if spanLength (anchor anc) == 1 then "∀" else "forall"
+ "forall" -> if spanLength (epaLocationRealSrcSpan anc) == 1 then "∀" else "forall"
s -> s
loc <- printStringAtAAC NoCaptureComments (EpaDelta noSrcSpan (SameLine 0) []) str
case loc of
@@ -4617,15 +4607,15 @@ instance ExactPrint (IEWrappedName GhcPs) where
n' <- markAnnotated n
return (IEName x n')
exact (IEDefault r n) = do
- r' <- printStringAtAA r "default"
+ r' <- markEpToken r
n' <- markAnnotated n
return (IEDefault r' n')
exact (IEPattern r n) = do
- r' <- printStringAtAA r "pattern"
+ r' <- markEpToken r
n' <- markAnnotated n
return (IEPattern r' n')
exact (IEType r n) = do
- r' <- printStringAtAA r "type"
+ r' <- markEpToken r
n' <- markAnnotated n
return (IEType r' n')
@@ -4715,7 +4705,7 @@ instance ExactPrint (Pat GhcPs) where
exact (NPlusKPat an n k lit2 a b) = do
n' <- markAnnotated n
- an' <- printStringAtAAL an lid "+"
+ an' <- markEpToken an
k' <- markAnnotated k
return (NPlusKPat an' n' k' lit2 a b)
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -289,7 +289,8 @@ fixModuleTrailingComments (GHC.L l p) = GHC.L l p'
let
pc = GHC.priorComments cs
fc = GHC.getFollowingComments cs
- bf (GHC.L anc _) = GHC.anchor anc > ss
+ bf (GHC.L anc _) = GHC.epaLocationRealSrcSpan anc > ss
+
(prior,f) = break bf fc
cs'' = GHC.EpaCommentsBalanced (pc <> prior) f
in cs''
@@ -310,7 +311,7 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
-- Move any comments on the decl that occur prior to the location
pc = GHC.priorComments csd
fc = GHC.getFollowingComments csd
- bf (GHC.L anch _) = GHC.anchor anch > r
+ bf (GHC.L anch _) = GHC.epaLocationRealSrcSpan anch > r
(move,keep) = break bf pc
csd' = GHC.EpaCommentsBalanced keep fc
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -211,7 +211,7 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (AnnSig (EpUniTok dca u) mp md) ns (
-- we want DPs for the distance from the end of the ns to the
-- AnnDColon, and to the start of the ty
rd = case last ns of
- L (EpAnn anc' _ _) _ -> anchor anc'
+ L (EpAnn anc' _ _) _ -> epaLocationRealSrcSpan anc'
dca' = case dca of
EpaSpan ss@(RealSrcSpan r _) -> (EpaDelta ss (ss2delta (ss2posEnd rd) r) [])
_ -> dca
@@ -298,7 +298,7 @@ setEntryDP (L (EpAnn (EpaSpan ss@(RealSrcSpan r _)) an cs) a) dp
col = deltaColumn delta
edp' = if line == 0 then SameLine col
else DifferentLine line col
- edp = edp' `debug` ("setEntryDP :" ++ showGhc (edp', (ss2pos $ anchor $ getLoc lc), r))
+ edp = edp' `debug` ("setEntryDP :" ++ showGhc (edp', (ss2pos $ epaLocationRealSrcSpan $ getLoc lc), r))
-- ---------------------------------------------------------------------
@@ -552,12 +552,12 @@ trailingCommentsDeltas _ [] = []
trailingCommentsDeltas r (la@(L (EpaDelta _ dp _) _):las)
= (getDeltaLine dp, la): trailingCommentsDeltas r las
trailingCommentsDeltas r (la@(L l _):las)
- = deltaComment r la : trailingCommentsDeltas (anchor l) las
+ = deltaComment r la : trailingCommentsDeltas (epaLocationRealSrcSpan l) las
where
deltaComment rs' (L loc c) = (abs(ll - al), L loc c)
where
(al,_) = ss2posEnd rs'
- (ll,_) = ss2pos (anchor loc)
+ (ll,_) = ss2pos (epaLocationRealSrcSpan loc)
priorCommentsDeltas :: RealSrcSpan -> [LEpaComment]
-> [(Int, LEpaComment)]
@@ -565,14 +565,14 @@ priorCommentsDeltas r cs = go r (sortEpaComments cs)
where
go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go _ [] = []
- go _ (la@(L l@(EpaDelta _ dp _) _):las) = (getDeltaLine dp, la) : go (anchor l) las
- go rs' (la@(L l _):las) = deltaComment rs' la : go (anchor l) las
+ go _ (la@(L l@(EpaDelta _ dp _) _):las) = (getDeltaLine dp, la) : go (epaLocationRealSrcSpan l) las
+ go rs' (la@(L l _):las) = deltaComment rs' la : go (epaLocationRealSrcSpan l) las
deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment rs' (L loc c) = (abs(ll - al), L loc c)
where
(al,_) = ss2pos rs'
- (ll,_) = ss2pos (anchor loc)
+ (ll,_) = ss2pos (epaLocationRealSrcSpan loc)
-- ---------------------------------------------------------------------
@@ -664,14 +664,14 @@ addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs)
-- TODO: this is replicating functionality in ExactPrint. Sort out the
-- import loop`
anchorFromLocatedA :: LocatedA a -> RealSrcSpan
-anchorFromLocatedA (L (EpAnn anc _ _) _) = anchor anc
+anchorFromLocatedA (L (EpAnn anc _ _) _) = epaLocationRealSrcSpan anc
-- | Get the full span of interest for comments from a LocatedA.
-- This extends up to the last TrailingAnn
fullSpanFromLocatedA :: LocatedA a -> RealSrcSpan
fullSpanFromLocatedA (L (EpAnn anc (AnnListItem tas) _) _) = rr
where
- r = anchor anc
+ r = epaLocationRealSrcSpan anc
trailing_loc ta = case ta_location ta of
EpaSpan (RealSrcSpan s _) -> [s]
_ -> []
@@ -695,7 +695,7 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb)))
(csp,csf) = case anc1 of
EpaComments cs -> ([],cs)
EpaCommentsBalanced p f -> (p,f)
- (move',stay') = break (simpleBreak 0) (trailingCommentsDeltas (anchor anc) csf)
+ (move',stay') = break (simpleBreak 0) (trailingCommentsDeltas (epaLocationRealSrcSpan anc) csf)
move = map snd move'
stay = map snd stay'
cs1 = epaCommentsBalanced csp stay
=====================================
utils/check-exact/Types.hs
=====================================
@@ -8,8 +8,7 @@
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
-module Types
- where
+module Types where
import GHC hiding (EpaComment)
import GHC.Utils.Outputable hiding ( (<>) )
@@ -41,7 +40,7 @@ instance Ord Comment where
-- When we have CPP injected comments with a fake filename, or LINE
-- pragma, the file name changes, so we need to compare the
-- locations only, with out the filename.
- compare (Comment _ ss1 _ _) (Comment _ ss2 _ _) = compare (ss2pos $ anchor ss1) (ss2pos $ anchor ss2)
+ compare (Comment _ ss1 _ _) (Comment _ ss2 _ _) = compare (ss2pos $ epaLocationRealSrcSpan ss1) (ss2pos $ epaLocationRealSrcSpan ss2)
where
ss2pos ss = (srcSpanStartLine ss,srcSpanStartCol ss)
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -268,7 +268,7 @@ workInComments ocs new = cs'
(sortEpaComments $ fc ++ cs_after)
where
(cs_before,cs_after)
- = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ anchor ac) )
+ = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) )
new
insertTopLevelCppComments :: HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs, [LEpaComment])
@@ -292,7 +292,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
(an1,cs0a) = case lo of
EpExplicitBraces (EpTok (EpaSpan (RealSrcSpan s _))) _close ->
let
- (stay,cs0a') = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ s)) cs0
+ (stay,cs0a') = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ s)) cs0
cs' = workInComments (comments an0) stay
in (an0 { comments = cs' }, cs0a')
_ -> (an0,cs0)
@@ -300,7 +300,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
(an2, cs0b) = case am_decls $ anns an1 of
(AddSemiAnn (EpTok (EpaSpan (RealSrcSpan s _))):_) -> (an1 {comments = cs'}, cs0b')
where
- (stay,cs0b') = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ s)) cs0a
+ (stay,cs0b') = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ s)) cs0a
cs' = workInComments (comments an1) stay
_ -> (an1,cs0a)
@@ -314,7 +314,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
(csh', cs0b') = case annListBracketsLocs $ al_brackets $ anns l of
(EpaSpan (RealSrcSpan s _),_) ->(h, n)
where
- (h,n) = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) )
+ (h,n) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) )
cs0b
_ -> ([], cs0b)
@@ -361,7 +361,7 @@ splitOnWhere w (EpTok (EpaSpan (RealSrcSpan s _))) csIn = (hc, fc)
where
splitFunc Before anc_pos c_pos = c_pos < anc_pos
splitFunc After anc_pos c_pos = anc_pos < c_pos
- (hc,fc) = break (\(L ll _) -> splitFunc w (ss2pos $ anchor ll) (ss2pos s)) csIn
+ (hc,fc) = break (\(L ll _) -> splitFunc w (ss2pos $ epaLocationRealSrcSpan ll) (ss2pos s)) csIn
splitOnWhere _ _ csIn = (csIn,[])
balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])
@@ -372,7 +372,7 @@ balanceFirstLocatedAComments ((L (EpAnn anc an csd) a):ds) = (L (EpAnn anc an cs
EpaSpan (RealSrcSpan s _) -> (csd', hc)
`debug` ("balanceFirstLocatedAComments: (csd,csd',attached,header)=" ++ showAst (csd,csd',attached,header))
where
- (priors, inners) = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) )
+ (priors, inners) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos s) )
(priorComments csd)
pcds = priorCommentsDeltas' s priors
(attached, header) = break (\(d,_c) -> d /= 1) pcds
@@ -388,14 +388,14 @@ priorCommentsDeltas' r cs = go r (reverse cs)
where
go :: RealSrcSpan -> [LEpaComment] -> [(Int, LEpaComment)]
go _ [] = []
- go _ (la@(L l@(EpaDelta _ dp _) _):las) = (getDeltaLine dp, la) : go (anchor l) las
- go rs' (la@(L l _):las) = deltaComment rs' la : go (anchor l) las
+ go _ (la@(L l@(EpaDelta _ dp _) _):las) = (getDeltaLine dp, la) : go (epaLocationRealSrcSpan l) las
+ go rs' (la@(L l _):las) = deltaComment rs' la : go (epaLocationRealSrcSpan l) las
deltaComment :: RealSrcSpan -> LEpaComment -> (Int, LEpaComment)
deltaComment rs' (L loc c) = (abs(ll - al), L loc c)
where
(al,_) = ss2pos rs'
- (ll,_) = ss2pos (anchor loc)
+ (ll,_) = ss2pos (epaLocationRealSrcSpan loc)
allocatePriorComments
:: Pos
@@ -403,7 +403,7 @@ allocatePriorComments
-> ([LEpaComment], [LEpaComment])
allocatePriorComments ss_loc comment_q =
let
- cmp (L l _) = ss2pos (anchor l) <= ss_loc
+ cmp (L l _) = ss2pos (epaLocationRealSrcSpan l) <= ss_loc
(newAnns,after) = partition cmp comment_q
in
(after, newAnns)
@@ -420,7 +420,7 @@ insertRemainingCppComments (L l p) cs = L l p'
EpTok (EpaSpan (RealSrcSpan s _)) -> ss2pos s
_ -> (1,1)
_ -> (1,1)
- (new_before, new_after) = break (\(L ll _) -> (ss2pos $ anchor ll) > end_loc ) cs
+ (new_before, new_after) = break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > end_loc ) cs
addTrailingComments end_loc' cur new = epaCommentsBalanced pc' fc'
where
@@ -431,8 +431,8 @@ insertRemainingCppComments (L l p) cs = L l p'
(L ac _:_) -> (sortEpaComments $ pc ++ cs_before, sortEpaComments $ fc ++ cs_after)
where
(cs_before,cs_after)
- = if (ss2pos $ anchor ac) > end_loc'
- then break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos $ anchor ac) ) new
+ = if (ss2pos $ epaLocationRealSrcSpan ac) > end_loc'
+ then break (\(L ll _) -> (ss2pos $ epaLocationRealSrcSpan ll) > (ss2pos $ epaLocationRealSrcSpan ac) ) new
else (new_before, new_after)
-- ---------------------------------------------------------------------
@@ -513,7 +513,7 @@ normaliseCommentText (x:xs) = x:normaliseCommentText xs
-- |Must compare without span filenames, for CPP injected comments with fake filename
cmpComments :: Comment -> Comment -> Ordering
-cmpComments (Comment _ l1 _ _) (Comment _ l2 _ _) = compare (ss2pos $ anchor l1) (ss2pos $ anchor l2)
+cmpComments (Comment _ l1 _ _) (Comment _ l2 _ _) = compare (ss2pos $ epaLocationRealSrcSpan l1) (ss2pos $ epaLocationRealSrcSpan l2)
-- |Sort, comparing without span filenames, for CPP injected comments with fake filename
sortComments :: [Comment] -> [Comment]
@@ -523,7 +523,7 @@ sortComments cs = sortBy cmpComments cs
sortEpaComments :: [LEpaComment] -> [LEpaComment]
sortEpaComments cs = sortBy cmp cs
where
- cmp (L l1 _) (L l2 _) = compare (ss2pos $ anchor l1) (ss2pos $ anchor l2)
+ cmp (L l1 _) (L l2 _) = compare (ss2pos $ epaLocationRealSrcSpan l1) (ss2pos $ epaLocationRealSrcSpan l2)
-- | Makes a comment which originates from a specific keyword.
mkKWComment :: String -> NoCommentsLocation -> Comment
@@ -532,7 +532,7 @@ mkKWComment kw (EpaSpan (UnhelpfulSpan _)) = Comment kw (EpaDelta noSrcSpan (S
mkKWComment kw (EpaDelta ss dp cs) = Comment kw (EpaDelta ss dp cs) placeholderRealSpan (Just kw)
sortAnchorLocated :: [GenLocated EpaLocation a] -> [GenLocated EpaLocation a]
-sortAnchorLocated = sortBy (compare `on` (anchor . getLoc))
+sortAnchorLocated = sortBy (compare `on` (epaLocationRealSrcSpan . getLoc))
-- | Calculates the distance from the start of a string to the end of
-- a string.
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -97,7 +97,7 @@ getPragmas (L _ (HsModule { hsmodExt = XModulePs { hsmodAnn = anns' } })) = prag
tokComment (L _ (EpaComment (EpaLineComment s) _)) = s
tokComment _ = ""
- cmp (L l1 _) (L l2 _) = compare (anchor l1) (anchor l2)
+ cmp (L l1 _) (L l2 _) = compare (epaLocationRealSrcSpan l1) (epaLocationRealSrcSpan l2)
comments' = map tokComment $ sortBy cmp $ priorComments $ epAnnComments anns'
pragmas = filter (\c -> isPrefixOf "{-#" c ) comments'
pragmaStr = intercalate "\n" pragmas
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
=====================================
@@ -41,7 +41,7 @@ import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Ord (comparing)
import qualified Data.Set as Set hiding (Set)
-import GHC hiding (LexicalFixity (..), NoLink, anchor, moduleInfo)
+import GHC hiding (LexicalFixity (..), NoLink, moduleInfo)
import GHC.Types.Name
import GHC.Unit.State
import System.Directory
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
=====================================
@@ -24,7 +24,7 @@ module Haddock.Backends.Xhtml.DocMarkup
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
-import GHC hiding (anchor)
+import GHC
import GHC.Types.Name
import Text.XHtml hiding (name, p, quote)
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
=====================================
@@ -54,7 +54,7 @@ module Haddock.Backends.Xhtml.Layout
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
-import GHC hiding (anchor)
+import GHC
import GHC.Types.Name (nameOccName)
import Text.XHtml hiding (name, quote, title)
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
=====================================
@@ -31,7 +31,7 @@ module Haddock.Backends.Xhtml.Names
) where
import Data.List (stripPrefix)
-import GHC hiding (LexicalFixity (..), anchor)
+import GHC hiding (LexicalFixity (..))
import GHC.Data.FastString (unpackFS)
import GHC.Types.Name
import GHC.Types.Name.Reader
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b183191be1bf2488a6924758de025c131f9458f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b183191be1bf2488a6924758de025c131f9458f
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/20241030/8e8c7655/attachment-0001.html>
More information about the ghc-commits
mailing list