[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