summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGHC GitLab CI <ghc-ci@gitlab-haskell.org>2021-03-23 08:32:31 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-25 04:53:16 -0400
commit1350a5cd730f1cbbe306b849def26bfcd119c103 (patch)
tree45c8b4ef2cd4b09d6f9a24da905a1be5ff5ee616
parent0029df2bd52aa7f93e2254a369428e4261e5d3ae (diff)
downloadhaskell-1350a5cd730f1cbbe306b849def26bfcd119c103.tar.gz
EPA : Remove ApiAnn from ParsedModule
All the comments are now captured in the AST, there is no need for a side-channel structure for them.
-rw-r--r--compiler/GHC.hs12
-rw-r--r--compiler/GHC/Driver/Backpack.hs6
-rw-r--r--compiler/GHC/Driver/Main.hs10
-rw-r--r--compiler/GHC/Hs.hs5
-rw-r--r--compiler/GHC/Hs/Dump.hs4
-rw-r--r--compiler/GHC/Parser.y2
-rw-r--r--compiler/GHC/Parser/Annotation.hs10
-rw-r--r--compiler/GHC/Parser/Lexer.x6
-rw-r--r--compiler/GHC/Parser/PostProcess.hs2
-rw-r--r--testsuite/tests/ghc-api/annotations/.gitignore26
-rw-r--r--testsuite/tests/ghc-api/annotations/CheckUtils.hs118
-rw-r--r--testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr521
-rw-r--r--testsuite/tests/ghc-api/annotations/Makefile32
-rw-r--r--testsuite/tests/ghc-api/annotations/all.T4
-rw-r--r--testsuite/tests/ghc-api/annotations/bundle-export.stdout37
-rw-r--r--testsuite/tests/ghc-api/annotations/comments.hs72
-rw-r--r--testsuite/tests/ghc-api/annotations/comments.stdout17
-rw-r--r--testsuite/tests/ghc-api/annotations/exampleTest.stdout88
-rw-r--r--testsuite/tests/ghc-api/annotations/stringSource.hs146
-rw-r--r--testsuite/tests/ghc-api/annotations/t11430.hs133
-rw-r--r--testsuite/tests/printer/CommentsTest.hs (renamed from testsuite/tests/ghc-api/annotations/CommentsTest.hs)0
-rw-r--r--testsuite/tests/printer/InTreeAnnotations1.hs (renamed from testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs)0
-rw-r--r--testsuite/tests/printer/Makefile10
-rw-r--r--testsuite/tests/printer/all.T2
-rw-r--r--utils/check-exact/ExactPrint.hs30
-rw-r--r--utils/check-exact/Main.hs292
-rw-r--r--utils/check-exact/Parsers.hs28
-rw-r--r--utils/check-exact/Utils.hs18
-rw-r--r--utils/check-ppr/Main.hs9
29 files changed, 202 insertions, 1438 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 7a237b2146..0c55bfbea1 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -283,7 +283,7 @@ module GHC (
parser,
-- * API Annotations
- ApiAnns(..),AnnKeywordId(..),AnnotationComment(..),
+ AnnKeywordId(..),AnnotationComment(..),
-- * Miscellaneous
--sessionHscEnv,
@@ -1021,9 +1021,7 @@ class TypecheckedMod m => DesugaredMod m where
data ParsedModule =
ParsedModule { pm_mod_summary :: ModSummary
, pm_parsed_source :: ParsedSource
- , pm_extra_src_files :: [FilePath]
- , pm_annotations :: ApiAnns }
- -- See Note [Api annotations] in GHC.Parser.Annotation
+ , pm_extra_src_files :: [FilePath] }
instance ParsedMod ParsedModule where
modSummary m = pm_mod_summary m
@@ -1115,8 +1113,7 @@ parseModule ms = do
hsc_env <- getSession
let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
hpm <- liftIO $ hscParse hsc_env_tmp ms
- return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm)
- (hpm_annotations hpm))
+ return (ParsedModule ms (hpm_module hpm) (hpm_src_files hpm))
-- See Note [Api annotations] in GHC.Parser.Annotation
-- | Typecheck and rename a parsed module.
@@ -1130,8 +1127,7 @@ typecheckModule pmod = do
(tc_gbl_env, rn_info)
<- liftIO $ hscTypecheckRename hsc_env_tmp ms $
HsParsedModule { hpm_module = parsedSource pmod,
- hpm_src_files = pm_extra_src_files pmod,
- hpm_annotations = pm_annotations pmod }
+ hpm_src_files = pm_extra_src_files pmod }
details <- liftIO $ makeSimpleDetails hsc_env_tmp tc_gbl_env
safe <- liftIO $ finalSafeMode (ms_hspp_opts ms) tc_gbl_env
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index daf53a502f..07c56bb36a 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -773,8 +773,7 @@ summariseRequirement pn mod_name = do
hsmodDeprecMessage = Nothing,
hsmodHaddockModHeader = Nothing
}),
- hpm_src_files = [],
- hpm_annotations = ApiAnns []
+ hpm_src_files = []
}),
ms_hspp_file = "", -- none, it came inline
ms_hspp_opts = dflags,
@@ -884,8 +883,7 @@ hsModuleToModSummary pn hsc_src modname
-- This is our hack to get the parse tree to the right spot
ms_parsed_mod = Just (HsParsedModule {
hpm_module = hsmod,
- hpm_src_files = [], -- TODO if we preprocessed it
- hpm_annotations = ApiAnns [] -- BOGUS
+ hpm_src_files = [] -- TODO if we preprocessed it
}),
ms_hs_date = time,
ms_obj_date = Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index c060f69c87..0ef4f10719 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -217,7 +217,7 @@ import qualified GHC.Data.Stream as Stream
import GHC.Data.Stream (Stream)
import Data.Data hiding (Fixity, TyCon)
-import Data.Maybe ( fromJust, fromMaybe )
+import Data.Maybe ( fromJust )
import Data.List ( nub, isPrefixOf, partition )
import Control.Monad
import Data.IORef
@@ -462,13 +462,9 @@ hscParse' mod_summary
-- filter them out:
srcs2 <- liftIO $ filterM doesFileExist srcs1
- let api_anns = ApiAnns {
- apiAnnRogueComments = (fromMaybe [] (header_comments pst)) ++ comment_q pst
- }
- res = HsParsedModule {
+ let res = HsParsedModule {
hpm_module = rdr_module,
- hpm_src_files = srcs2,
- hpm_annotations = api_anns
+ hpm_src_files = srcs2
}
-- apply parse transformation of plugins
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 95cf14a616..26022e96de 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -166,13 +166,10 @@ pp_nonnull xs = vcat (map ppr xs)
data HsParsedModule = HsParsedModule {
hpm_module :: Located HsModule,
- hpm_src_files :: [FilePath],
+ hpm_src_files :: [FilePath]
-- ^ extra source files (e.g. from #includes). The lexer collects
-- these from '# <file> <line>' pragmas, which the C preprocessor
-- leaves behind. These files and their timestamps are stored in
-- the .hi file, so that we can force recompilation if any of
-- them change (#3589)
- hpm_annotations :: ApiAnns
- -- See note [Api annotations] in GHC.Parser.Annotation
}
-
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index 329b2d9308..18605d3532 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -57,6 +57,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`extQ` annotationAddApiAnn
`extQ` annotationGrhsAnn
`extQ` annotationApiAnnHsCase
+ `extQ` annotationApiAnnHsLet
`extQ` annotationAnnList
`extQ` annotationApiAnnImportDecl
`extQ` annotationAnnParen
@@ -237,6 +238,9 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
annotationApiAnnHsCase :: ApiAnn' ApiAnnHsCase -> SDoc
annotationApiAnnHsCase = annotation' (text "ApiAnn' ApiAnnHsCase")
+ annotationApiAnnHsLet :: ApiAnn' AnnsLet -> SDoc
+ annotationApiAnnHsLet = annotation' (text "ApiAnn' AnnsLet")
+
annotationAnnList :: ApiAnn' AnnList -> SDoc
annotationAnnList = annotation' (text "ApiAnn' AnnList")
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index f786940591..b9bae7a1f7 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1197,6 +1197,8 @@ topdecls_cs_semi :: { OrdList (LHsDecl GhcPs) }
: topdecls_cs_semi topdecl_cs semis1 {% do { t <- amsA $2 $3
; return ($1 `snocOL` t) }}
| {- empty -} { nilOL }
+
+-- Each topdecl accumulates prior comments
topdecl_cs :: { LHsDecl GhcPs }
topdecl_cs : topdecl {% commentsPA $1 }
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 3dd3b3302b..a860e3edb9 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -4,10 +4,6 @@
{-# LANGUAGE FlexibleInstances #-}
module GHC.Parser.Annotation (
- -- * Out-of-tree API Annotations. Exist for the duration of !5158,
- -- * will be removed by !2418
- ApiAnns(..),
-
-- * Core API Annotation types
AnnKeywordId(..),
AnnotationComment(..), AnnotationCommentTok(..),
@@ -162,12 +158,6 @@ The wiki page describing this feature is
https://gitlab.haskell.org/ghc/ghc/wikis/api-annotations
-}
--- ---------------------------------------------------------------------
-
-data ApiAnns =
- ApiAnns
- { apiAnnRogueComments :: [LAnnotationComment]
- }
-- --------------------------------------------------------------------
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index bfebbfa411..634cd10207 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -2932,7 +2932,7 @@ instance MonadP P where
POk s {
header_comments = header_comments',
comment_q = comment_q'
- } (AnnCommentsBalanced [] (reverse newAnns))
+ } (AnnCommentsBalanced (fromMaybe [] header_comments') (reverse newAnns))
getCommentsFor :: (MonadP m) => SrcSpan -> m ApiAnnComments
getCommentsFor (RealSrcSpan l _) = allocateCommentsP l
@@ -3496,8 +3496,8 @@ allocateFinalComments ss comment_q mheader_comments =
comment_q'= before
in
case mheader_comments of
- Nothing -> (Just newAnns, comment_q', [])
- Just _ -> (mheader_comments, comment_q', newAnns)
+ Nothing -> (Just newAnns, [], comment_q')
+ Just _ -> (mheader_comments, [], comment_q' ++ newAnns)
commentToAnnotation :: RealLocated Token -> LAnnotationComment
commentToAnnotation (L l (ITdocCommentNext s ll)) = mkLAnnotationComment l ll (AnnDocCommentNext s)
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 9dde6faeb8..9ac689c4d4 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2826,7 +2826,7 @@ instance MonadP PV where
PV_Ok s {
pv_header_comments = header_comments',
pv_comment_q = comment_q'
- } (AnnCommentsBalanced [] (reverse newAnns))
+ } (AnnCommentsBalanced (fromMaybe [] header_comments') (reverse newAnns))
{- Note [Parser-Validator Hint]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/ghc-api/annotations/.gitignore b/testsuite/tests/ghc-api/annotations/.gitignore
deleted file mode 100644
index 320a756e5c..0000000000
--- a/testsuite/tests/ghc-api/annotations/.gitignore
+++ /dev/null
@@ -1,26 +0,0 @@
-annotations
-parseTree
-comments
-exampleTest
-listcomps
-boolFormula
-t10255
-t10268
-t10269
-t10278
-t10280
-t10307
-t10309
-t10312
-t10354
-t10357
-t10358
-t10396
-t10399
-t11430
-load-main
-stringSource
-*.hi
-*.o
-*.run.*
-*.normalised
diff --git a/testsuite/tests/ghc-api/annotations/CheckUtils.hs b/testsuite/tests/ghc-api/annotations/CheckUtils.hs
deleted file mode 100644
index d3a2b3d80e..0000000000
--- a/testsuite/tests/ghc-api/annotations/CheckUtils.hs
+++ /dev/null
@@ -1,118 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-
--- This program must be called with GHC's libdir and the file to be checked as
--- the command line arguments.
-module CheckUtils where
-
-import Data.Data
-import Data.List
-import System.IO
-import GHC
-import GHC.Types.Basic
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-import GHC.Utils.Monad
-import GHC.Utils.Outputable
-import GHC.Parser.Annotation
-import GHC.Data.Bag (filterBag,isEmptyBag)
-import System.Directory (removeFile)
-import System.Environment( getArgs )
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import Data.Dynamic ( fromDynamic,Dynamic )
-
-_main::IO()
-_main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
-
-testOneFile libdir fileName = do
- ((anns,cs),p) <- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- setSessionDynFlags dflags
- let mn =mkModuleName fileName
- addTarget Target { targetId = TargetModule mn
- , targetAllowObjCode = True
- , targetContents = Nothing }
- load LoadAllTargets
- modSum <- getModSummary mn
- p <- parseModule modSum
- return (pm_annotations p,p)
-
- let spans = Set.fromList $ getAllSrcSpans (pm_parsed_source p)
-
- problems = filter (\(s,a) -> not (Set.member s spans))
- $ getAnnSrcSpans (anns,cs)
-
- exploded = [((kw,ss),[anchor])
- | ((anchor,kw),sss) <- Map.toList anns,ss <- sss]
-
- exploded' = Map.toList $ Map.fromListWith (++) exploded
-
- problems' = filter (\(_,anchors)
- -> not (any (\a -> Set.member a spans) anchors))
- exploded'
-
- putStrLn "---Problems---------------------"
- putStrLn (intercalate "\n" [showAnns $ Map.fromList $ map snd problems])
- putStrLn "---Problems'--------------------"
- putStrLn (intercalate "\n" [pp $ Map.fromList $ map fst problems'])
- putStrLn "--------------------------------"
- putStrLn (intercalate "\n" [showAnns anns])
-
- where
- getAnnSrcSpans :: ApiAnns -> [(SrcSpan,(ApiAnnKey,[SrcSpan]))]
- getAnnSrcSpans (anns,_) = map (\a@((ss,_),_) -> (ss,a)) $ Map.toList anns
-
- getAllSrcSpans :: (Data t) => t -> [SrcSpan]
- getAllSrcSpans ast = everything (++) ([] `mkQ` getSrcSpan) ast
- where
- getSrcSpan :: SrcSpan -> [SrcSpan]
- getSrcSpan ss = [ss]
-
-
-showAnns anns = "[\n" ++ (intercalate "\n"
- $ map (\((s,k),v)
- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
- $ Map.toList anns)
- ++ "]\n"
-
-pp a = showPprUnsafe a
-
-
--- ---------------------------------------------------------------------
-
--- Copied from syb for the test
-
-
--- | Generic queries of type \"r\",
--- i.e., take any \"a\" and return an \"r\"
---
-type GenericQ r = forall a. Data a => a -> r
-
-
--- | Make a generic query;
--- start from a type-specific case;
--- return a constant otherwise
---
-mkQ :: ( Typeable a
- , Typeable b
- )
- => r
- -> (b -> r)
- -> a
- -> r
-(r `mkQ` br) a = case cast a of
- Just b -> br b
- Nothing -> r
-
-
-
--- | Summarise all nodes in top-down, left-to-right order
-everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
-
--- Apply f to x to summarise top-level node;
--- use gmapQ to recurse into immediate subterms;
--- use ordinary foldl to reduce list of intermediate results
-
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr b/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr
deleted file mode 100644
index 42e3143635..0000000000
--- a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.stderr
+++ /dev/null
@@ -1,521 +0,0 @@
-
-==================== Parser AST ====================
-
-(L
- { InTreeAnnotations1.hs:1:1 }
- (HsModule
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:1:1 }
- (UnchangedAnchor))
- (AnnsModule
- [(AddApiAnn AnnModule (AR { InTreeAnnotations1.hs:2:1-6 }))
- ,(AddApiAnn AnnWhere (AR { InTreeAnnotations1.hs:2:27-31 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- []))
- (AnnCommentsBalanced
- []
- [(L
- (Anchor
- { InTreeAnnotations1.hs:9:1 }
- (UnchangedAnchor))
- (AnnComment
- (AnnEofComment)
- { InTreeAnnotations1.hs:9:1 }))]))
- (VirtualBraces
- (1))
- (Just
- (L
- { InTreeAnnotations1.hs:2:8-25 }
- {ModuleName: InTreeAnnotations1}))
- (Nothing)
- []
- [(L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:1-31 }
- (UnchangedAnchor))
- (AnnListItem
- [])
- (AnnComments
- [])) { InTreeAnnotations1.hs:4:1-31 })
- (ValD
- (NoExtField)
- (FunBind
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-3 })
- (Unqual
- {OccName: foo}))
- (MG
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-31 })
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-31 })
- (Match
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:1-31 }
- (UnchangedAnchor))
- []
- (AnnComments
- []))
- (FunRhs
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:1-3 })
- (Unqual
- {OccName: foo}))
- (Prefix)
- (NoSrcStrict))
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:5-11 })
- (AsPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:5-11 }
- (UnchangedAnchor))
- [(AddApiAnn AnnAt (AR { InTreeAnnotations1.hs:4:6 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:5 })
- (Unqual
- {OccName: a}))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:7-11 })
- (TuplePat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:7-11 }
- (UnchangedAnchor))
- [(AddApiAnn AnnOpenP (AR { InTreeAnnotations1.hs:4:7 }))
- ,(AddApiAnn AnnCloseP (AR { InTreeAnnotations1.hs:4:11 }))]
- (AnnComments
- []))
- [(L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:8 }
- (UnchangedAnchor))
- (AnnListItem
- [(AddCommaAnn
- (AR { InTreeAnnotations1.hs:4:9 }))])
- (AnnComments
- [])) { InTreeAnnotations1.hs:4:8 })
- (WildPat
- (NoExtField)))
- ,(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:10 })
- (WildPat
- (NoExtField)))]
- (Boxed)))))
- ,(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:13-16 })
- (BangPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:13-16 }
- (UnchangedAnchor))
- [(AddApiAnn AnnBang (AR { InTreeAnnotations1.hs:4:13 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:14-16 })
- (LitPat
- (NoExtField)
- (HsString
- (SourceText "a")
- {FastString: "a"})))))
- ,(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:18-19 })
- (LazyPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:18-19 }
- (UnchangedAnchor))
- [(AddApiAnn AnnTilde (AR { InTreeAnnotations1.hs:4:18 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:19 })
- (VarPat
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:19 })
- (Unqual
- {OccName: x}))))))]
- (GRHSs
- (NoExtField)
- [(L
- { InTreeAnnotations1.hs:4:21-31 }
- (GRHS
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:4:21-31 }
- (UnchangedAnchor))
- (GrhsAnn
- (Nothing)
- (AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:4:21 })))
- (AnnComments
- []))
- []
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:23-31 })
- (HsVar
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:4:23-31 })
- (Unqual
- {OccName: undefined}))))))]
- (EmptyLocalBinds
- (NoExtField)))))])
- (FromSource))
- [])))
- ,(L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:1-27 }
- (UnchangedAnchor))
- (AnnListItem
- [])
- (AnnComments
- [])) { InTreeAnnotations1.hs:6:1-27 })
- (TyClD
- (NoExtField)
- (DataDecl
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:1-27 }
- (UnchangedAnchor))
- [(AddApiAnn AnnData (AR { InTreeAnnotations1.hs:6:1-4 }))
- ,(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:6:8 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:6 })
- (Unqual
- {OccName: T}))
- (HsQTvs
- (NoExtField)
- [])
- (Prefix)
- (HsDataDefn
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:1-27 }
- (UnchangedAnchor))
- [(AddApiAnn AnnData (AR { InTreeAnnotations1.hs:6:1-4 }))
- ,(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:6:8 }))]
- (AnnComments
- []))
- (DataType)
- (Nothing)
- (Nothing)
- (Nothing)
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:10-27 })
- (ConDeclH98
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:10-27 }
- (UnchangedAnchor))
- []
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:10-12 })
- (Unqual
- {OccName: MkT}))
- (False)
- []
- (Nothing)
- (RecCon
- (L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:14 }
- (UnchangedAnchor))
- (AnnList
- (Just
- (Anchor
- { InTreeAnnotations1.hs:6:16-25 }
- (UnchangedAnchor)))
- (Just
- (AddApiAnn AnnOpenC (AR { InTreeAnnotations1.hs:6:14 })))
- (Just
- (AddApiAnn AnnCloseC (AR { InTreeAnnotations1.hs:6:27 })))
- []
- [])
- (AnnComments
- [])) { InTreeAnnotations1.hs:6:14-27 })
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:16-25 })
- (ConDeclField
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:16-18 }
- (UnchangedAnchor))
- [(AddApiAnn AnnDcolon (AR { InTreeAnnotations1.hs:6:20-21 }))]
- (AnnComments
- []))
- [(L
- { InTreeAnnotations1.hs:6:16 }
- (FieldOcc
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:16 }
- (UnchangedAnchor))
- (NameAnnTrailing
- [(AddCommaAnn
- (AR { InTreeAnnotations1.hs:6:17 }))])
- (AnnComments
- [])) { InTreeAnnotations1.hs:6:16 })
- (Unqual
- {OccName: x}))))
- ,(L
- { InTreeAnnotations1.hs:6:18 }
- (FieldOcc
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:18 })
- (Unqual
- {OccName: y}))))]
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:23-25 })
- (HsTyVar
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:6:23-25 }
- (UnchangedAnchor))
- []
- (AnnComments
- []))
- (NotPromoted)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:6:23-25 })
- (Unqual
- {OccName: Int}))))
- (Nothing)))]))
- (Nothing)))]
- []))))
- ,(L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:1-43 }
- (UnchangedAnchor))
- (AnnListItem
- [])
- (AnnComments
- [])) { InTreeAnnotations1.hs:8:1-43 })
- (ValD
- (NoExtField)
- (FunBind
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1 })
- (Unqual
- {OccName: f}))
- (MG
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1-43 })
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1-43 })
- (Match
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:1-43 }
- (UnchangedAnchor))
- []
- (AnnComments
- []))
- (FunRhs
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:1 })
- (Unqual
- {OccName: f}))
- (Prefix)
- (NoSrcStrict))
- [(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:3-35 })
- (ParPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:3-35 }
- (UnchangedAnchor))
- (AnnParen
- (AnnParens)
- (AR { InTreeAnnotations1.hs:8:3 })
- (AR { InTreeAnnotations1.hs:8:35 }))
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:4-34 })
- (ConPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:4-34 }
- (UnchangedAnchor))
- [(AddApiAnn AnnOpenC (AR { InTreeAnnotations1.hs:8:8 }))
- ,(AddApiAnn AnnCloseC (AR { InTreeAnnotations1.hs:8:34 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:4-6 })
- (Unqual
- {OccName: MkT}))
- (RecCon
- (HsRecFields
- [(L
- (SrcSpanAnn (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:10-15 }
- (UnchangedAnchor))
- (AnnListItem
- [(AddCommaAnn
- (AR { InTreeAnnotations1.hs:8:16 }))])
- (AnnComments
- [])) { InTreeAnnotations1.hs:8:10-15 })
- (HsRecField
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:10 }
- (UnchangedAnchor))
- [(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:12 }))]
- (AnnComments
- []))
- (L
- { InTreeAnnotations1.hs:8:10 }
- (FieldOcc
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:10 })
- (Unqual
- {OccName: x}))))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:14-15 })
- (BangPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:14-15 }
- (UnchangedAnchor))
- [(AddApiAnn AnnBang (AR { InTreeAnnotations1.hs:8:14 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:15 })
- (VarPat
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:15 })
- (Unqual
- {OccName: v}))))))
- (False)))
- ,(L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:18-32 })
- (HsRecField
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:18 }
- (UnchangedAnchor))
- [(AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:20 }))]
- (AnnComments
- []))
- (L
- { InTreeAnnotations1.hs:8:18 }
- (FieldOcc
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:18 })
- (Unqual
- {OccName: y}))))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-32 })
- (ViewPat
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:22-32 }
- (UnchangedAnchor))
- [(AddApiAnn AnnRarrow (AR { InTreeAnnotations1.hs:8:29-30 }))]
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-27 })
- (HsVar
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:22-27 })
- (Unqual
- {OccName: negate}))))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:32 })
- (VarPat
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:32 })
- (Unqual
- {OccName: w}))))))
- (False)))]
- (Nothing)))))))]
- (GRHSs
- (NoExtField)
- [(L
- { InTreeAnnotations1.hs:8:37-43 }
- (GRHS
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:37-43 }
- (UnchangedAnchor))
- (GrhsAnn
- (Nothing)
- (AddApiAnn AnnEqual (AR { InTreeAnnotations1.hs:8:37 })))
- (AnnComments
- []))
- []
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39-43 })
- (OpApp
- (ApiAnn
- (Anchor
- { InTreeAnnotations1.hs:8:39-43 }
- (UnchangedAnchor))
- []
- (AnnComments
- []))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39 })
- (HsVar
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:39 })
- (Unqual
- {OccName: v}))))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:41 })
- (HsVar
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:41 })
- (Unqual
- {OccName: +}))))
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:43 })
- (HsVar
- (NoExtField)
- (L
- (SrcSpanAnn (ApiAnnNotUsed) { InTreeAnnotations1.hs:8:43 })
- (Unqual
- {OccName: w}))))))))]
- (EmptyLocalBinds
- (NoExtField)))))])
- (FromSource))
- [])))]
- (Nothing)
- (Nothing)))
diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile
deleted file mode 100644
index 23151ea43a..0000000000
--- a/testsuite/tests/ghc-api/annotations/Makefile
+++ /dev/null
@@ -1,32 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
-clean:
- rm -f *.o *.hi
- rm -f annotations comments
- rm -f stringSource
-
-.PHONY: annotations
-annotations:
- rm -f annotations.o annotations.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc annotations
- ./annotations "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-.PHONY: comments
-comments:
- rm -f comments.o comments.hi
- '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc comments
- ./comments "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
-
-# .PHONY: T10313
-# T10313:
-# rm -f stringSource.o stringSource.hi
-# '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc stringSource
-# ./stringSource "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test10313
-
-# .PHONY: T11430
-# T11430:
-# rm -f t11430.o t11430.hi t11430
-# '$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc t11430
-# ./t11430 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test11430
diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T
deleted file mode 100644
index b99afdab4a..0000000000
--- a/testsuite/tests/ghc-api/annotations/all.T
+++ /dev/null
@@ -1,4 +0,0 @@
-test('comments', [normalise_slashes,
- extra_files(['CommentsTest.hs']),
- ignore_stderr], makefile_test, ['comments'])
-test('InTreeAnnotations1',normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
diff --git a/testsuite/tests/ghc-api/annotations/bundle-export.stdout b/testsuite/tests/ghc-api/annotations/bundle-export.stdout
deleted file mode 100644
index e7bff3db75..0000000000
--- a/testsuite/tests/ghc-api/annotations/bundle-export.stdout
+++ /dev/null
@@ -1,37 +0,0 @@
----Unattached Annotation Problems (should be empty list)---
-[]
----Ann before enclosing span problem (should be empty list)---
-[
-
-]
-
----Annotations-----------------------
--- SrcSpan the annotation is attached to, AnnKeywordId,
--- list of locations the keyword item appears in
-[
-((BundleExport.hs:1:1,AnnModule), [BundleExport.hs:2:1-6]),
-((BundleExport.hs:1:1,AnnWhere), [BundleExport.hs:2:37-41]),
-((BundleExport.hs:2:20-35,AnnCloseP), [BundleExport.hs:2:35]),
-((BundleExport.hs:2:20-35,AnnOpenP), [BundleExport.hs:2:20]),
-((BundleExport.hs:2:21-28,AnnCloseP), [BundleExport.hs:2:28]),
-((BundleExport.hs:2:21-28,AnnComma), [BundleExport.hs:2:25, BundleExport.hs:2:29]),
-((BundleExport.hs:2:21-28,AnnDotdot), [BundleExport.hs:2:23-24]),
-((BundleExport.hs:2:21-28,AnnOpenP), [BundleExport.hs:2:22]),
-((BundleExport.hs:2:31-34,AnnCloseP), [BundleExport.hs:2:34]),
-((BundleExport.hs:2:31-34,AnnOpenP), [BundleExport.hs:2:32]),
-((BundleExport.hs:4:1-10,AnnData), [BundleExport.hs:4:1-4]),
-((BundleExport.hs:4:1-10,AnnEqual), [BundleExport.hs:4:8]),
-((BundleExport.hs:4:1-10,AnnSemi), [BundleExport.hs:6:1]),
-((BundleExport.hs:6:1-10,AnnData), [BundleExport.hs:6:1-4]),
-((BundleExport.hs:6:1-10,AnnEqual), [BundleExport.hs:6:8]),
-((BundleExport.hs:6:1-10,AnnSemi), [BundleExport.hs:8:1]),
-((BundleExport.hs:8:1-13,AnnEqual), [BundleExport.hs:8:11]),
-((BundleExport.hs:8:1-13,AnnPattern), [BundleExport.hs:8:1-7]),
-((BundleExport.hs:8:1-13,AnnSemi), [BundleExport.hs:9:1]),
-((BundleExport.hs:9:1-13,AnnEqual), [BundleExport.hs:9:11]),
-((BundleExport.hs:9:1-13,AnnPattern), [BundleExport.hs:9:1-7]),
-((BundleExport.hs:9:1-13,AnnSemi), [BundleExport.hs:10:1])
-]
-
----Eof Position (should be Just)-----
-Just SrcSpanPoint "BundleExport.hs" 10 1
diff --git a/testsuite/tests/ghc-api/annotations/comments.hs b/testsuite/tests/ghc-api/annotations/comments.hs
deleted file mode 100644
index d8c68594d0..0000000000
--- a/testsuite/tests/ghc-api/annotations/comments.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-
--- This program must be called with GHC's libdir as the single command line
--- argument.
-module Main where
-
--- import Data.Generics
-import Data.Data
-import Data.List (intercalate)
-import System.IO
-import GHC
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-import GHC.Utils.Monad
-import GHC.Utils.Outputable
-import GHC.Data.Bag (filterBag,isEmptyBag)
-import System.Directory (removeFile)
-import System.Environment( getArgs )
-import qualified Data.Map as Map
-import Data.Dynamic ( fromDynamic,Dynamic )
-
-main::IO()
-main = do
- [libdir] <- getArgs
- testOneFile libdir "CommentsTest" True
- testOneFile libdir "CommentsTest" False
-
-testOneFile libdir fileName useHaddock = do
- p <- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- let dflags' = if useHaddock
- then gopt_set (gopt_set dflags Opt_Haddock)
- Opt_KeepRawTokenStream
- else gopt_set (gopt_unset dflags Opt_Haddock)
- Opt_KeepRawTokenStream
- setSessionDynFlags dflags'
- let mn =mkModuleName fileName
- addTarget Target { targetId = TargetModule mn
- , targetAllowObjCode = True
- , targetContents = Nothing }
- load LoadAllTargets
- modSum <- getModSummary mn
- p <- parseModule modSum
- t <- typecheckModule p
- d <- desugarModule t
- l <- loadModule d
- let ts=typecheckedSource l
- r =renamedSource l
- -- liftIO (putStr (showSDocDebug (ppr ts)))
- return (pm_annotations p)
-
- let anns = p
- -- ann_comments = apiAnnComments anns
- ann_comments = Map.empty
- ann_rcomments = apiAnnRogueComments anns
- comments =
- map (\(s,v) -> (RealSrcSpan s Nothing, v)) (Map.toList ann_comments)
- ++
- [(noSrcSpan, ann_rcomments)]
-
- putStrLn (intercalate "\n" [showAnns comments])
-
-showAnns anns = "[\n" ++ (intercalate "\n"
- $ map (\(s,v)
- -> ("( " ++ pp s ++" =\n[" ++ showToks v ++ "])\n"))
- $ anns)
- ++ "]\n"
-
-showToks ts = intercalate ",\n\n"
- $ map (\(L p t) -> "(" ++ pp p ++ "," ++ show t ++ ")") ts
-
-pp a = showPprUnsafe a
diff --git a/testsuite/tests/ghc-api/annotations/comments.stdout b/testsuite/tests/ghc-api/annotations/comments.stdout
deleted file mode 100644
index 1b7ed7061a..0000000000
--- a/testsuite/tests/ghc-api/annotations/comments.stdout
+++ /dev/null
@@ -1,17 +0,0 @@
-[
-( <no location info> =
-[(Anchor CommentsTest.hs:11:1-33 UnchangedAnchor,AnnComment {ac_tok = AnnDocCommentNext " The function @foo@ does blah", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 9 31 33}),
-
-(Anchor CommentsTest.hs:(3,1)-(7,2) UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 2 27 32}),
-
-(Anchor CommentsTest.hs:1:1-31 UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}", ac_prior_tok = SrcSpanPoint "./CommentsTest.hs" 1 1})])
-]
-
-[
-( <no location info> =
-[(Anchor CommentsTest.hs:11:1-33 UnchangedAnchor,AnnComment {ac_tok = AnnLineComment "-- | The function @foo@ does blah", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 9 31 33}),
-
-(Anchor CommentsTest.hs:(3,1)-(7,2) UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-\nAn opening comment\n {- with a nested one -}\n {-# nested PRAGMA #-}\n-}", ac_prior_tok = SrcSpanOneLine "./CommentsTest.hs" 2 27 32}),
-
-(Anchor CommentsTest.hs:1:1-31 UnchangedAnchor,AnnComment {ac_tok = AnnBlockComment "{-# LANGUAGE DeriveFoldable #-}", ac_prior_tok = SrcSpanPoint "./CommentsTest.hs" 1 1})])
-]
diff --git a/testsuite/tests/ghc-api/annotations/exampleTest.stdout b/testsuite/tests/ghc-api/annotations/exampleTest.stdout
deleted file mode 100644
index 904b845bfd..0000000000
--- a/testsuite/tests/ghc-api/annotations/exampleTest.stdout
+++ /dev/null
@@ -1,88 +0,0 @@
----Unattached Annotation Problems (should be empty list)---
-[]
----Ann before enclosing span problem (should be empty list)---
-[
-
-]
-
----Annotations-----------------------
--- SrcSpan the annotation is attached to, AnnKeywordId,
--- list of locations the keyword item appears in
-[
-((AnnotationTuple.hs:1:1,AnnCloseC), [AnnotationTuple.hs:27:1]),
-((AnnotationTuple.hs:1:1,AnnModule), [AnnotationTuple.hs:3:1-6]),
-((AnnotationTuple.hs:1:1,AnnOpenC), [AnnotationTuple.hs:5:1]),
-((AnnotationTuple.hs:1:1,AnnWhere), [AnnotationTuple.hs:3:30-34]),
-((AnnotationTuple.hs:3:24-28,AnnCloseP), [AnnotationTuple.hs:3:28]),
-((AnnotationTuple.hs:3:24-28,AnnOpenP), [AnnotationTuple.hs:3:24]),
-((AnnotationTuple.hs:6:1-32,AnnAs), [AnnotationTuple.hs:6:28-29]),
-((AnnotationTuple.hs:6:1-32,AnnImport), [AnnotationTuple.hs:6:1-6]),
-((AnnotationTuple.hs:6:1-32,AnnQualified), [AnnotationTuple.hs:6:8-16]),
-((AnnotationTuple.hs:6:1-32,AnnSemi), [AnnotationTuple.hs:7:1]),
-((AnnotationTuple.hs:(8,1)-(11,14),AnnEqual), [AnnotationTuple.hs:8:5]),
-((AnnotationTuple.hs:(8,1)-(11,14),AnnFunId), [AnnotationTuple.hs:8:1-3]),
-((AnnotationTuple.hs:(8,1)-(11,14),AnnSemi), [AnnotationTuple.hs:13:1]),
-((AnnotationTuple.hs:(8,7)-(11,14),AnnIn), [AnnotationTuple.hs:11:7-8]),
-((AnnotationTuple.hs:(8,7)-(11,14),AnnLet), [AnnotationTuple.hs:8:7-9]),
-((AnnotationTuple.hs:9:9-13,AnnEqual), [AnnotationTuple.hs:9:11]),
-((AnnotationTuple.hs:9:9-13,AnnFunId), [AnnotationTuple.hs:9:9]),
-((AnnotationTuple.hs:9:9-13,AnnSemi), [AnnotationTuple.hs:10:9]),
-((AnnotationTuple.hs:10:9-13,AnnEqual), [AnnotationTuple.hs:10:11]),
-((AnnotationTuple.hs:10:9-13,AnnFunId), [AnnotationTuple.hs:10:9]),
-((AnnotationTuple.hs:11:10-14,AnnVal), [AnnotationTuple.hs:11:12]),
-((AnnotationTuple.hs:14:1-72,AnnEqual), [AnnotationTuple.hs:14:5]),
-((AnnotationTuple.hs:14:1-72,AnnFunId), [AnnotationTuple.hs:14:1-3]),
-((AnnotationTuple.hs:14:1-72,AnnSemi), [AnnotationTuple.hs:15:1]),
-((AnnotationTuple.hs:14:7-72,AnnVal), [AnnotationTuple.hs:14:13]),
-((AnnotationTuple.hs:14:19-53,AnnCloseP), [AnnotationTuple.hs:14:53]),
-((AnnotationTuple.hs:14:19-53,AnnOpenP), [AnnotationTuple.hs:14:19]),
-((AnnotationTuple.hs:14:20,AnnComma), [AnnotationTuple.hs:14:21]),
-((AnnotationTuple.hs:14:23-29,AnnComma), [AnnotationTuple.hs:14:33]),
-((AnnotationTuple.hs:14:35-37,AnnComma), [AnnotationTuple.hs:14:38]),
-((AnnotationTuple.hs:14:39,AnnComma), [AnnotationTuple.hs:14:39]),
-((AnnotationTuple.hs:14:41-52,AnnCloseS), [AnnotationTuple.hs:14:52]),
-((AnnotationTuple.hs:14:41-52,AnnOpenS), [AnnotationTuple.hs:14:41]),
-((AnnotationTuple.hs:14:42,AnnComma), [AnnotationTuple.hs:14:43]),
-((AnnotationTuple.hs:14:45,AnnComma), [AnnotationTuple.hs:14:46]),
-((AnnotationTuple.hs:14:48,AnnComma), [AnnotationTuple.hs:14:49]),
-((AnnotationTuple.hs:14:55-72,AnnCloseS), [AnnotationTuple.hs:14:72]),
-((AnnotationTuple.hs:14:55-72,AnnOpenS), [AnnotationTuple.hs:14:55]),
-((AnnotationTuple.hs:14:56-62,AnnComma), [AnnotationTuple.hs:14:63]),
-((AnnotationTuple.hs:14:61-62,AnnCloseP), [AnnotationTuple.hs:14:62]),
-((AnnotationTuple.hs:14:61-62,AnnOpenP), [AnnotationTuple.hs:14:61]),
-((AnnotationTuple.hs:16:1-41,AnnEqual), [AnnotationTuple.hs:16:5]),
-((AnnotationTuple.hs:16:1-41,AnnFunId), [AnnotationTuple.hs:16:1-3]),
-((AnnotationTuple.hs:16:1-41,AnnSemi), [AnnotationTuple.hs:17:1]),
-((AnnotationTuple.hs:16:7-27,AnnCloseP), [AnnotationTuple.hs:16:27]),
-((AnnotationTuple.hs:16:7-27,AnnOpenP), [AnnotationTuple.hs:16:7]),
-((AnnotationTuple.hs:16:8,AnnComma), [AnnotationTuple.hs:16:9]),
-((AnnotationTuple.hs:16:11-17,AnnComma), [AnnotationTuple.hs:16:18]),
-((AnnotationTuple.hs:16:20-22,AnnComma), [AnnotationTuple.hs:16:23]),
-((AnnotationTuple.hs:16:24,AnnComma), [AnnotationTuple.hs:16:24]),
-((AnnotationTuple.hs:16:25,AnnComma), [AnnotationTuple.hs:16:25]),
-((AnnotationTuple.hs:16:26,AnnComma), [AnnotationTuple.hs:16:26]),
-((AnnotationTuple.hs:16:33-41,AnnCloseP), [AnnotationTuple.hs:16:41]),
-((AnnotationTuple.hs:16:33-41,AnnOpenP), [AnnotationTuple.hs:16:33]),
-((AnnotationTuple.hs:16:39-40,AnnCloseP), [AnnotationTuple.hs:16:40]),
-((AnnotationTuple.hs:16:39-40,AnnOpenP), [AnnotationTuple.hs:16:39]),
-((AnnotationTuple.hs:18:1-28,AnnData), [AnnotationTuple.hs:18:1-4]),
-((AnnotationTuple.hs:18:1-28,AnnDcolon), [AnnotationTuple.hs:18:20-21]),
-((AnnotationTuple.hs:18:1-28,AnnFamily), [AnnotationTuple.hs:18:6-11]),
-((AnnotationTuple.hs:18:1-28,AnnSemi), [AnnotationTuple.hs:19:1]),
-((AnnotationTuple.hs:18:23,AnnRarrow), [AnnotationTuple.hs:18:25-26]),
-((AnnotationTuple.hs:18:23-28,AnnRarrow), [AnnotationTuple.hs:18:25-26]),
-((AnnotationTuple.hs:(20,1)-(24,14),AnnFunId), [AnnotationTuple.hs:20:1-5]),
-((AnnotationTuple.hs:(20,1)-(24,14),AnnSemi), [AnnotationTuple.hs:25:1]),
-((AnnotationTuple.hs:(21,7)-(24,14),AnnEqual), [AnnotationTuple.hs:24:7]),
-((AnnotationTuple.hs:(21,7)-(24,14),AnnVbar), [AnnotationTuple.hs:21:7]),
-((AnnotationTuple.hs:21:9-24,AnnComma), [AnnotationTuple.hs:22:7]),
-((AnnotationTuple.hs:21:9-24,AnnLarrow), [AnnotationTuple.hs:21:16-17]),
-((AnnotationTuple.hs:22:9-25,AnnComma), [AnnotationTuple.hs:23:7]),
-((AnnotationTuple.hs:22:9-25,AnnLarrow), [AnnotationTuple.hs:22:16-17]),
-((AnnotationTuple.hs:23:9-24,AnnLarrow), [AnnotationTuple.hs:23:16-17]),
-((AnnotationTuple.hs:26:1-10,AnnDcolon), [AnnotationTuple.hs:26:5-6]),
-((AnnotationTuple.hs:26:1-14,AnnEqual), [AnnotationTuple.hs:26:12])
-]
-
----Eof Position (should be Just)-----
-Just SrcSpanPoint "AnnotationTuple.hs" 32 1
diff --git a/testsuite/tests/ghc-api/annotations/stringSource.hs b/testsuite/tests/ghc-api/annotations/stringSource.hs
deleted file mode 100644
index b07b00a2ce..0000000000
--- a/testsuite/tests/ghc-api/annotations/stringSource.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-
--- This program must be called with GHC's libdir as the single command line
--- argument.
-module Main where
-
--- import Data.Generics
-import Data.Data
-import Data.List (intercalate)
-import System.IO
-import GHC
-import GHC.Types.Basic
-import GHC.Types.SourceText
-import GHC.Unit.Module.Warnings
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-import GHC.Data.FastString
-import GHC.Types.ForeignCall
-import GHC.Utils.Monad
-import GHC.Utils.Outputable
-import GHC.Hs.Decls
-import GHC.Data.Bag (filterBag,isEmptyBag)
-import System.Directory (removeFile)
-import System.Environment( getArgs )
-import qualified Data.Map as Map
-import Data.Dynamic ( fromDynamic,Dynamic )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
-
-testOneFile libdir fileName = do
- p <- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- setSessionDynFlags dflags
- let mn =mkModuleName fileName
- addTarget Target { targetId = TargetModule mn
- , targetAllowObjCode = True
- , targetContents = Nothing }
- load LoadAllTargets
- modSum <- getModSummary mn
- p <- parseModule modSum
- return p
-
- let tupArgs = gq (pm_parsed_source p)
-
- putStrLn (pp tupArgs)
- -- putStrLn (intercalate "\n" [showAnns anns])
-
- where
- gq ast = everything (++) ([] `mkQ` doWarningTxt
- `extQ` doImportDecl
- `extQ` doCType
- `extQ` doRuleDecl
- `extQ` doCCallTarget
- `extQ` doHsExpr
- ) ast
-
- doWarningTxt :: WarningTxt -> [(String,[Located (SourceText,FastString)])]
- doWarningTxt ((WarningTxt _ ss)) = [("w",map conv ss)]
- doWarningTxt ((DeprecatedTxt _ ss)) = [("d",map conv ss)]
-
- doImportDecl :: ImportDecl GhcPs
- -> [(String,[Located (SourceText,FastString)])]
- doImportDecl (ImportDecl _ _ _ Nothing _ _ _ _ _ _) = []
- doImportDecl (ImportDecl _ _ _ (Just ss) _ _ _ _ _ _)
- = [("i",[conv (noLoc ss)])]
-
- doCType :: CType -> [(String,[Located (SourceText,FastString)])]
- doCType (CType src (Just (Header hs hf)) c)
- = [("c",[noLoc (hs,hf),noLoc c])]
- doCType (CType src Nothing c) = [("c",[noLoc c])]
-
- doRuleDecl :: RuleDecl GhcPs
- -> [(String,[Located (SourceText,FastString)])]
- doRuleDecl (HsRule _ ss _ _ _ _ _) = [("r",[ss])]
-
- doCCallTarget :: CCallTarget
- -> [(String,[Located (SourceText,FastString)])]
- doCCallTarget (StaticTarget s f _ _) = [("st",[(noLoc (s,f))])]
-
- doHsExpr :: HsExpr GhcPs -> [(String,[Located (SourceText,FastString)])]
- doHsExpr (HsPragE _ prag _) = doPragE prag
- doHsExpr _ = []
-
- doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])]
- doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])]
-
- conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs)
-
-showAnns anns = "[\n" ++ (intercalate "\n"
- $ map (\((s,k),v)
- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
- $ Map.toList anns)
- ++ "]\n"
-
-pp a = showPprUnsafe a
-
--- ---------------------------------------------------------------------
-
--- Copied from syb for the test
-
-
--- | Generic queries of type \"r\",
--- i.e., take any \"a\" and return an \"r\"
---
-type GenericQ r = forall a. Data a => a -> r
-
-
--- | Make a generic query;
--- start from a type-specific case;
--- return a constant otherwise
---
-mkQ :: ( Typeable a
- , Typeable b
- )
- => r
- -> (b -> r)
- -> a
- -> r
-(r `mkQ` br) a = case cast a of
- Just b -> br b
- Nothing -> r
-
--- | Extend a generic query by a type-specific case
-extQ :: ( Typeable a
- , Typeable b
- )
- => (a -> q)
- -> (b -> q)
- -> a
- -> q
-extQ f g a = maybe (f a) g (cast a)
-
-
--- | Summarise all nodes in top-down, left-to-right order
-everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
-
--- Apply f to x to summarise top-level node;
--- use gmapQ to recurse into immediate subterms;
--- use ordinary foldl to reduce list of intermediate results
-
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/testsuite/tests/ghc-api/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs
deleted file mode 100644
index 0e702769c2..0000000000
--- a/testsuite/tests/ghc-api/annotations/t11430.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-
--- This program must be called with GHC's libdir as the single command line
--- argument.
-module Main where
-
--- import Data.Generics
-import Data.Data hiding (Fixity)
-import Data.List (intercalate)
-import System.IO
-import GHC
-import GHC.Types.Basic
-import GHC.Types.SourceText
-import GHC.Types.Fixity
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-import GHC.Data.FastString
-import GHC.Types.ForeignCall
-import GHC.Utils.Monad
-import GHC.Utils.Outputable
-import GHC.Hs.Decls
-import GHC.Data.Bag (filterBag,isEmptyBag)
-import System.Directory (removeFile)
-import System.Environment( getArgs )
-import qualified Data.Map as Map
-import Data.Dynamic ( fromDynamic,Dynamic )
-
-main::IO()
-main = do
- [libdir,fileName] <- getArgs
- testOneFile libdir fileName
-
-testOneFile libdir fileName = do
- p <- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- setSessionDynFlags dflags
- let mn =mkModuleName fileName
- addTarget Target { targetId = TargetModule mn
- , targetAllowObjCode = True
- , targetContents = Nothing }
- load LoadAllTargets
- modSum <- getModSummary mn
- p <- parseModule modSum
- return p
-
- let tupArgs = gq (pm_parsed_source p)
-
- putStrLn (intercalate "\n" $ map show tupArgs)
- -- putStrLn (pp tupArgs)
- -- putStrLn (intercalate "\n" [showAnns anns])
-
- where
- gq ast = everything (++) ([] `mkQ` doFixity
- `extQ` doRuleDecl
- `extQ` doHsExpr
- `extQ` doInline
- ) ast
-
- doFixity :: Fixity -> [(String,[String])]
- doFixity (Fixity (SourceText ss) _ _) = [("f",[ss])]
-
- doRuleDecl :: RuleDecl GhcPs
- -> [(String,[String])]
- doRuleDecl (HsRule _ _ (ActiveBefore (SourceText ss) _) _ _ _ _)
- = [("rb",[ss])]
- doRuleDecl (HsRule _ _ (ActiveAfter (SourceText ss) _) _ _ _ _)
- = [("ra",[ss])]
- doRuleDecl (HsRule _ _ _ _ _ _ _) = []
-
- doHsExpr :: HsExpr GhcPs -> [(String,[String])]
- doHsExpr _ = []
-
- doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _)
- = [("ib",[ss])]
- doInline (InlinePragma _ _ _ (ActiveAfter (SourceText ss) _) _)
- = [("ia",[ss])]
- doInline (InlinePragma _ _ _ _ _ ) = []
-
-showAnns anns = "[\n" ++ (intercalate "\n"
- $ map (\((s,k),v)
- -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n"))
- $ Map.toList anns)
- ++ "]\n"
-
-pp a = showPprUnsafe a
-
--- ---------------------------------------------------------------------
-
--- Copied from syb for the test
-
-
--- | Generic queries of type \"r\",
--- i.e., take any \"a\" and return an \"r\"
---
-type GenericQ r = forall a. Data a => a -> r
-
-
--- | Make a generic query;
--- start from a type-specific case;
--- return a constant otherwise
---
-mkQ :: ( Typeable a
- , Typeable b
- )
- => r
- -> (b -> r)
- -> a
- -> r
-(r `mkQ` br) a = case cast a of
- Just b -> br b
- Nothing -> r
-
--- | Extend a generic query by a type-specific case
-extQ :: ( Typeable a
- , Typeable b
- )
- => (a -> q)
- -> (b -> q)
- -> a
- -> q
-extQ f g a = maybe (f a) g (cast a)
-
-
--- | Summarise all nodes in top-down, left-to-right order
-everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
-
--- Apply f to x to summarise top-level node;
--- use gmapQ to recurse into immediate subterms;
--- use ordinary foldl to reduce list of intermediate results
-
-everything k f x = foldl k (f x) (gmapQ (everything k f) x)
diff --git a/testsuite/tests/ghc-api/annotations/CommentsTest.hs b/testsuite/tests/printer/CommentsTest.hs
index c6cf79c5da..c6cf79c5da 100644
--- a/testsuite/tests/ghc-api/annotations/CommentsTest.hs
+++ b/testsuite/tests/printer/CommentsTest.hs
diff --git a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs b/testsuite/tests/printer/InTreeAnnotations1.hs
index c454b0a237..c454b0a237 100644
--- a/testsuite/tests/ghc-api/annotations/InTreeAnnotations1.hs
+++ b/testsuite/tests/printer/InTreeAnnotations1.hs
diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile
index 6e7b5bcd10..6be7545752 100644
--- a/testsuite/tests/printer/Makefile
+++ b/testsuite/tests/printer/Makefile
@@ -547,3 +547,13 @@ PprRecordDotSyntax4:
PprRecordDotSyntaxA:
$(CHECK_PPR) $(LIBDIR) PprRecordDotSyntaxA.hs
$(CHECK_EXACT) $(LIBDIR) PprRecordDotSyntaxA.hs
+
+.PHONY: CommentsTest
+CommentsTest:
+ $(CHECK_PPR) $(LIBDIR) CommentsTest.hs
+ $(CHECK_EXACT) $(LIBDIR) CommentsTest.hs
+
+.PHONY: InTreeAnnotations1
+InTreeAnnotations1:
+ $(CHECK_PPR) $(LIBDIR) InTreeAnnotations1.hs
+ $(CHECK_EXACT) $(LIBDIR) InTreeAnnotations1.hs
diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T
index 3799b1d0ea..5c0e3fbdfa 100644
--- a/testsuite/tests/printer/all.T
+++ b/testsuite/tests/printer/all.T
@@ -121,3 +121,5 @@ test('PprRecordDotSyntax2', ignore_stderr, makefile_test, ['PprRecordDotSyntax2'
test('PprRecordDotSyntax3', ignore_stderr, makefile_test, ['PprRecordDotSyntax3'])
test('PprRecordDotSyntax4', ignore_stderr, makefile_test, ['PprRecordDotSyntax4'])
test('PprRecordDotSyntaxA', ignore_stderr, makefile_test, ['PprRecordDotSyntaxA'])
+test('CommentsTest', ignore_stderr, makefile_test, ['CommentsTest'])
+test('InTreeAnnotations1', ignore_stderr, makefile_test, ['InTreeAnnotations1'])
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 8f4f89e265..80ef0eb19c 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -50,17 +50,17 @@ import Types
-- ---------------------------------------------------------------------
-exactPrint :: ExactPrint ast => Located ast -> ApiAnns -> String
-exactPrint ast anns = runIdentity (runEP anns stringOptions (markAnnotated ast))
+exactPrint :: ExactPrint ast => Located ast -> String
+exactPrint ast = runIdentity (runEP stringOptions (markAnnotated ast))
type EP w m a = RWST (PrintOptions m w) (EPWriter w) EPState m a
type EPP a = EP String Identity a
-runEP :: ApiAnns -> PrintOptions Identity String
+runEP :: PrintOptions Identity String
-> Annotated () -> Identity String
-runEP anns epReader action =
+runEP epReader action =
fmap (output . snd) .
- (\next -> execRWST next epReader (defaultEPState anns))
+ (\next -> execRWST next epReader defaultEPState)
. xx $ action
xx :: Annotated () -> EP String Identity ()
@@ -69,10 +69,9 @@ xx = id
-- ---------------------------------------------------------------------
-defaultEPState :: ApiAnns -> EPState
-defaultEPState as = EPState
+defaultEPState :: EPState
+defaultEPState = EPState
{ epPos = (1,1)
- , epApiAnns = as
, dLHS = 1
, pMarkLayout = False
, pLHS = 1
@@ -80,7 +79,7 @@ defaultEPState as = EPState
, dPriorEndPosition = (1,1)
, uAnchorSpan = badRealSrcSpan
, uExtraDP = Nothing
- , epComments = rogueComments as
+ , epComments = []
}
@@ -130,9 +129,7 @@ instance Monoid w => Monoid (EPWriter w) where
mempty = EPWriter mempty
data EPState = EPState
- { epApiAnns :: !ApiAnns
-
- , uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST
+ { uAnchorSpan :: !RealSrcSpan -- ^ in pre-changed AST
-- reference frame, from
-- Annotation
, uExtraDP :: !(Maybe Anchor) -- ^ Used to anchor a
@@ -3628,7 +3625,9 @@ instance ExactPrint (Pat GhcPs) where
-- filtered.
let pun_RDR = "pun-right-hand-side"
when (showPprUnsafe n /= pun_RDR) $ markAnnotated n
- -- | LazyPat an pat)
+ exact (LazyPat an pat) = do
+ markApiAnn an AnnTilde
+ markAnnotated pat
exact (AsPat an n pat) = do
markAnnotated n
markApiAnn an AnnAt
@@ -3638,7 +3637,10 @@ instance ExactPrint (Pat GhcPs) where
markAnnotated pat
markAnnKw an ap_close AnnCloseP
- -- | BangPat an pat)
+ exact (BangPat an pat) = do
+ markApiAnn an AnnBang
+ markAnnotated pat
+
exact (ListPat an pats) = markAnnList an (markAnnotated pats)
exact (TuplePat an pats boxity) = do
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 23fb0a825e..48b9da62c4 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -36,47 +36,48 @@ _tt :: IO ()
-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib"
_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
- -- "../../testsuite/tests/ghc-api/exactprint/RenameCase1.hs" changeRenameCase1
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet2.hs" changeLayoutLet2
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet3.hs" changeLayoutLet3
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet4.hs" changeLayoutLet3
- -- "../../testsuite/tests/ghc-api/exactprint/Rename1.hs" changeRename1
- -- "../../testsuite/tests/ghc-api/exactprint/Rename2.hs" changeRename2
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn1.hs" changeLayoutIn1
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3.hs" changeLayoutIn3
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3a.hs" changeLayoutIn3
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3b.hs" changeLayoutIn3
- -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn4.hs" changeLayoutIn4
- -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" changeLocToName
- -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" changeLetIn1
- -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" changeWhereIn4
- -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" changeAddDecl1
- -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" changeAddDecl2
- -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" changeAddDecl3
- -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" changeLocalDecls
- -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" changeLocalDecls2
- -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" changeWhereIn3a
- -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" changeWhereIn3b
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" addLocaLDecl1
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl2.hs" addLocaLDecl2
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" addLocaLDecl3
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" addLocaLDecl4
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" addLocaLDecl5
- -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6)
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" rmDecl1
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" rmDecl2
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" rmDecl3
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" rmDecl4
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl5.hs" rmDecl5
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl6.hs" rmDecl6
- -- "../../testsuite/tests/ghc-api/exactprint/RmDecl7.hs" rmDecl7
- -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig1.hs" rmTypeSig1
- -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" rmTypeSig2
- -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" addHiding1
- -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" addHiding2
+
+ -- "../../testsuite/tests/ghc-api/exactprint/RenameCase1.hs" (Just changeRenameCase1)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet2.hs" (Just changeLayoutLet2)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet3.hs" (Just changeLayoutLet3)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet4.hs" (Just changeLayoutLet3)
+ -- "../../testsuite/tests/ghc-api/exactprint/Rename1.hs" (Just changeRename1)
+ -- "../../testsuite/tests/ghc-api/exactprint/Rename2.hs" (Just changeRename2)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn1.hs" (Just changeLayoutIn1)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3.hs" (Just changeLayoutIn3)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3a.hs" (Just changeLayoutIn3)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3b.hs" (Just changeLayoutIn3)
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn4.hs" (Just changeLayoutIn4)
+ -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" (Just changeLocToName)
+ -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1)
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3)
+ -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls)
+ -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a)
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl2.hs" (Just addLocaLDecl2)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" (Just addLocaLDecl3)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just (Just addLocaLDecl6))
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" (Just rmDecl4)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl5.hs" (Just rmDecl5)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl6.hs" (Just rmDecl6)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl7.hs" (Just rmDecl7)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig1.hs" (Just rmTypeSig1)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" (Just rmTypeSig2)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" (Just addHiding1)
+ -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" (Just addHiding2)
-- "../../testsuite/tests/printer/Ppr001.hs" Nothing
- "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs" Nothing
-- "../../testsuite/tests/hiefile/should_compile/Constructors.hs" Nothing
-- "../../testsuite/tests/hiefile/should_compile/Scopes.hs" Nothing
-- "../../testsuite/tests/hiefile/should_compile/hie008.hs" Nothing
@@ -171,6 +172,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin
-- "../../testsuite/tests/printer/Test16230.hs" Nothing
-- "../../testsuite/tests/printer/Test16236.hs" Nothing
-- "../../testsuite/tests/printer/Test17519.hs" Nothing
+ "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing
-- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing
-- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing
@@ -232,8 +234,8 @@ changers =
usage :: String
usage = unlines
- [ "usage: check-ppr (libdir) (file)"
- , " check-ppr (libdir) (changer) (file)"
+ [ "usage: check-exact (libdir) (file)"
+ , " check-exact (libdir) (file) (changer)"
, ""
, "where libdir is the GHC library directory (e.g. the output of"
, "ghc --print-libdir), file is the file to parse"
@@ -246,13 +248,14 @@ main = do
args <- getArgs
case args of
[libdir,fileName] -> testOneFile changers libdir fileName Nothing
- [libdir,fileName,changerStr] -> case lookup changerStr changers of
- Just doChange -> testOneFile changers libdir fileName (Just doChange)
- Nothing -> do
- putStrLn $ "exactprint: could not find changer for [" ++ changerStr ++ "]"
- putStrLn $ "valid changers are:\n" ++ unlines (map fst changers)
- putStrLn $ "(see utils/check-exact/Main.hs)"
- exitFailure
+ [libdir,fileName,changerStr] -> do
+ case lookup changerStr changers of
+ Just doChange -> testOneFile changers libdir fileName (Just doChange)
+ Nothing -> do
+ putStrLn $ "exactprint: could not find changer for [" ++ changerStr ++ "]"
+ putStrLn $ "valid changers are:\n" ++ unlines (map fst changers)
+ putStrLn $ "(see utils/check-exact/Main.hs)"
+ exitFailure
_ -> putStrLn usage
deriving instance Data Token
@@ -266,11 +269,10 @@ writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8
testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO ()
testOneFile _ libdir fileName mchanger = do
(p,_toks) <- parseOneFile libdir fileName
- -- putStrLn $ "\n\ngot p" ++ showAst (take 4 $ reverse toks)
+ -- putStrLn $ "\n\ngot p" ++ showAst (take 4 $ reverse _toks)
let
origAst = ppAst (pm_parsed_source p)
- anns' = pm_annotations p
- pped = exactPrint (pm_parsed_source p) anns'
+ pped = exactPrint (pm_parsed_source p)
newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
newFileChanged = dropExtension fileName <.> "changed" <.> takeExtension fileName
@@ -284,7 +286,7 @@ testOneFile _ libdir fileName mchanger = do
(changedSourceOk, expectedSource, changedSource) <- case mchanger of
Just changer -> do
- (pped', ast') <- exactprintWithChange libdir changer (pm_parsed_source p) anns'
+ (pped', ast') <- exactprintWithChange libdir changer (pm_parsed_source p)
writeBinFile changedAstFile (ppAst ast')
writeBinFile newFileChanged pped'
@@ -299,9 +301,8 @@ testOneFile _ libdir fileName mchanger = do
newAstStr = ppAst (pm_parsed_source p')
writeBinFile newAstFile newAstStr
+ let origAstOk = origAst == newAstStr
- let
- origAstOk = origAst == newAstStr
if origAstOk && changedSourceOk
then do
exitSuccess
@@ -350,63 +351,47 @@ parseOneFile libdir fileName = do
toks <- getTokenStream (ms_mod modSum)
return (pm, toks)
- -- getTokenStream :: GhcMonad m => Module -> m [Located Token]
-
--- getPragmas :: ApiAnns -> String
--- getPragmas anns' = pragmaStr
--- where
--- tokComment (L _ (AnnBlockComment s)) = s
--- tokComment (L _ (AnnLineComment s)) = s
--- tokComment _ = ""
-
--- comments' = map tokComment $ sortRealLocated $ apiAnnRogueComments anns'
--- pragmas = filter (\c -> isPrefixOf "{-#" c ) comments'
--- pragmaStr = intercalate "\n" pragmas
-
--- pp :: (Outputable a) => a -> String
--- pp a = showPpr unsafeGlobalDynFlags a
-- ---------------------------------------------------------------------
-exactprintWithChange :: FilePath -> Changer -> ParsedSource -> ApiAnns -> IO (String, ParsedSource)
-exactprintWithChange libdir f p apiAnns = do
- debugM $ "exactprintWithChange:apiAnns=" ++ showGhc (apiAnnRogueComments apiAnns)
- (apiAnns',p') <- f libdir apiAnns p
- return (exactPrint p' apiAnns', p')
+exactprintWithChange :: FilePath -> Changer -> ParsedSource -> IO (String, ParsedSource)
+exactprintWithChange libdir f p = do
+ p' <- f libdir p
+ return (exactPrint p', p')
-- First param is libdir
-type Changer = FilePath -> (ApiAnns -> ParsedSource -> IO (ApiAnns,ParsedSource))
+type Changer = FilePath -> (ParsedSource -> IO ParsedSource)
noChange :: Changer
-noChange _libdir ans parsed = return (ans,parsed)
+noChange _libdir parsed = return parsed
changeRenameCase1 :: Changer
-changeRenameCase1 _libdir ans parsed = return (ans,rename "bazLonger" [((3,15),(3,18))] parsed)
+changeRenameCase1 _libdir parsed = return (rename "bazLonger" [((3,15),(3,18))] parsed)
changeLayoutLet2 :: Changer
-changeLayoutLet2 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)
+changeLayoutLet2 _libdir parsed = return (rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)
changeLayoutLet3 :: Changer
-changeLayoutLet3 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
+changeLayoutLet3 _libdir parsed = return (rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
changeLayoutIn1 :: Changer
-changeLayoutIn1 _libdir ans parsed = return (ans,rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)
+changeLayoutIn1 _libdir parsed = return (rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)
changeLayoutIn3 :: Changer
-changeLayoutIn3 _libdir ans parsed = return (ans,rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
+changeLayoutIn3 _libdir parsed = return (rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
changeLayoutIn4 :: Changer
-changeLayoutIn4 _libdir ans parsed = return (ans,rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)
+changeLayoutIn4 _libdir parsed = return (rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)
changeLocToName :: Changer
-changeLocToName _libdir ans parsed = return (ans,rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)
+changeLocToName _libdir parsed = return (rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)
changeRename1 :: Changer
-changeRename1 _libdir ans parsed = return (ans,rename "bar2" [((3,1),(3,4))] parsed)
+changeRename1 _libdir parsed = return (rename "bar2" [((3,1),(3,4))] parsed)
changeRename2 :: Changer
-changeRename2 _libdir ans parsed = return (ans,rename "joe" [((2,1),(2,5))] parsed)
+changeRename2 _libdir parsed = return (rename "joe" [((2,1),(2,5))] parsed)
rename :: (Data a) => String -> [(Pos, Pos)] -> a -> a
rename newNameStr spans' a
@@ -425,8 +410,8 @@ rename newNameStr spans' a
-- ---------------------------------------------------------------------
changeWhereIn4 :: Changer
-changeWhereIn4 _libdir ans parsed
- = return (ans,everywhere (mkT replace) parsed)
+changeWhereIn4 _libdir parsed
+ = return (everywhere (mkT replace) parsed)
where
replace :: LocatedN RdrName -> LocatedN RdrName
replace (L ln _n)
@@ -436,8 +421,8 @@ changeWhereIn4 _libdir ans parsed
-- ---------------------------------------------------------------------
changeLetIn1 :: Changer
-changeLetIn1 _libdir ans parsed
- = return (ans,everywhere (mkT replace) parsed)
+changeLetIn1 _libdir parsed
+ = return (everywhere (mkT replace) parsed)
where
replace :: HsExpr GhcPs -> HsExpr GhcPs
replace (HsLet (ApiAnn anc (AnnsLet l _i) cs) localDecls expr)
@@ -448,27 +433,29 @@ changeLetIn1 _libdir ans parsed
(L (SrcSpanAnn _ le) e) = expr
a = (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan le) (MovedAnchor (DP 0 1))) mempty noCom) le)
expr' = L a e
- in (HsLet (ApiAnn anc (AnnsLet l (AD (DP 1 0))) cs) (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
+ in (HsLet (ApiAnn anc (AnnsLet l (AD (DP 1 0))) cs)
+ (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
replace x = x
+
-- ---------------------------------------------------------------------
-- | Add a declaration to AddDecl
changeAddDecl1 :: Changer
-changeAddDecl1 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+changeAddDecl1 libdir top = do
+ Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
let decl' = setEntryDP' decl (DP 2 0)
let (p',(_,_),_) = runTransform mempty doAddDecl
doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
replaceTopLevelDecls m = insertAtStart m decl'
- return (ans,p')
+ return p'
-- ---------------------------------------------------------------------
changeAddDecl2 :: Changer
-changeAddDecl2 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+changeAddDecl2 libdir top = do
+ Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
let decl' = setEntryDP' decl (DP 2 0)
let top' = anchorEof top
@@ -476,12 +463,13 @@ changeAddDecl2 libdir ans top = do
doAddDecl = everywhereM (mkM replaceTopLevelDecls) top'
replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
replaceTopLevelDecls m = insertAtEnd m decl'
- return (ans,p')
+ return p'
-- ---------------------------------------------------------------------
+
changeAddDecl3 :: Changer
-changeAddDecl3 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+changeAddDecl3 libdir top = do
+ Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
let decl' = setEntryDP' decl (DP 2 0)
let (p',(_,_),_) = runTransform mempty doAddDecl
@@ -491,15 +479,15 @@ changeAddDecl3 libdir ans top = do
l2' = setEntryDP' l2 (DP 2 0)
replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
replaceTopLevelDecls m = insertAt f m decl'
- return (ans,p')
+ return p'
-- ---------------------------------------------------------------------
-- | Add a local declaration with signature to LocalDecl
changeLocalDecls :: Changer
-changeLocalDecls libdir ans (L l p) = do
- Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
- Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+changeLocalDecls libdir (L l p) = do
+ Right s@(L ls (SigD _ sig)) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
+ Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
let decl' = setEntryDP' (L ld decl) (DP 1 0)
let sig' = setEntryDP' (L ls sig) (DP 0 0)
let (p',(_,_),_w) = runTransform mempty doAddLocal
@@ -521,16 +509,16 @@ changeLocalDecls libdir ans (L l p) = do
(sig':os':oldSigs)))
return (L lm (Match an mln pats (GRHSs noExtField rhs binds')))
replaceLocalBinds x = return x
- return (ans,L l p')
+ return (L l p')
-- ---------------------------------------------------------------------
-- | Add a local declaration with signature to LocalDecl, where there was no
-- prior local decl. So it adds a "where" annotation.
changeLocalDecls2 :: Changer
-changeLocalDecls2 libdir ans (L l p) = do
- Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
+changeLocalDecls2 libdir (L l p) = do
+ Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ Right s@(L ls (SigD _ sig)) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
let decl' = setEntryDP' (L ld decl) (DP 1 0)
let sig' = setEntryDP' (L ls sig) (DP 0 2)
let (p',(_,_),_w) = runTransform mempty doAddLocal
@@ -551,25 +539,25 @@ changeLocalDecls2 libdir ans (L l p) = do
[sig']))
return (L lm (Match ma mln pats (GRHSs noExtField rhs binds)))
replaceLocalBinds x = return x
- return (ans,L l p')
+ return (L l p')
-- ---------------------------------------------------------------------
-- | Check that balanceCommentsList is idempotent
changeWhereIn3a :: Changer
-changeWhereIn3a _libdir ans (L l p) = do
+changeWhereIn3a _libdir (L l p) = do
let decls0 = hsmodDecls p
(decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
(_de0:_:de1:_d2:_) = decls
debugM $ unlines w
debugM $ "changeWhereIn3a:de1:" ++ showAst de1
let p2 = p { hsmodDecls = decls}
- return (ans,L l p2)
+ return (L l p2)
-- ---------------------------------------------------------------------
changeWhereIn3b :: Changer
-changeWhereIn3b _libdir ans (L l p) = do
+changeWhereIn3b _libdir (L l p) = do
let decls0 = hsmodDecls p
(decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
(de0:_:de1:d2:_) = decls
@@ -580,13 +568,13 @@ changeWhereIn3b _libdir ans (L l p) = do
debugM $ unlines w
debugM $ "changeWhereIn3b:de1':" ++ showAst de1'
let p2 = p { hsmodDecls = decls'}
- return (ans,L l p2)
+ return (L l p2)
-- ---------------------------------------------------------------------
addLocaLDecl1 :: Changer
-addLocaLDecl1 libdir ans lp = do
- Right (_, (L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+addLocaLDecl1 libdir lp = do
+ Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
let decl' = setEntryDP' (L ld decl) (DP 1 4)
doAddLocal = do
(de1:d2:d3:_) <- hsDecls lp
@@ -597,13 +585,13 @@ addLocaLDecl1 libdir ans lp = do
(lp',(_,_),w) <- runTransformT mempty doAddLocal
debugM $ "addLocaLDecl1:" ++ intercalate "\n" w
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addLocaLDecl2 :: Changer
-addLocaLDecl2 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+addLocaLDecl2 libdir lp = do
+ Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
let
doAddLocal = do
(de1:d2:_) <- hsDecls lp
@@ -618,14 +606,13 @@ addLocaLDecl2 libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doAddLocal
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addLocaLDecl3 :: Changer
-addLocaLDecl3 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- -- Right (_, newDecl@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "jj = 2")
+addLocaLDecl3 libdir lp = do
+ Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
let
doAddLocal = do
(de1:d2:_) <- hsDecls lp
@@ -639,15 +626,14 @@ addLocaLDecl3 libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doAddLocal
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addLocaLDecl4 :: Changer
-addLocaLDecl4 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- Right (_, newSig) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
- -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp
+addLocaLDecl4 libdir lp = do
+ Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ Right newSig <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
let
doAddLocal = do
(parent:ds) <- hsDecls lp
@@ -662,13 +648,13 @@ addLocaLDecl4 libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doAddLocal
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addLocaLDecl5 :: Changer
-addLocaLDecl5 _libdir ans lp = do
+addLocaLDecl5 _libdir lp = do
let
doAddLocal = do
decls <- hsDecls lp
@@ -683,13 +669,13 @@ addLocaLDecl5 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doAddLocal
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addLocaLDecl6 :: Changer
-addLocaLDecl6 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")
+addLocaLDecl6 libdir lp = do
+ Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")
let
newDecl' = setEntryDP' newDecl (DP 1 4)
doAddLocal = do
@@ -706,12 +692,12 @@ addLocaLDecl6 libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doAddLocal
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl1 :: Changer
-rmDecl1 _libdir ans lp = do
+rmDecl1 _libdir lp = do
let doRmDecl = do
tlDecs0 <- hsDecls lp
tlDecs <- balanceCommentsList $ captureLineSpacing tlDecs0
@@ -721,12 +707,12 @@ rmDecl1 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl2 :: Changer
-rmDecl2 _libdir ans lp = do
+rmDecl2 _libdir lp = do
let
doRmDecl = do
let
@@ -742,12 +728,12 @@ rmDecl2 _libdir ans lp = do
let (lp',(_,_),_w) = runTransform mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl3 :: Changer
-rmDecl3 _libdir ans lp = do
+rmDecl3 _libdir lp = do
let
doRmDecl = do
[de1,d2] <- hsDecls lp
@@ -760,12 +746,12 @@ rmDecl3 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl4 :: Changer
-rmDecl4 _libdir ans lp = do
+rmDecl4 _libdir lp = do
let
doRmDecl = do
[de1] <- hsDecls lp
@@ -780,12 +766,12 @@ rmDecl4 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl5 :: Changer
-rmDecl5 _libdir ans lp = do
+rmDecl5 _libdir lp = do
let
doRmDecl = do
let
@@ -802,12 +788,12 @@ rmDecl5 _libdir ans lp = do
let (lp',(_,_),_w) = runTransform mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl6 :: Changer
-rmDecl6 _libdir ans lp = do
+rmDecl6 _libdir lp = do
let
doRmDecl = do
[de1] <- hsDecls lp
@@ -822,12 +808,12 @@ rmDecl6 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmDecl7 :: Changer
-rmDecl7 _libdir ans lp = do
+rmDecl7 _libdir lp = do
let
doRmDecl = do
tlDecs <- hsDecls lp
@@ -839,12 +825,12 @@ rmDecl7 _libdir ans lp = do
(lp',(_,_),_w) <- runTransformT mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmTypeSig1 :: Changer
-rmTypeSig1 _libdir ans lp = do
+rmTypeSig1 _libdir lp = do
let doRmDecl = do
tlDecs <- hsDecls lp
let (s0:de1:d2) = tlDecs
@@ -856,12 +842,12 @@ rmTypeSig1 _libdir ans lp = do
let (lp',(_,_),_w) = runTransform mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
rmTypeSig2 :: Changer
-rmTypeSig2 _libdir ans lp = do
+rmTypeSig2 _libdir lp = do
let doRmDecl = do
tlDecs <- hsDecls lp
let [de1] = tlDecs
@@ -873,12 +859,12 @@ rmTypeSig2 _libdir ans lp = do
let (lp',(_,_),_w) = runTransform mempty doRmDecl
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addHiding1 :: Changer
-addHiding1 _libdir ans (L l p) = do
+addHiding1 _libdir (L l p) = do
let doTransform = do
l0 <- uniqueSrcSpanT
l1 <- uniqueSrcSpanT
@@ -902,12 +888,12 @@ addHiding1 _libdir ans (L l p) = do
let (lp',(_ans',_),_w) = runTransform mempty doTransform
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
addHiding2 :: Changer
-addHiding2 _libdir ans (L l p) = do
+addHiding2 _libdir (L l p) = do
let doTransform = do
l1 <- uniqueSrcSpanT
l2 <- uniqueSrcSpanT
@@ -933,7 +919,7 @@ addHiding2 _libdir ans (L l p) = do
let (lp',(_ans',_),_w) = runTransform mempty doTransform
debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
+ return lp'
-- ---------------------------------------------------------------------
diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs
index 403ee3e55d..d4b1756ef9 100644
--- a/utils/check-exact/Parsers.hs
+++ b/utils/check-exact/Parsers.hs
@@ -88,7 +88,7 @@ parseWith :: GHC.DynFlags
parseWith dflags fileName parser s =
case runParser parser dflags fileName s of
GHC.PFailed pst -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)
- GHC.POk (mkApiAnns -> apianns) pmod -> Right (apianns, pmod)
+ GHC.POk _ pmod -> Right pmod
parseWithECP :: (GHC.DisambECP w)
@@ -102,7 +102,7 @@ parseWithECP dflags fileName parser s =
-- case runParser (parser >>= \p -> GHC.runECP_P p) dflags fileName s of
case runParser (parser >>= \p -> GHC.runPV $ GHC.unECP p) dflags fileName s of
GHC.PFailed pst -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)
- GHC.POk (mkApiAnns -> apianns) pmod -> Right (apianns, pmod)
+ GHC.POk _ pmod -> Right pmod
-- ---------------------------------------------------------------------
@@ -134,7 +134,7 @@ parseFile = runParser GHC.parseModule
-- ---------------------------------------------------------------------
-type ParseResult a = Either GHC.ErrorMessages (GHC.ApiAnns, a)
+type ParseResult a = Either GHC.ErrorMessages a
type Parser a = GHC.DynFlags -> FilePath -> String
-> ParseResult a
@@ -193,7 +193,7 @@ parseModuleFromStringInternal dflags fileName str =
let (str1, lp) = stripLinePragmas str
res = case runParser GHC.parseModule dflags fileName str1 of
GHC.PFailed pst -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)
- GHC.POk x pmod -> Right (mkApiAnns x, lp, dflags, pmod)
+ GHC.POk _ pmod -> Right (lp, dflags, pmod)
in postParseTransform res
parseModuleWithOptions :: FilePath -- ^ GHC libdir
@@ -225,7 +225,7 @@ parseModuleApiAnnsWithCpp
-> IO
( Either
GHC.ErrorMessages
- (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
+ ([Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCpp libdir cppOptions file = ghcWrapper libdir $ do
dflags <- initDynFlags file
@@ -247,7 +247,7 @@ parseModuleApiAnnsWithCppInternal
-> m
( Either
GHC.ErrorMessages
- (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
+ ([Comment], GHC.DynFlags, GHC.ParsedSource)
)
parseModuleApiAnnsWithCppInternal cppOptions dflags file = do
let useCpp = GHC.xopt LangExt.Cpp dflags
@@ -264,17 +264,17 @@ parseModuleApiAnnsWithCppInternal cppOptions dflags file = do
return $
case parseFile dflags' file fileContents of
GHC.PFailed pst -> Left (fmap GHC.pprError $ GHC.getErrorMessages pst)
- GHC.POk (mkApiAnns -> apianns) pmod ->
- Right $ (apianns, injectedComments, dflags', pmod)
+ GHC.POk _ pmod ->
+ Right $ (injectedComments, dflags', pmod)
-- | Internal function. Exposed if you want to muck with DynFlags
-- before parsing. Or after parsing.
postParseTransform
- :: Either a (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
- -> Either a (GHC.ApiAnns, GHC.ParsedSource)
+ :: Either a ([Comment], GHC.DynFlags, GHC.ParsedSource)
+ -> Either a (GHC.ParsedSource)
postParseTransform parseRes = fmap mkAnns parseRes
where
- mkAnns (apianns, _cs, _, m) = (apianns, m)
+ mkAnns (_cs, _, m) = m
-- (relativiseApiAnnsWithOptions opts cs m apianns, m)
-- | Internal function. Initializes DynFlags value for parsing.
@@ -324,9 +324,3 @@ initDynFlagsPure fp s = do
return dflags3
-- ---------------------------------------------------------------------
-
-mkApiAnns :: GHC.PState -> GHC.ApiAnns
-mkApiAnns pstate
- = GHC.ApiAnns {
- GHC.apiAnnRogueComments = GHC.comment_q pstate
- }
diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs
index 23f166514f..5741bb66dd 100644
--- a/utils/check-exact/Utils.hs
+++ b/utils/check-exact/Utils.hs
@@ -306,24 +306,6 @@ mkKWComment kw (AD dp)
comment2dp :: (Comment, DeltaPos) -> (KeywordId, DeltaPos)
comment2dp = first AnnComment
-
-rogueComments :: ApiAnns -> [Comment]
-rogueComments as = extractRogueComments as
- -- where
- -- go :: Comment -> (Comment, DeltaPos)
- -- go c@(Comment _str loc _mo) = (c, ss2delta (1,1) loc)
-
--- extractComments :: ApiAnns -> [Comment]
--- extractComments anns
--- -- cm has type :: Map RealSrcSpan [LAnnotationComment]
--- -- = map tokComment . sortRealLocated . concat $ Map.elems (apiAnnComments anns)
--- = []
-
-extractRogueComments :: ApiAnns -> [Comment]
-extractRogueComments anns
- -- cm has type :: Map RealSrcSpan [LAnnotationComment]
- = map tokComment $ sortAnchorLocated (apiAnnRogueComments anns)
-
sortAnchorLocated :: [GenLocated Anchor a] -> [GenLocated Anchor a]
sortAnchorLocated = sortBy (compare `on` (anchor . getLoc))
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index f537a0085c..0973d2ccfe 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -45,8 +45,7 @@ testOneFile libdir fileName = do
$ showAstData BlankSrcSpan BlankApiAnnotations
$ eraseLayoutInfo (pm_parsed_source p)
pped = pragmas ++ "\n" ++ pp (pm_parsed_source p)
- anns' = pm_annotations p
- pragmas = getPragmas anns'
+ pragmas = getPragmas (pm_parsed_source p)
newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
astFile = fileName <.> "ast"
@@ -98,15 +97,15 @@ parseOneFile libdir fileName = do
++ show (map (ml_hs_file . ms_location) xs)
parseModule modSum
-getPragmas :: ApiAnns -> String
-getPragmas anns' = pragmaStr
+getPragmas :: Located HsModule -> String
+getPragmas (L _ (HsModule { hsmodAnn = anns'})) = pragmaStr
where
tokComment (L _ (AnnComment (AnnBlockComment s) _)) = s
tokComment (L _ (AnnComment (AnnLineComment s) _)) = s
tokComment _ = ""
cmp (L l1 _) (L l2 _) = compare (anchor l1) (anchor l2)
- comments' = map tokComment $ sortBy cmp $ apiAnnRogueComments anns'
+ comments' = map tokComment $ sortBy cmp $ priorComments $ apiAnnComments anns'
pragmas = filter (\c -> isPrefixOf "{-#" c ) comments'
pragmaStr = intercalate "\n" pragmas