diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index ac95331c7fbad87bde273b9fd9622a1a1207c3e2..a38621ea7ef0e5f75156686db353afdcc8cf6e07 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -4446,13 +4446,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) diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index ccae37db53a993ad340ce63903da3156159cf18d..ad4f3b20abae2f4c1783ccb58599ce548f570086 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/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" diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 37358682160864ddba3ca7feadbf98fdc399c73a..6a44d89457c738dcafe2866e8a00c8e28c7a61cf 100644 --- a/utils/check-exact/Main.hs +++ b/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 diff --git a/utils/check-exact/Orphans.hs b/utils/check-exact/Orphans.hs index f6000288b0f149e501bc360e5eda42a90d92f022..5857888d596dceb86aadfadeea949df4cce44617 100644 --- a/utils/check-exact/Orphans.hs +++ b/utils/check-exact/Orphans.hs @@ -3,90 +3,70 @@ module Orphans where --- import Data.Default import GHC hiding (EpaComment) -- --------------------------------------------------------------------- +-- Orphan NoAnn instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372 -class Default a where - def :: a +instance NoAnn [a] where + noAnn = [] --- --------------------------------------------------------------------- --- Orphan Default instances. See https://gitlab.haskell.org/ghc/ghc/-/issues/20372 - -instance Default [a] where - def = [] - -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 Semigroup EpAnnImportDecl where - (<>) = error "unimplemented" -instance Default EpAnnImportDecl where - def = EpAnnImportDecl def Nothing Nothing Nothing Nothing Nothing +instance NoAnn AnnPragma where + noAnn = AnnPragma noAnn noAnn noAnn -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 diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index 340fa43cfafa2ec7c84231ef440d9cd6e2579cd7..b877d1eda2e81f7aa2d55107f34718686fd0634c 100644 --- a/utils/check-exact/Transform.hs +++ b/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@. -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 diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs index 59353df8245ae04811a1e51e65be378ea65cb93d..c8301df0d7db4b3e4055acfc0311a60c0f330f4f 100644 --- a/utils/check-exact/Utils.hs +++ b/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 diff --git a/utils/haddock b/utils/haddock index d073163aacdb321c4020d575fc417a9b2368567a..7e97eb212291fca97b67466d4f603eafc5b7caa7 160000 --- a/utils/haddock +++ b/utils/haddock @@ -1 +1 @@ -Subproject commit d073163aacdb321c4020d575fc417a9b2368567a +Subproject commit 7e97eb212291fca97b67466d4f603eafc5b7caa7