[Git][ghc/ghc][wip/az/T20372-noann-not-monoid] EPA: Replace Monoid with NoAnn
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Sep 24 16:56:46 UTC 2023
Alan Zimmerman pushed to branch wip/az/T20372-noann-not-monoid at Glasgow Haskell Compiler / GHC
Commits:
7a28864c by Alan Zimmerman at 2023-09-24T17:56:30+01:00
EPA: Replace Monoid with NoAnn
We currently use the Monoid class as a constraint on Exact Print
Annotation functions, so we can use mempty. But this leads to
requiring Semigroup instances too, which do not always make sense.
Instead, introduce a class NoAnn, with a function noAnn analogous to
mempty.
Closes #20372
- - - - -
7 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- utils/check-exact/Main.hs
- utils/check-exact/Orphans.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Parser.y
=====================================
@@ -4442,13 +4442,13 @@ parseModule = parseModuleNoHaddock >>= addHaddockToModule
parseSignature :: P (Located (HsModule GhcPs))
parseSignature = parseSignatureNoHaddock >>= addHaddockToModule
-commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann)
-commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc
+commentsA :: (NoAnn ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann)
+commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) noAnn cs) loc
-- | Instead of getting the *enclosed* comments, this includes the
-- *preceding* ones. It is used at the top level to get comments
-- between top level declarations.
-commentsPA :: (Monoid ann) => LocatedAn ann a -> P (LocatedAn ann a)
+commentsPA :: (NoAnn ann) => LocatedAn ann a -> P (LocatedAn ann a)
commentsPA la@(L l a) = do
cs <- getPriorCommentsFor (getLocA la)
return (L (addCommentsToSrcAnn l cs) a)
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -20,7 +20,7 @@ module GHC.Parser.Annotation (
EpAnn(..), Anchor(..), AnchorOperation(..),
spanAsAnchor, realSpanAsAnchor,
- noAnn,
+ NoAnn(..),
-- ** Comments in Annotations
@@ -1022,6 +1022,26 @@ reLocN (L (SrcSpanAnn _ l) a) = L l a
-- ---------------------------------------------------------------------
+noLocA :: a -> LocatedAn an a
+noLocA = L (SrcSpanAnn EpAnnNotUsed noSrcSpan)
+
+getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan
+getLocA = getHasLoc
+
+noSrcSpanA :: SrcAnn ann
+noSrcSpanA = noAnnSrcSpan noSrcSpan
+
+noAnnSrcSpan :: SrcSpan -> SrcAnn ann
+noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
+
+-- ---------------------------------------------------------------------
+
+class NoAnn a where
+ -- | equivalent of `mempty`, but does not need Semigroup
+ noAnn :: a
+
+-- ---------------------------------------------------------------------
+
class HasLoc a where
-- ^ conveniently calculate locations for things without locations attached
getHasLoc :: a -> SrcSpan
@@ -1070,22 +1090,9 @@ reAnnL anns cs (L l a) = L (SrcSpanAnn (EpAnn (spanAsAnchor l) anns cs) l) a
getLocAnn :: Located a -> SrcSpanAnnA
getLocAnn (L l _) = SrcSpanAnn EpAnnNotUsed l
-getLocA :: GenLocated (SrcSpanAnn' a) e -> SrcSpan
-getLocA = getHasLoc
-
-noLocA :: a -> LocatedAn an a
-noLocA = L (SrcSpanAnn EpAnnNotUsed noSrcSpan)
-
-noAnnSrcSpan :: SrcSpan -> SrcAnn ann
-noAnnSrcSpan l = SrcSpanAnn EpAnnNotUsed l
-
-noSrcSpanA :: SrcAnn ann
-noSrcSpanA = noAnnSrcSpan noSrcSpan
-
--- | Short form for 'EpAnnNotUsed'
-noAnn :: EpAnn a
-noAnn = EpAnnNotUsed
-
+instance NoAnn (EpAnn a) where
+ -- Short form for 'EpAnnNotUsed'
+ noAnn = EpAnnNotUsed
addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn]
addAnns (EpAnn l as1 cs) as2 cs2
@@ -1219,34 +1226,34 @@ comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs
-- | Add additional comments to a 'SrcAnn', used for manipulating the
-- AST prior to exact printing the changed one.
-addCommentsToSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
+addCommentsToSrcAnn :: (NoAnn ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
addCommentsToSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
- = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
+ = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) noAnn cs) loc
addCommentsToSrcAnn (SrcSpanAnn (EpAnn a an cs) loc) cs'
= SrcSpanAnn (EpAnn a an (cs <> cs')) loc
-- | Replace any existing comments on a 'SrcAnn', used for manipulating the
-- AST prior to exact printing the changed one.
-setCommentsSrcAnn :: (Monoid ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
+setCommentsSrcAnn :: (NoAnn ann) => SrcAnn ann -> EpAnnComments -> SrcAnn ann
setCommentsSrcAnn (SrcSpanAnn EpAnnNotUsed loc) cs
- = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs) loc
+ = SrcSpanAnn (EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) noAnn cs) loc
setCommentsSrcAnn (SrcSpanAnn (EpAnn a an _) loc) cs
= SrcSpanAnn (EpAnn a an cs) loc
-- | Add additional comments, used for manipulating the
-- AST prior to exact printing the changed one.
-addCommentsToEpAnn :: (Monoid a)
+addCommentsToEpAnn :: (NoAnn a)
=> SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
addCommentsToEpAnn loc EpAnnNotUsed cs
- = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
+ = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) noAnn cs
addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs)
-- | Replace any existing comments, used for manipulating the
-- AST prior to exact printing the changed one.
-setCommentsEpAnn :: (Monoid a)
+setCommentsEpAnn :: (NoAnn a)
=> SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a
setCommentsEpAnn loc EpAnnNotUsed cs
- = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs
+ = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) noAnn cs
setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs
-- | Transfer comments and trailing items from the annotations in the
@@ -1254,7 +1261,7 @@ setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs
transferAnnsA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsA from@(SrcSpanAnn EpAnnNotUsed _) to = (from, to)
transferAnnsA (SrcSpanAnn (EpAnn a an cs) l) to
- = ((SrcSpanAnn (EpAnn a mempty emptyComments) l), to')
+ = ((SrcSpanAnn (EpAnn a noAnn emptyComments) l), to')
where
to' = case to of
(SrcSpanAnn EpAnnNotUsed loc)
@@ -1268,9 +1275,9 @@ transferAnnsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnnA)
transferAnnsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2
= (SrcSpanAnn EpAnnNotUsed l, ss2)
transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l')
- = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn (spanAsAnchor l') an emptyComments) l')
+ = (SrcSpanAnn (EpAnn a noAnn cs) l, SrcSpanAnn (EpAnn (spanAsAnchor l') an emptyComments) l')
transferAnnsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l')
- = (SrcSpanAnn (EpAnn a mempty cs) l, SrcSpanAnn (EpAnn a' (an' <> an) cs') l')
+ = (SrcSpanAnn (EpAnn a noAnn cs) l, SrcSpanAnn (EpAnn a' (an' <> an) cs') l')
-- | Transfer comments from the annotations in the
-- first 'SrcSpanAnnA' argument to those in the second.
@@ -1278,15 +1285,15 @@ transferCommentsOnlyA :: SrcSpanAnnA -> SrcSpanAnnA -> (SrcSpanAnnA, SrcSpanAnn
transferCommentsOnlyA (SrcSpanAnn EpAnnNotUsed l) ss2
= (SrcSpanAnn EpAnnNotUsed l, ss2)
transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn EpAnnNotUsed l')
- = (SrcSpanAnn (EpAnn a an emptyComments ) l, SrcSpanAnn (EpAnn (spanAsAnchor l') mempty cs) l')
+ = (SrcSpanAnn (EpAnn a an emptyComments ) l, SrcSpanAnn (EpAnn (spanAsAnchor l') noAnn cs) l')
transferCommentsOnlyA (SrcSpanAnn (EpAnn a an cs) l) (SrcSpanAnn (EpAnn a' an' cs') l')
= (SrcSpanAnn (EpAnn a an emptyComments) l, SrcSpanAnn (EpAnn a' an' (cs <> cs')) l')
-- | Remove the exact print annotations payload, leaving only the
-- anchor and comments.
-commentsOnlyA :: Monoid ann => SrcAnn ann -> SrcAnn ann
+commentsOnlyA :: NoAnn ann => SrcAnn ann -> SrcAnn ann
commentsOnlyA (SrcSpanAnn EpAnnNotUsed loc) = SrcSpanAnn EpAnnNotUsed loc
-commentsOnlyA (SrcSpanAnn (EpAnn a _ cs) loc) = (SrcSpanAnn (EpAnn a mempty cs) loc)
+commentsOnlyA (SrcSpanAnn (EpAnn a _ cs) loc) = (SrcSpanAnn (EpAnn a noAnn cs) loc)
-- | Remove the comments, leaving the exact print annotations payload
removeCommentsA :: SrcAnn ann -> SrcAnn ann
@@ -1325,36 +1332,14 @@ instance Semigroup EpAnnComments where
EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2)
-instance (Monoid a) => Monoid (EpAnn a) where
- mempty = EpAnnNotUsed
-
-instance Semigroup NoEpAnns where
- _ <> _ = NoEpAnns
+instance NoAnn NoEpAnns where
+ noAnn = NoEpAnns
instance Semigroup AnnListItem where
(AnnListItem l1) <> (AnnListItem l2) = AnnListItem (l1 <> l2)
-instance Monoid AnnListItem where
- mempty = AnnListItem []
-
-
-instance Semigroup AnnList where
- (AnnList a1 o1 c1 r1 t1) <> (AnnList a2 o2 c2 r2 t2)
- = AnnList (a1 <> a2) (c o1 o2) (c c1 c2) (r1 <> r2) (t1 <> t2)
- where
- -- Left biased combination for the open and close annotations
- c Nothing x = x
- c x Nothing = x
- c f _ = f
-
-instance Monoid AnnList where
- mempty = AnnList Nothing Nothing Nothing [] []
-
-instance Semigroup NameAnn where
- _ <> _ = panic "semigroup nameann"
-
-instance Monoid NameAnn where
- mempty = NameAnnTrailing []
+instance NoAnn AnnListItem where
+ noAnn = AnnListItem []
instance Semigroup (AnnSortKey tag) where
@@ -1362,9 +1347,15 @@ instance Semigroup (AnnSortKey tag) where
x <> NoAnnSortKey = x
AnnSortKey ls1 <> AnnSortKey ls2 = AnnSortKey (ls1 <> ls2)
+instance NoAnn AnnList where
+ noAnn = AnnList Nothing Nothing Nothing [] []
+
instance Monoid (AnnSortKey tag) where
mempty = NoAnnSortKey
+instance NoAnn NameAnn where
+ noAnn = NameAnnTrailing []
+
instance (Outputable a) => Outputable (EpAnn a) where
ppr (EpAnn l a c) = text "EpAnn" <+> ppr l <+> ppr a <+> ppr c
ppr EpAnnNotUsed = text "EpAnnNotUsed"
=====================================
utils/check-exact/Main.hs
=====================================
@@ -450,7 +450,7 @@ changeLetIn1 _libdir parsed
[l2,_l1] = map wrapDecl $ bagToList bagDecls
bagDecls' = listToBag $ concatMap decl2Bind [l2]
(L (SrcSpanAnn _ le) e) = expr
- a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) mempty emptyComments) le)
+ a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) noAnn emptyComments) le)
expr' = L a e
tkIn' = L (TokenLoc (EpaDelta (DifferentLine 1 0) [])) HsTok
in (HsLet an tkLet
=====================================
utils/check-exact/Orphans.hs
=====================================
@@ -14,79 +14,67 @@ class Default a where
-- ---------------------------------------------------------------------
-- Orphan Default instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372
-instance Default [a] where
- def = []
+instance NoAnn [a] where
+ noAnn = []
-instance Default NameAnn where
- def = mempty
-
-instance Default AnnList where
- def = mempty
-
-instance Default AnnListItem where
- def = mempty
-
-instance Default AnnPragma where
- def = AnnPragma def def def
+instance NoAnn AnnPragma where
+ noAnn = AnnPragma noAnn noAnn noAnn
instance Semigroup EpAnnImportDecl where
(<>) = error "unimplemented"
-instance Default EpAnnImportDecl where
- def = EpAnnImportDecl def Nothing Nothing Nothing Nothing Nothing
-
-instance Default HsRuleAnn where
- def = HsRuleAnn Nothing Nothing def
+instance NoAnn EpAnnImportDecl where
+ noAnn = EpAnnImportDecl noAnn Nothing Nothing Nothing Nothing Nothing
-instance Default AnnSig where
- def = AnnSig def def
+instance NoAnn AnnParen where
+ noAnn = AnnParen AnnParens noAnn noAnn
-instance Default GrhsAnn where
- def = GrhsAnn Nothing def
+instance NoAnn HsRuleAnn where
+ noAnn = HsRuleAnn Nothing Nothing noAnn
-instance Default EpAnnUnboundVar where
- def = EpAnnUnboundVar def def
+instance NoAnn AnnSig where
+ noAnn = AnnSig noAnn noAnn
-instance (Default a, Default b) => Default (a, b) where
- def = (def, def)
+instance NoAnn GrhsAnn where
+ noAnn = GrhsAnn Nothing noAnn
-instance Default NoEpAnns where
- def = NoEpAnns
+instance NoAnn EpAnnUnboundVar where
+ noAnn = EpAnnUnboundVar noAnn noAnn
-instance Default AnnParen where
- def = AnnParen AnnParens def def
+instance (NoAnn a, NoAnn b) => NoAnn (a, b) where
+ noAnn = (noAnn, noAnn)
-instance Default AnnExplicitSum where
- def = AnnExplicitSum def def def def
+instance NoAnn AnnExplicitSum where
+ noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
-instance Default EpAnnHsCase where
- def = EpAnnHsCase def def def
+instance NoAnn EpAnnHsCase where
+ noAnn = EpAnnHsCase noAnn noAnn noAnn
-instance Default AnnsIf where
- def = AnnsIf def def def def def
+instance NoAnn AnnsIf where
+ noAnn = AnnsIf noAnn noAnn noAnn noAnn noAnn
-instance Default (Maybe a) where
- def = Nothing
+instance NoAnn (Maybe a) where
+ noAnn = Nothing
-instance Default AnnProjection where
- def = AnnProjection def def
+instance NoAnn AnnProjection where
+ noAnn = AnnProjection noAnn noAnn
-instance Default AnnFieldLabel where
- def = AnnFieldLabel Nothing
+instance NoAnn AnnFieldLabel where
+ noAnn = AnnFieldLabel Nothing
-instance Default EpaLocation where
- def = EpaDelta (SameLine 0) []
+instance NoAnn EpaLocation where
+ noAnn = EpaDelta (SameLine 0) []
-instance Default AddEpAnn where
- def = AddEpAnn def def
+instance NoAnn AddEpAnn where
+ noAnn = AddEpAnn noAnn noAnn
-instance Default AnnKeywordId where
- def = Annlarrowtail {- gotta pick one -}
+instance NoAnn AnnKeywordId where
+ noAnn = Annlarrowtail {- gotta pick one -}
-instance Default AnnContext where
- def = AnnContext Nothing [] []
+instance NoAnn AnnContext where
+ noAnn = AnnContext Nothing [] []
-instance Default EpAnnSumPat where
- def = EpAnnSumPat def def def
+instance NoAnn EpAnnSumPat where
+ noAnn = EpAnnSumPat noAnn noAnn noAnn
-instance Default AnnsModule where
- def = AnnsModule [] mempty Nothing
+instance NoAnn AnnsModule where
+ noAnn = AnnsModule [] mempty Nothing
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -87,7 +87,7 @@ module Transform
import Types
import Utils
-import Orphans (Default(..))
+import Orphans () -- NoAnn instances only
import Control.Monad.RWS
import qualified Control.Monad.Fail as Fail
@@ -191,7 +191,7 @@ captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms )))))
ms' = captureLineSpacing ms
captureMatchLineSpacing d = d
-captureLineSpacing :: Default t
+captureLineSpacing :: NoAnn t
=> [LocatedAn t e] -> [LocatedAn t e]
captureLineSpacing [] = []
captureLineSpacing [d] = [d]
@@ -226,7 +226,7 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H
op = case dca of
EpaSpan r _ -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll))
EpaDelta _ _ -> MovedAnchor (SameLine 1)
- in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) mempty emptyComments) ll) b)
+ in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) noAnn emptyComments) ll) b)
(L (SrcSpanAnn (EpAnn (Anchor r op) a c) ll) b)
-> let
op' = case op of
@@ -255,10 +255,10 @@ setEntryDPDecl d dp = setEntryDP d dp
-- |Set the true entry 'DeltaPos' from the annotation for a given AST
-- element. This is the 'DeltaPos' ignoring any comments.
-setEntryDP :: Default t => LocatedAn t a -> DeltaPos -> LocatedAn t a
+setEntryDP :: NoAnn t => LocatedAn t a -> DeltaPos -> LocatedAn t a
setEntryDP (L (SrcSpanAnn EpAnnNotUsed l) a) dp
= L (SrcSpanAnn
- (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) def emptyComments)
+ (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) noAnn emptyComments)
l) a
setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an (EpaComments [])) l) a) dp
= L (SrcSpanAnn
@@ -331,14 +331,14 @@ setEntryDPFromAnchor off (EpaSpan anc _) ll@(L la _) = setEntryDP ll dp'
-- |Take the annEntryDelta associated with the first item and associate it with the second.
-- Also transfer any comments occuring before it.
-transferEntryDP :: (Monad m, Monoid t2, Typeable t1, Typeable t2)
+transferEntryDP :: (Monad m, NoAnn t2, Typeable t1, Typeable t2)
=> LocatedAn t1 a -> LocatedAn t2 b -> TransformT m (LocatedAn t2 b)
transferEntryDP (L (SrcSpanAnn EpAnnNotUsed l1) _) (L (SrcSpanAnn EpAnnNotUsed _) b) = do
logTr $ "transferEntryDP': EpAnnNotUsed,EpAnnNotUsed"
return (L (SrcSpanAnn EpAnnNotUsed l1) b)
transferEntryDP (L (SrcSpanAnn (EpAnn anc _an cs) _l1) _) (L (SrcSpanAnn EpAnnNotUsed l2) b) = do
logTr $ "transferEntryDP': EpAnn,EpAnnNotUsed"
- return (L (SrcSpanAnn (EpAnn anc mempty cs) l2) b)
+ return (L (SrcSpanAnn (EpAnn anc noAnn cs) l2) b)
transferEntryDP (L (SrcSpanAnn (EpAnn anc1 an1 cs1) _l1) _) (L (SrcSpanAnn (EpAnn _anc2 an2 cs2) l2) b) = do
logTr $ "transferEntryDP': EpAnn,EpAnn"
-- Problem: if the original had preceding comments, blindly
@@ -619,7 +619,7 @@ splitCommentsStart p (EpaCommentsBalanced cs ts) = EpaCommentsBalanced cs' ts'
cs' = before
ts' = after <> ts
-moveLeadingComments :: (Data t, Data u, Monoid t, Monoid u)
+moveLeadingComments :: (Data t, Data u, NoAnn t, NoAnn u)
=> LocatedAn t a -> SrcAnn u -> (LocatedAn t a, SrcAnn u)
moveLeadingComments from@(L (SrcSpanAnn EpAnnNotUsed _) _) to = (from, to)
moveLeadingComments (L la a) lb = (L la' a, lb')
@@ -732,17 +732,17 @@ commentsOrigDeltasDecl (L (SrcSpanAnn an l) d) = L (SrcSpanAnn an' l) d
-- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the
-- given @DeltaPos at .
-noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
+noAnnSrcSpanDP :: (NoAnn ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP l dp
- = SrcSpanAnn (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty emptyComments) l
+ = SrcSpanAnn (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) noAnn emptyComments) l
-noAnnSrcSpanDP0 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
+noAnnSrcSpanDP0 :: (NoAnn ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP0 l = noAnnSrcSpanDP l (SameLine 0)
-noAnnSrcSpanDP1 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
+noAnnSrcSpanDP1 :: (NoAnn ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDP1 l = noAnnSrcSpanDP l (SameLine 1)
-noAnnSrcSpanDPn :: (Monoid ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)
+noAnnSrcSpanDPn :: (NoAnn ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann)
noAnnSrcSpanDPn l s = noAnnSrcSpanDP l (SameLine s)
d0 :: EpaLocation
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -26,8 +26,6 @@ import Data.Ord (comparing)
import GHC.Hs.Dump
import Lookup
-import Orphans (Default())
-import qualified Orphans as Orphans
import GHC hiding (EpaComment)
import qualified GHC
@@ -45,6 +43,7 @@ import qualified Data.Map.Strict as Map
import Debug.Trace
import Types
+import Orphans () -- NoAnn instances only
-- ---------------------------------------------------------------------
@@ -348,20 +347,20 @@ locatedAnAnchor (L (SrcSpanAnn (EpAnn a _ _) _) _) = anchor a
-- ---------------------------------------------------------------------
-setAnchorAn :: (Default an) => LocatedAn an a -> Anchor -> EpAnnComments -> LocatedAn an a
+setAnchorAn :: (NoAnn an) => LocatedAn an a -> Anchor -> EpAnnComments -> LocatedAn an a
setAnchorAn (L (SrcSpanAnn EpAnnNotUsed l) a) anc cs
- = (L (SrcSpanAnn (EpAnn anc Orphans.def cs) l) a)
+ = (L (SrcSpanAnn (EpAnn anc noAnn cs) l) a)
-- `debug` ("setAnchorAn: anc=" ++ showAst anc)
setAnchorAn (L (SrcSpanAnn (EpAnn _ an _) l) a) anc cs
= (L (SrcSpanAnn (EpAnn anc an cs) l) a)
-- `debug` ("setAnchorAn: anc=" ++ showAst anc)
-setAnchorEpa :: (Default an) => EpAnn an -> Anchor -> EpAnnComments -> EpAnn an
-setAnchorEpa EpAnnNotUsed anc cs = EpAnn anc Orphans.def cs
+setAnchorEpa :: (NoAnn an) => EpAnn an -> Anchor -> EpAnnComments -> EpAnn an
+setAnchorEpa EpAnnNotUsed anc cs = EpAnn anc noAnn cs
setAnchorEpa (EpAnn _ an _) anc cs = EpAnn anc an cs
setAnchorEpaL :: EpAnn AnnList -> Anchor -> EpAnnComments -> EpAnn AnnList
-setAnchorEpaL EpAnnNotUsed anc cs = EpAnn anc mempty cs
+setAnchorEpaL EpAnnNotUsed anc cs = EpAnn anc noAnn cs
setAnchorEpaL (EpAnn _ an _) anc cs = EpAnn anc (an {al_anchor = Nothing}) cs
setAnchorHsModule :: HsModule GhcPs -> Anchor -> EpAnnComments -> HsModule GhcPs
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit d073163aacdb321c4020d575fc417a9b2368567a
+Subproject commit 0f16e5ccd225fb909b4ae51ec6a22690bb629c24
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a28864cbb900e4fbeeaeeba681128ba49220c71
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a28864cbb900e4fbeeaeeba681128ba49220c71
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/20230924/8a07e22c/attachment-0001.html>
More information about the ghc-commits
mailing list