diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-09-10 18:20:45 +0200 |
---|---|---|
committer | Sylvain Henry <sylvain@haskus.fr> | 2020-09-29 17:24:03 +0200 |
commit | 8e3f00dd24936b6674d0a2322f8410125968583e (patch) | |
tree | d9630cc481aff867c16300b049b28e8cdd1a7aa2 | |
parent | 4365d77a0b306ada61654c3648b844cfa0f4fdcf (diff) | |
download | haskell-8e3f00dd24936b6674d0a2322f8410125968583e.tar.gz |
Make the parser module less dependent on DynFlags
Bump haddock submodule
-rw-r--r-- | compiler/GHC.hs | 11 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Parser.y | 4 | ||||
-rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Driver/Config.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Driver/Main.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 6 | ||||
-rw-r--r-- | compiler/GHC/Parser/Header.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Parser/Lexer.x | 104 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Runtime/Eval.hs | 18 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T11579.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/ghc-api/T9015.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountParserDeps.hs | 9 | ||||
m--------- | utils/haddock | 0 |
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 |