Commit a946c7ef authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot
Browse files

Less DynFlags in Header parsing

parent a5aaceec
......@@ -37,6 +37,7 @@ import GHC.Prelude
import qualified GHC.Runtime.Linker as Linker
import GHC.Driver.Config
import GHC.Driver.Phases
import GHC.Driver.Pipeline
import GHC.Driver.Session
......@@ -2672,7 +2673,9 @@ getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do
pi_hspp_buf <- liftIO $ hGetStringBuffer pi_hspp_fn
(pi_srcimps, pi_theimps, L pi_mod_name_loc pi_mod_name)
<- ExceptT $ do
mimps <- getImports pi_local_dflags pi_hspp_buf pi_hspp_fn src_fn
let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags
popts = initParserOpts pi_local_dflags
mimps <- getImports popts imp_prelude pi_hspp_buf pi_hspp_fn src_fn
return (first (fmap pprError) mimps)
return PreprocessedImports {..}
......
......@@ -44,6 +44,7 @@ import GHC.Unit
import GHC.Unit.State
import GHC.Platform.Ways
import GHC.Platform.ArchOS
import GHC.Driver.Config
import GHC.Parser.Header
import GHC.Parser.Errors.Ppr
import GHC.Driver.Phases
......@@ -1116,7 +1117,9 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
(hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
do
buf <- hGetStringBuffer input_fn
eimps <- getImports dflags buf input_fn (basename <.> suff)
let imp_prelude = xopt LangExt.ImplicitPrelude dflags
popts = initParserOpts dflags
eimps <- getImports popts imp_prelude buf input_fn (basename <.> suff)
case eimps of
Left errs -> throwErrors (fmap pprError errs)
Right (src_imps,imps,L _ mod_name) -> return
......
......@@ -53,7 +53,6 @@ import GHC.Hs
import GHC.Driver.Phases ( HscSource(..) )
import GHC.Driver.Types ( IsBootInterface(..), WarningTxt(..) )
import GHC.Driver.Session
import GHC.Driver.Backpack.Syntax
import GHC.Unit.Info
......
......@@ -49,7 +49,6 @@ import GHC.Data.Bag ( Bag, emptyBag, listToBag, unitBag, isEmptyBag )
import GHC.Utils.Monad
import GHC.Utils.Exception as Exception
import GHC.Types.Basic
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
import System.IO
......@@ -61,7 +60,8 @@ import Data.List
-- | Parse the imports of a source file.
--
-- Throws a 'SourceError' if parsing fails.
getImports :: DynFlags
getImports :: ParserOpts -- ^ Parser options
-> Bool -- ^ Implicit Prelude?
-> StringBuffer -- ^ Parse this.
-> FilePath -- ^ Filename the buffer came from. Used for
-- reporting parse error locations.
......@@ -74,9 +74,9 @@ getImports :: DynFlags
Located ModuleName))
-- ^ The source imports and normal imports (with optional package
-- names from -XPackageImports), and the module name.
getImports dflags buf filename source_filename = do
getImports popts implicit_prelude buf filename source_filename = do
let loc = mkRealSrcLoc (mkFastString filename) 1 1
case unP parseHeader (initParserState (initParserOpts dflags) buf loc) of
case unP parseHeader (initParserState popts buf loc) of
PFailed pst ->
-- assuming we're not logging warnings here as per below
return $ Left $ getErrorMessages pst
......@@ -100,7 +100,6 @@ getImports dflags buf filename source_filename = do
. ideclName . unLoc)
ord_idecls
implicit_prelude = xopt LangExt.ImplicitPrelude dflags
implicit_imports = mkPrelImports (unLoc mod) main_loc
implicit_prelude imps
convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
......@@ -160,7 +159,7 @@ getOptionsFromFile dflags filename
(hClose)
(\handle -> do
opts <- fmap (getOptions' dflags)
(lazyGetToks dflags' filename handle)
(lazyGetToks (initParserOpts dflags') filename handle)
seqList opts $ return opts)
where -- We don't need to get haddock doc tokens when we're just
-- getting the options from pragmas, and lazily lexing them
......@@ -176,10 +175,10 @@ blockSize :: Int
-- blockSize = 17 -- for testing :-)
blockSize = 1024
lazyGetToks :: DynFlags -> FilePath -> Handle -> IO [Located Token]
lazyGetToks dflags filename handle = do
lazyGetToks :: ParserOpts -> FilePath -> Handle -> IO [Located Token]
lazyGetToks popts filename handle = do
buf <- hGetStringBufferBlock handle blockSize
let prag_state = initPragState (initParserOpts dflags) buf loc
let prag_state = initPragState popts buf loc
unsafeInterleaveIO $ lazyLexBuf handle prag_state False blockSize
where
loc = mkRealSrcLoc (mkFastString filename) 1 1
......@@ -215,10 +214,10 @@ lazyGetToks dflags filename handle = do
unsafeInterleaveIO $ lazyLexBuf handle state{buffer=newbuf} False new_size
getToks :: DynFlags -> FilePath -> StringBuffer -> [Located Token]
getToks dflags filename buf = lexAll pstate
getToks :: ParserOpts -> FilePath -> StringBuffer -> [Located Token]
getToks popts filename buf = lexAll pstate
where
pstate = initPragState (initParserOpts dflags) buf loc
pstate = initPragState popts buf loc
loc = mkRealSrcLoc (mkFastString filename) 1 1
lexAll state = case unP (lexer False return) state of
......@@ -235,7 +234,7 @@ getOptions :: DynFlags
-> FilePath -- ^ Source filename. Used for location info.
-> [Located String] -- ^ Parsed options.
getOptions dflags buf filename
= getOptions' dflags (getToks dflags filename buf)
= getOptions' dflags (getToks (initParserOpts dflags) filename buf)
-- The token parser is written manually because Happy can't
-- return a partial result when it encounters a lexer error.
......
......@@ -138,7 +138,7 @@ import GHC.Utils.Misc
import GHC.Parser.Annotation
import Data.List
import Data.Foldable
import GHC.Driver.Session ( WarningFlag(..) )
import GHC.Driver.Flags ( WarningFlag(..) )
import GHC.Utils.Panic
import Control.Monad
......
......@@ -55,7 +55,7 @@ import GHC.Prelude hiding (mod)
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Driver.Session ( WarningFlag(..) )
import GHC.Driver.Flags ( WarningFlag(..) )
import GHC.Utils.Panic
import GHC.Data.Bag
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment