summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-09-10 18:20:45 +0200
committerSylvain Henry <sylvain@haskus.fr>2020-09-29 17:24:03 +0200
commit8e3f00dd24936b6674d0a2322f8410125968583e (patch)
treed9630cc481aff867c16300b049b28e8cdd1a7aa2
parent4365d77a0b306ada61654c3648b844cfa0f4fdcf (diff)
downloadhaskell-8e3f00dd24936b6674d0a2322f8410125968583e.tar.gz
Make the parser module less dependent on DynFlags
Bump haddock submodule
-rw-r--r--compiler/GHC.hs11
-rw-r--r--compiler/GHC/Cmm/Parser.y4
-rw-r--r--compiler/GHC/Driver/Backpack.hs3
-rw-r--r--compiler/GHC/Driver/Config.hs14
-rw-r--r--compiler/GHC/Driver/Main.hs5
-rw-r--r--compiler/GHC/Parser.y6
-rw-r--r--compiler/GHC/Parser/Header.hs9
-rw-r--r--compiler/GHC/Parser/Lexer.x104
-rw-r--r--compiler/GHC/Parser/PostProcess.hs2
-rw-r--r--compiler/GHC/Runtime/Eval.hs18
-rw-r--r--ghc/GHCi/UI.hs5
-rw-r--r--testsuite/tests/ghc-api/T11579.hs4
-rw-r--r--testsuite/tests/ghc-api/T9015.hs4
-rw-r--r--testsuite/tests/parser/should_run/CountParserDeps.hs9
m---------utils/haddock0
15 files changed, 109 insertions, 89 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index e92f7f16aa..979e42ccc9 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -303,6 +303,7 @@ import GHCi.RemoteTypes
import GHC.Core.Ppr.TyThing ( pprFamInst )
import GHC.Driver.Backend
+import GHC.Driver.Config
import GHC.Driver.Main
import GHC.Driver.Make
import GHC.Driver.Hooks
@@ -1426,9 +1427,9 @@ getModuleSourceAndFlags mod = do
-- Throws a 'GHC.Driver.Types.SourceError' on parse error.
getTokenStream :: GhcMonad m => Module -> m [Located Token]
getTokenStream mod = do
- (sourceFile, source, flags) <- getModuleSourceAndFlags mod
+ (sourceFile, source, dflags) <- getModuleSourceAndFlags mod
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
- case lexTokenStream source startLoc flags of
+ case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return ts
PFailed pst ->
do dflags <- getDynFlags
@@ -1439,9 +1440,9 @@ getTokenStream mod = do
-- 'showRichTokenStream'.
getRichTokenStream :: GhcMonad m => Module -> m [(Located Token, String)]
getRichTokenStream mod = do
- (sourceFile, source, flags) <- getModuleSourceAndFlags mod
+ (sourceFile, source, dflags) <- getModuleSourceAndFlags mod
let startLoc = mkRealSrcLoc (mkFastString sourceFile) 1 1
- case lexTokenStream source startLoc flags of
+ case lexTokenStream (initParserOpts dflags) source startLoc of
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed pst ->
do dflags <- getDynFlags
@@ -1616,7 +1617,7 @@ parser str dflags filename =
loc = mkRealSrcLoc (mkFastString filename) 1 1
buf = stringToStringBuffer str
in
- case unP Parser.parseModule (mkPState dflags buf loc) of
+ case unP Parser.parseModule (initParserState (initParserOpts dflags) buf loc) of
PFailed pst ->
let (warns,errs) = getMessages pst dflags in
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 3771a0e82c..e1e89e9977 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -249,6 +249,7 @@ import GHC.Types.Unique.FM
import GHC.Types.SrcLoc
import GHC.Driver.Session
import GHC.Driver.Ppr
+import GHC.Driver.Config
import GHC.Utils.Error
import GHC.Data.StringBuffer
import GHC.Data.FastString
@@ -1432,7 +1433,8 @@ parseCmmFile dflags filename = withTiming dflags (text "ParseCmm"<+>brackets (te
buf <- hGetStringBuffer filename
let
init_loc = mkRealSrcLoc (mkFastString filename) 1 1
- init_state = (mkPState dflags buf init_loc) { lex_state = [0] }
+ opts = initParserOpts dflags
+ init_state = (initParserState opts buf init_loc) { lex_state = [0] }
-- reset the lex_state: the Lexer monad leaves some stuff
-- in there we don't want.
case unPD cmmParse dflags init_state of
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 36be9d15db..494cffb785 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -27,6 +27,7 @@ import GHC.Parser.Annotation
import GHC hiding (Failed, Succeeded)
import GHC.Parser
import GHC.Parser.Lexer
+import GHC.Driver.Config
import GHC.Driver.Monad
import GHC.Driver.Session
import GHC.Driver.Ppr
@@ -83,7 +84,7 @@ doBackpack [src_filename] = do
buf <- liftIO $ hGetStringBuffer src_filename
let loc = mkRealSrcLoc (mkFastString src_filename) 1 1 -- TODO: not great
- case unP parseBackpack (mkPState dflags buf loc) of
+ case unP parseBackpack (initParserState (initParserOpts dflags) buf loc) of
PFailed pst -> throwErrors (getErrorMessages pst dflags)
POk _ pkgname_bkp -> do
-- OK, so we have an LHsUnit PackageName, but we want an
diff --git a/compiler/GHC/Driver/Config.hs b/compiler/GHC/Driver/Config.hs
index f178597d1c..9cb566437b 100644
--- a/compiler/GHC/Driver/Config.hs
+++ b/compiler/GHC/Driver/Config.hs
@@ -2,6 +2,7 @@
module GHC.Driver.Config
( initOptCoercionOpts
, initSimpleOpts
+ , initParserOpts
)
where
@@ -10,6 +11,7 @@ import GHC.Prelude
import GHC.Driver.Session
import GHC.Core.SimpleOpt
import GHC.Core.Coercion.Opt
+import GHC.Parser.Lexer
-- | Initialise coercion optimiser configuration from DynFlags
initOptCoercionOpts :: DynFlags -> OptCoercionOpts
@@ -23,3 +25,15 @@ initSimpleOpts dflags = SimpleOpts
{ so_uf_opts = unfoldingOpts dflags
, so_co_opts = initOptCoercionOpts dflags
}
+
+-- | Extracts the flag information needed for parsing
+initParserOpts :: DynFlags -> ParserOpts
+initParserOpts =
+ mkParserOpts
+ <$> warningFlags
+ <*> extensionFlags
+ <*> homeUnitId_
+ <*> safeImportsOn
+ <*> gopt Opt_Haddock
+ <*> gopt Opt_KeepRawTokenStream
+ <*> const True
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 44babeec18..593251a253 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -138,6 +138,7 @@ import GHC.Cmm.Info.Build
import GHC.Cmm.Pipeline
import GHC.Cmm.Info
import GHC.Driver.CodeOutput
+import GHC.Driver.Config
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Utils.Fingerprint ( Fingerprint )
@@ -353,7 +354,7 @@ hscParse' mod_summary
= parseSignature
| otherwise = parseModule
- case unP parseMod (mkPState dflags buf loc) of
+ case unP parseMod (initParserState (initParserOpts dflags) buf loc) of
PFailed pst ->
handleWarningsThrowErrors (getMessages pst dflags)
POk pst rdr_module -> do
@@ -1875,7 +1876,7 @@ hscParseThingWithLocation source linenumber parser str
let buf = stringToStringBuffer str
loc = mkRealSrcLoc (fsLit source) linenumber 1
- case unP parser (mkPState dflags buf loc) of
+ case unP parser (initParserState (initParserOpts dflags) buf loc) of
PFailed pst -> do
handleWarningsThrowErrors (getMessages pst dflags)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index abfcc6fbff..2984d33631 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -21,13 +21,13 @@
-- and then parse that string:
--
-- @
--- runParser :: DynFlags -> String -> P a -> ParseResult a
--- runParser flags str parser = unP parser parseState
+-- runParser :: ParserOpts -> String -> P a -> ParseResult a
+-- runParser opts str parser = unP parser parseState
-- where
-- filename = "\<interactive\>"
-- location = mkRealSrcLoc (mkFastString filename) 1 1
-- buffer = stringToStringBuffer str
--- parseState = mkPState flags buffer location
+-- parseState = initParserState opts buffer location
-- @
module GHC.Parser
( parseModule, parseSignature, parseImport, parseStatement, parseBackpack
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index e6818fceb2..64b1ee8333 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -37,6 +37,7 @@ import GHC.Builtin.Names
import GHC.Data.StringBuffer
import GHC.Types.SrcLoc
import GHC.Driver.Session
+import GHC.Driver.Config
import GHC.Utils.Error
import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
@@ -73,7 +74,7 @@ getImports :: DynFlags
-- names from -XPackageImports), and the module name.
getImports dflags buf filename source_filename = do
let loc = mkRealSrcLoc (mkFastString filename) 1 1
- case unP parseHeader (mkPState dflags buf loc) of
+ case unP parseHeader (initParserState (initParserOpts dflags) buf loc) of
PFailed pst ->
-- assuming we're not logging warnings here as per below
return $ Left $ getErrorMessages pst dflags
@@ -178,7 +179,8 @@ blockSize = 1024
lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks dflags filename handle = do
buf <- hGetStringBufferBlock handle blockSize
- unsafeInterleaveIO $ lazyLexBuf handle (pragState dflags buf loc) False blockSize
+ let prag_state = initPragState (initParserOpts dflags) buf loc
+ unsafeInterleaveIO $ lazyLexBuf handle prag_state False blockSize
where
loc = mkRealSrcLoc (mkFastString filename) 1 1
@@ -214,8 +216,9 @@ lazyGetToks dflags filename handle = do
getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
-getToks dflags filename buf = lexAll (pragState dflags buf loc)
+getToks dflags filename buf = lexAll pstate
where
+ pstate = initPragState (initParserOpts dflags) buf loc
loc = mkRealSrcLoc (mkFastString filename) 1 1
lexAll state = case unP (lexer False return) state of
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index ad93226112..b3d83b2408 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -49,8 +49,10 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Parser.Lexer (
- Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..),
- P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..),
+ Token(..), lexer, lexerDbg,
+ ParserOpts(..), mkParserOpts,
+ PState (..), initParserState, initPragState,
+ P(..), ParseResult(..),
appendWarning,
appendError,
allocateComments,
@@ -62,7 +64,7 @@ module GHC.Parser.Lexer (
activeContext, nextIsEOF,
getLexState, popLexState, pushLexState,
ExtBits(..),
- xtest,
+ xtest, xunset, xset,
lexTokenStream,
AddAnn(..),mkParensApiAnn,
addAnnsAt,
@@ -2207,12 +2209,13 @@ data ParseResult a
-- a non-empty bag of errors.
-- | Test whether a 'WarningFlag' is set
-warnopt :: WarningFlag -> ParserFlags -> Bool
+warnopt :: WarningFlag -> ParserOpts -> Bool
warnopt f options = f `EnumSet.member` pWarningFlags options
--- | The subset of the 'DynFlags' used by the parser.
--- See 'mkParserFlags' or 'mkParserFlags'' for ways to construct this.
-data ParserFlags = ParserFlags {
+-- | Parser options.
+--
+-- See 'mkParserOpts' to construct this.
+data ParserOpts = ParserOpts {
pWarningFlags :: EnumSet WarningFlag
, pHomeUnitId :: UnitId -- ^ id of the unit currently being compiled
-- (only used in Cmm parser)
@@ -2230,7 +2233,7 @@ data HdkComment
data PState = PState {
buffer :: StringBuffer,
- options :: ParserFlags,
+ options :: ParserOpts,
-- This needs to take DynFlags as an argument until
-- we have a fix for #10143
messages :: DynFlags -> Messages,
@@ -2570,6 +2573,12 @@ xbit = bit . fromEnum
xtest :: ExtBits -> ExtsBitmap -> Bool
xtest ext xmap = testBit xmap (fromEnum ext)
+xset :: ExtBits -> ExtsBitmap -> ExtsBitmap
+xset ext xmap = setBit xmap (fromEnum ext)
+
+xunset :: ExtBits -> ExtsBitmap -> ExtsBitmap
+xunset ext xmap = clearBit xmap (fromEnum ext)
+
-- | Various boolean flags, mostly language extensions, that impact lexing and
-- parsing. Note that a handful of these can change during lexing/parsing.
data ExtBits
@@ -2630,19 +2639,8 @@ data ExtBits
-- tokens of their own.
deriving Enum
-
-
-
-
--- PState for parsing options pragmas
---
-pragState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
-pragState dynflags buf loc = (mkPState dynflags buf loc) {
- lex_state = [bol, option_prags, 0]
- }
-
-{-# INLINE mkParserFlags' #-}
-mkParserFlags'
+{-# INLINE mkParserOpts #-}
+mkParserOpts
:: EnumSet WarningFlag -- ^ warnings flags enabled
-> EnumSet LangExt.Extension -- ^ permitted language extensions enabled
-> UnitId -- ^ id of the unit currently being compiled
@@ -2656,11 +2654,11 @@ mkParserFlags'
-- the internal position kept by the parser. Otherwise, those pragmas are
-- lexed as 'ITline_prag' and 'ITcolumn_prag' tokens.
- -> ParserFlags
--- ^ Given exactly the information needed, set up the 'ParserFlags'
-mkParserFlags' warningFlags extensionFlags homeUnitId
+ -> ParserOpts
+-- ^ Given exactly the information needed, set up the 'ParserOpts'
+mkParserOpts warningFlags extensionFlags homeUnitId
safeImports isHaddock rawTokStream usePosPrags =
- ParserFlags {
+ ParserOpts {
pWarningFlags = warningFlags
, pHomeUnitId = homeUnitId
, pExtsBitmap = safeHaskellBit .|. langExtBits .|. optBits
@@ -2722,25 +2720,15 @@ mkParserFlags' warningFlags extensionFlags homeUnitId
b `setBitIf` cond | cond = xbit b
| otherwise = 0
--- | Extracts the flag information needed for parsing
-mkParserFlags :: DynFlags -> ParserFlags
-mkParserFlags =
- mkParserFlags'
- <$> DynFlags.warningFlags
- <*> DynFlags.extensionFlags
- <*> DynFlags.homeUnitId_
- <*> safeImportsOn
- <*> gopt Opt_Haddock
- <*> gopt Opt_KeepRawTokenStream
- <*> const True
-
--- | Creates a parse state from a 'DynFlags' value
-mkPState :: DynFlags -> StringBuffer -> RealSrcLoc -> PState
-mkPState flags = mkPStatePure (mkParserFlags flags)
-
--- | Creates a parse state from a 'ParserFlags' value
-mkPStatePure :: ParserFlags -> StringBuffer -> RealSrcLoc -> PState
-mkPStatePure options buf loc =
+-- | Set parser options for parsing OPTIONS pragmas
+initPragState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
+initPragState options buf loc = (initParserState options buf loc)
+ { lex_state = [bol, option_prags, 0]
+ }
+
+-- | Creates a parse state from a 'ParserOpts' value
+initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState
+initParserState options buf loc =
PState {
buffer = buf,
options = options,
@@ -2818,7 +2806,7 @@ appendError srcspan msg m =
in (ws, es')
appendWarning
- :: ParserFlags
+ :: ParserOpts
-> WarningFlag
-> SrcSpan
-> SDoc
@@ -2928,7 +2916,7 @@ getOffside = P $ \s@PState{last_loc=loc, context=stk} ->
-- Construct a parse error
srcParseErr
- :: ParserFlags
+ :: ParserOpts
-> StringBuffer -- current buffer (placed just after the last token)
-> Int -- length of the previous token
-> MsgDoc
@@ -3248,16 +3236,20 @@ reportLexError loc1 loc2 buf str
then failLocMsgP loc2 loc2 (str ++ " (UTF-8 decoding error)")
else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
-lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token]
-lexTokenStream buf loc dflags = unP go initState{ options = opts' }
- where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream
- initState@PState{ options = opts } = mkPState dflags' buf loc
- opts' = opts{ pExtsBitmap = complement (xbit UsePosPragsBit) .&. pExtsBitmap opts }
- go = do
- ltok <- lexer False return
- case ltok of
- L _ ITeof -> return []
- _ -> liftM (ltok:) go
+lexTokenStream :: ParserOpts -> StringBuffer -> RealSrcLoc -> ParseResult [Located Token]
+lexTokenStream opts buf loc = unP go initState{ options = opts' }
+ where
+ new_exts = xunset HaddockBit -- disable Haddock
+ $ xunset UsePosPragsBit -- parse LINE/COLUMN pragmas as tokens
+ $ xset RawTokenStreamBit -- include comments
+ $ pExtsBitmap opts
+ opts' = opts { pExtsBitmap = new_exts }
+ initState = initParserState opts' buf loc
+ go = do
+ ltok <- lexer False return
+ case ltok of
+ L _ ITeof -> return []
+ _ -> liftM (ltok:) go
linePrags = Map.singleton "line" linePrag
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index ee95880bba..48bcc45091 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -2660,7 +2660,7 @@ failOpFewArgs (L loc op) =
data PV_Context =
PV_Context
- { pv_options :: ParserFlags
+ { pv_options :: ParserOpts
, pv_hint :: SDoc -- See Note [Parser-Validator Hint]
}
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index aad557579b..be416a3997 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -96,8 +96,8 @@ import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Data.Bag
import GHC.Utils.Misc
-import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, mkPStatePure)
-import GHC.Parser.Lexer (ParserFlags)
+import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, initParserState)
+import GHC.Parser.Lexer (ParserOpts)
import qualified GHC.Parser as Parser (parseStmt, parseModule, parseDeclaration, parseImport)
import System.Directory
@@ -877,14 +877,14 @@ parseName str = withSession $ \hsc_env -> liftIO $
; hscTcRnLookupRdrName hsc_env lrdr_name }
-- | Returns @True@ if passed string is a statement.
-isStmt :: ParserFlags -> String -> Bool
+isStmt :: ParserOpts -> String -> Bool
isStmt pflags stmt =
case parseThing Parser.parseStmt pflags stmt of
Lexer.POk _ _ -> True
Lexer.PFailed _ -> False
-- | Returns @True@ if passed string has an import declaration.
-hasImport :: ParserFlags -> String -> Bool
+hasImport :: ParserOpts -> String -> Bool
hasImport pflags stmt =
case parseThing Parser.parseModule pflags stmt of
Lexer.POk _ thing -> hasImports thing
@@ -893,14 +893,14 @@ hasImport pflags stmt =
hasImports = not . null . hsmodImports . unLoc
-- | Returns @True@ if passed string is an import declaration.
-isImport :: ParserFlags -> String -> Bool
+isImport :: ParserOpts -> String -> Bool
isImport pflags stmt =
case parseThing Parser.parseImport pflags stmt of
Lexer.POk _ _ -> True
Lexer.PFailed _ -> False
-- | Returns @True@ if passed string is a declaration but __/not a splice/__.
-isDecl :: ParserFlags -> String -> Bool
+isDecl :: ParserOpts -> String -> Bool
isDecl pflags stmt = do
case parseThing Parser.parseDeclaration pflags stmt of
Lexer.POk _ thing ->
@@ -909,12 +909,12 @@ isDecl pflags stmt = do
_ -> True
Lexer.PFailed _ -> False
-parseThing :: Lexer.P thing -> ParserFlags -> String -> Lexer.ParseResult thing
-parseThing parser pflags stmt = do
+parseThing :: Lexer.P thing -> ParserOpts -> String -> Lexer.ParseResult thing
+parseThing parser opts stmt = do
let buf = stringToStringBuffer stmt
loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
- Lexer.unP parser (Lexer.mkPStatePure pflags buf loc)
+ Lexer.unP parser (Lexer.initParserState opts buf loc)
getDocs :: GhcMonad m
=> Name
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 6112428d22..029b39ba42 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -50,6 +50,7 @@ import GHC.Driver.Ppr hiding (printForUser)
import GHC.Utils.Error hiding (traceCmd)
import GHC.Driver.Finder as Finder
import GHC.Driver.Monad ( modifySession )
+import GHC.Driver.Config
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc,
@@ -1133,7 +1134,7 @@ checkInputForLayout stmt getStmt = do
st0 <- getGHCiState
let buf' = stringToStringBuffer stmt
loc = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1
- pstate = Lexer.mkPState dflags buf' loc
+ pstate = Lexer.initParserState (initParserOpts dflags) buf' loc
case Lexer.unP goToEnd pstate of
(Lexer.POk _ False) -> return $ Just stmt
_other -> do
@@ -1175,7 +1176,7 @@ enqueueCommands cmds = do
-- The return value True indicates success, as in `runOneCommand`.
runStmt :: GhciMonad m => String -> SingleStep -> m (Maybe GHC.ExecResult)
runStmt input step = do
- pflags <- Lexer.mkParserFlags <$> GHC.getInteractiveDynFlags
+ pflags <- initParserOpts <$> GHC.getInteractiveDynFlags
-- In GHCi, we disable `-fdefer-type-errors`, as well as `-fdefer-type-holes`
-- and `-fdefer-out-of-scope-variables` for **naked expressions**. The
-- declarations and statements are not affected.
diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs
index 9f1cc41f92..f2beeb3035 100644
--- a/testsuite/tests/ghc-api/T11579.hs
+++ b/testsuite/tests/ghc-api/T11579.hs
@@ -1,5 +1,6 @@
import System.Environment
import GHC.Driver.Session
+import GHC.Driver.Config
import GHC.Data.FastString
import GHC
import GHC.Data.StringBuffer
@@ -16,7 +17,8 @@ main = do
hdk_comments <- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
- let pstate = mkPState (dflags `gopt_set` Opt_Haddock) stringBuffer loc
+ let opts = initParserOpts (dflags `gopt_set` Opt_Haddock)
+ pstate = initParserState opts stringBuffer loc
case unP (lexer False return) pstate of
POk s (L _ ITeof) -> return (map unLoc (toList (hdk_comments s)))
_ -> error "No token"
diff --git a/testsuite/tests/ghc-api/T9015.hs b/testsuite/tests/ghc-api/T9015.hs
index 3388ee0566..3ca05afc7d 100644
--- a/testsuite/tests/ghc-api/T9015.hs
+++ b/testsuite/tests/ghc-api/T9015.hs
@@ -3,7 +3,7 @@ module Main where
import GHC
import GHC.Driver.Session
import GHC.Driver.Monad
-import GHC.Parser.Lexer (mkParserFlags)
+import GHC.Driver.Config
import System.Environment
testStrings = [
@@ -53,7 +53,7 @@ main = do
where
testWithParser parser = do
dflags <- getSessionDynFlags
- let pflags = mkParserFlags dflags
+ let pflags = initParserOpts dflags
liftIO . putStrLn . unlines $ map (testExpr (parser pflags)) testStrings
testExpr parser expr = do
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs
index 5d3396f835..ae344aaf49 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.hs
+++ b/testsuite/tests/parser/should_run/CountParserDeps.hs
@@ -28,9 +28,12 @@ main = do
[libdir] <- getArgs
modules <- parserDeps libdir
let num = sizeUniqSet modules
--- print num
--- print (map moduleNameString $ nonDetEltsUniqSet modules)
- unless (num <= 201) $ exitWith (ExitFailure num)
+ max_num = 201
+ min_num = max_num - 10 -- so that we don't forget to change the number
+ -- when the number of dependencies decreases
+ -- putStrLn $ "Found " ++ show num ++ " parser module dependencies"
+ -- forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
+ unless (num <= max_num && num >= min_num) $ exitWith (ExitFailure num)
parserDeps :: FilePath -> IO (UniqSet ModuleName)
parserDeps libdir =
diff --git a/utils/haddock b/utils/haddock
-Subproject 37c47822d390b553ce24fe256c9700d5fd83bf9
+Subproject a18c3af7f983f3b6d3cd84093c9079031da5846