[Git][ghc/ghc][master] EPA: Replace AnnsModule am_main with EpTokens
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sun Sep 22 06:35:06 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
c0df5aa9 by Alan Zimmerman at 2024-09-22T02:34:42-04:00
EPA: Replace AnnsModule am_main with EpTokens
Working towards removing `AddEpAnn`
- - - - -
26 changed files:
- compiler/GHC/Hs.hs
- compiler/GHC/Parser.y
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/parser/should_compile/T23315/T23315.stderr
- testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- testsuite/tests/printer/Test24533.stdout
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -18,6 +18,7 @@ therefore, is almost nothing but re-exporting.
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data
+{-# LANGUAGE DataKinds #-}
module GHC.Hs (
module Language.Haskell.Syntax,
@@ -98,7 +99,9 @@ deriving instance Data (HsModule GhcPs)
data AnnsModule
= AnnsModule {
- am_main :: [AddEpAnn],
+ am_sig :: EpToken "signature",
+ am_mod :: EpToken "module",
+ am_where :: EpToken "where",
am_decls :: [TrailingAnn], -- ^ Semis before the start of top decls
am_cs :: [LEpaComment], -- ^ Comments before start of top decl,
-- used in exact printing only
@@ -106,7 +109,7 @@ data AnnsModule
} deriving (Data, Eq)
instance NoAnn AnnsModule where
- noAnn = AnnsModule [] [] [] Nothing
+ noAnn = AnnsModule NoEpTok NoEpTok NoEpTok [] [] Nothing
instance Outputable (HsModule GhcPs) where
ppr (HsModule { hsmodExt = XModulePs { hsmodHaddockModHeader = mbDoc }
=====================================
compiler/GHC/Parser.y
=====================================
@@ -911,7 +911,7 @@ signature :: { Located (HsModule GhcPs) }
: 'signature' modid maybe_warning_pragma maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
acs loc (\loc cs-> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6) [] Nothing) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fstOf3 $6) [] Nothing) cs)
(thdOf3 $6) $3 Nothing)
(Just $2) $4 (fst $ sndOf3 $6)
(snd $ sndOf3 $6)))
@@ -921,7 +921,7 @@ module :: { Located (HsModule GhcPs) }
: 'module' modid maybe_warning_pragma maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
acsFinal (\cs eof -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6) [] eof) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fstOf3 $6) [] eof) cs)
(thdOf3 $6) $3 Nothing)
(Just $2) $4 (fst $ sndOf3 $6)
(snd $ sndOf3 $6))
@@ -929,7 +929,7 @@ module :: { Located (HsModule GhcPs) }
| body2
{% fileSrcSpan >>= \ loc ->
acsFinal (\cs eof -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1) [] eof) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 $1) [] eof) cs)
(thdOf3 $1) Nothing Nothing)
Nothing Nothing
(fst $ sndOf3 $1) (snd $ sndOf3 $1)))) }
@@ -969,14 +969,14 @@ header :: { Located (HsModule GhcPs) }
: 'module' modid maybe_warning_pragma maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
acs loc (\loc cs -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] [] Nothing) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs)
EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
))) }
| 'signature' modid maybe_warning_pragma maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
acs loc (\loc cs -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] [] Nothing) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs)
EpNoLayout $3 Nothing)
(Just $2) $4 $6 []
))) }
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T22919.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T22919.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { T22919.hs:1:29-33 }))
[]
[]
(Just
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { Test20239.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { Test20239.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { Test20239.hs:1:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test20239.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { Test20239.hs:1:18-22 }))
[]
[]
(Just
@@ -351,6 +354,6 @@
[]))))))]))
-
Test20239.hs:5:15: error: [GHC-76037]
Not in scope: type constructor or class ‘Method’
+
=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { ZeroWidthSemi.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { ZeroWidthSemi.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { ZeroWidthSemi.hs:1:22-26 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { ZeroWidthSemi.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { ZeroWidthSemi.hs:1:22-26 }))
[]
[]
(Just
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T17544.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { T17544.hs:3:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T17544_kw.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T17544_kw.hs:11:1-6 }))
+ (EpTok
+ (EpaSpan { T17544_kw.hs:13:13-17 }))
[]
[]
(Just
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T24221.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T24221.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T24221.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T24221.hs:1:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T24221.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { T24221.hs:1:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -8,7 +8,9 @@
(EpAnn
(EpaSpan { mod185.hs:1:1 })
(AnnsModule
- []
+ (NoEpTok)
+ (NoEpTok)
+ (NoEpTok)
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { DumpParsedAst.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { DumpParsedAst.hs:4:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:4:22-26 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:4:1-6 }))
+ (EpTok
+ (EpaSpan { DumpParsedAst.hs:4:22-26 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { DumpParsedAstComments.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { DumpParsedAstComments.hs:5:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAstComments.hs:5:30-34 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpParsedAstComments.hs:5:1-6 }))
+ (EpTok
+ (EpaSpan { DumpParsedAstComments.hs:5:30-34 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { DumpSemis.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { DumpSemis.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:1:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { DumpSemis.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { DumpSemis.hs:1:18-22 }))
[(AddSemiAnn
(EpaSpan { DumpSemis.hs:4:1 }))
,(AddSemiAnn
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { KindSigs.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { KindSigs.hs:6:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:6:17-21 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { KindSigs.hs:6:1-6 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:6:17-21 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T15323.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T15323.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:3:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T15323.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { T15323.hs:3:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T20452.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T20452.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T20452.hs:3:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20452.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { T20452.hs:3:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T20718.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T20718.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T20718.hs:3:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20718.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { T20718.hs:3:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T20718b.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T20718b.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T20718b.hs:4:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T20718b.hs:4:16-20 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20718b.hs:4:1-6 }))
+ (EpTok
+ (EpaSpan { T20718b.hs:4:16-20 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T20846.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T20846.hs:1:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T20846.hs:1:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T20846.hs:1:1-6 }))
+ (EpTok
+ (EpaSpan { T20846.hs:1:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/parser/should_compile/T23315/T23315.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T23315.hsig:1:1 })
(AnnsModule
- [(AddEpAnn AnnSignature (EpaSpan { T23315.hsig:1:1-9 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T23315.hsig:1:18-22 }))]
+ (EpTok
+ (EpaSpan { T23315.hsig:1:1-9 }))
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T23315.hsig:1:18-22 }))
[]
[]
(Nothing))
=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { AnnotationNoListTuplePuns.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.hs:3:34-38 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { AnnotationNoListTuplePuns.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { AnnotationNoListTuplePuns.hs:3:34-38 }))
[]
[]
(Just
@@ -188,8 +191,11 @@
(EpAnn
(EpaSpan { AnnotationNoListTuplePuns.ppr.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:34-38 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:1-6 }))
+ (EpTok
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:34-38 }))
[]
[]
(Just
=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { T18791.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { T18791.hs:2:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:2:15-19 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { T18791.hs:2:1-6 }))
+ (EpTok
+ (EpaSpan { T18791.hs:2:15-19 }))
[]
[]
(Just
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { Test20297.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { Test20297.hs:2:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:2:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test20297.hs:2:1-6 }))
+ (EpTok
+ (EpaSpan { Test20297.hs:2:18-22 }))
[]
[]
(Just
@@ -420,8 +423,11 @@
(EpAnn
(EpaSpan { Test20297.ppr.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { Test20297.ppr.hs:2:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:2:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test20297.ppr.hs:2:1-6 }))
+ (EpTok
+ (EpaSpan { Test20297.ppr.hs:2:18-22 }))
[]
[]
(Just
=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -8,8 +8,11 @@
(EpAnn
(EpaSpan { Test24533.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { Test24533.hs:2:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { Test24533.hs:2:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test24533.hs:2:1-6 }))
+ (EpTok
+ (EpaSpan { Test24533.hs:2:18-22 }))
[]
[]
(Just
@@ -640,8 +643,11 @@
(EpAnn
(EpaSpan { Test24533.ppr.hs:1:1 })
(AnnsModule
- [(AddEpAnn AnnModule (EpaSpan { Test24533.ppr.hs:2:1-6 }))
- ,(AddEpAnn AnnWhere (EpaSpan { Test24533.ppr.hs:2:18-22 }))]
+ (NoEpTok)
+ (EpTok
+ (EpaSpan { Test24533.ppr.hs:2:1-6 }))
+ (EpTok
+ (EpaSpan { Test24533.ppr.hs:2:18-22 }))
[]
[]
(Just
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -996,15 +997,21 @@ lepa k epAnn = fmap (\newAnns -> epAnn { anns = newAnns })
-- data AnnsModule
-- = AnnsModule {
--- am_main :: [AddEpAnn],
+-- am_sig :: Maybe (EpToken "signature"),
+-- am_mod :: Maybe (EpToken "module"),
+-- am_where :: Maybe (EpToken "where"),
-- am_decls :: [TrailingAnn],
-- am_cs :: [LEpaComment],
-- am_eof :: Maybe (RealSrcSpan, RealSrcSpan)
-- } deriving (Data, Eq)
-lam_main :: Lens AnnsModule [AddEpAnn]
-lam_main k annsModule = fmap (\newAnns -> annsModule { am_main = newAnns })
- (k (am_main annsModule))
+lam_mod :: Lens AnnsModule (EpToken "module")
+lam_mod k annsModule = fmap (\newAnns -> annsModule { am_mod = newAnns })
+ (k (am_mod annsModule))
+
+lam_where :: Lens AnnsModule (EpToken "where")
+lam_where k annsModule = fmap (\newAnns -> annsModule { am_where = newAnns })
+ (k (am_where annsModule))
-- lam_decls :: Lens AnnsModule AnnList
-- lam_decls k annsModule = fmap (\newAnns -> annsModule { am_decls = newAnns })
@@ -1366,6 +1373,12 @@ markLensKwM' a l kw = do
go Nothing = return Nothing
go (Just s) = Just <$> markKwA kw s
+markLensTok :: (Monad m, Monoid w, KnownSymbol sym)
+ => EpAnn a -> Lens a (EpToken sym) -> EP w m (EpAnn a)
+markLensTok (EpAnn anc a cs) l = do
+ new <- markEpToken (view l a)
+ return (EpAnn anc (set l new a) cs)
+
-- ---------------------------------------------------------------------
markEpAnnL' :: (Monad m, Monoid w)
@@ -1676,14 +1689,14 @@ instance ExactPrint (HsModule GhcPs) where
case mmn of
Nothing -> return (an, mmn, mdeprec, mexports)
Just m -> do
- an0 <- markEpAnnL' an lam_main AnnModule
+ an0 <- markLensTok an lam_mod
m' <- markAnnotated m
mdeprec' <- setLayoutTopLevelP $ markAnnotated mdeprec
mexports' <- setLayoutTopLevelP $ markAnnotated mexports
- an1 <- setLayoutTopLevelP $ markEpAnnL' an0 lam_main AnnWhere
+ an1 <- setLayoutTopLevelP $ markLensTok an0 lam_where
return (an1, Just m', mdeprec', mexports')
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -326,8 +326,8 @@ fixModuleHeaderComments (GHC.L l p) = GHC.L l p'
-> ([GHC.LHsDecl GHC.GhcPs], GHC.EpAnn GHC.AnnsModule)
rebalance (ds, GHC.EpAnn a an cs) = (ds1, GHC.EpAnn a an cs')
where
- (ds1,cs') = case break (\(GHC.AddEpAnn k _) -> k == GHC.AnnWhere) (GHC.am_main an) of
- (_, (GHC.AddEpAnn _ whereLoc:_)) ->
+ (ds1,cs') = case GHC.am_where an of
+ GHC.EpTok whereLoc ->
case GHC.hsmodDecls p of
(d:ds0) -> (d':ds0, cs0)
where (d',cs0) = moveComments whereLoc d cs
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -292,7 +293,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
Just _ ->
-- We have a module name. Capture all comments up to the `where`
let
- (these, remaining) = splitOnWhere Before (am_main $ anns an) cs
+ (these, remaining) = splitOnWhere Before (am_where $ anns an) cs
(EpAnn a anno ocs) = an :: EpAnn AnnsModule
anm = EpAnn a anno (workInComments ocs these)
in
@@ -336,9 +337,9 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
-- Either hc0i or hc0d should have comments. Combine them
hc0 = hc0i ++ hc0d
- (hc1,hc_cs) = if null ( am_main $ anns an3)
+ (hc1,hc_cs) = if NoEpTok == (am_where $ anns an3)
then (hc0,[])
- else splitOnWhere After (am_main $ anns an3) hc0
+ else splitOnWhere After (am_where $ anns an3) hc0
hc2 = workInComments (comments an3) hc1
an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 }
@@ -355,15 +356,14 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
(xs',rest') = allocPreceding xs rest
data SplitWhere = Before | After
-splitOnWhere :: SplitWhere -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
-splitOnWhere _ [] csIn = (csIn,[])
-splitOnWhere w (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)
+
+splitOnWhere :: SplitWhere -> EpToken "where" -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
+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
-splitOnWhere _ (AddEpAnn AnnWhere _:_) csIn = (csIn, [])
-splitOnWhere f (_:as) csIn = splitOnWhere f as csIn
+splitOnWhere _ _ csIn = (csIn,[])
balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])
balanceFirstLocatedAComments [] = ([],[])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0df5aa9999fcb7a7890973c319b56731b77aa7d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c0df5aa9999fcb7a7890973c319b56731b77aa7d
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/20240922/93a3ceee/attachment-0001.html>
More information about the ghc-commits
mailing list