From 59e7d08db602d243d3768ce6907e7bfe67a55e1a Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 14 Jun 2008 12:11:56 +0000 Subject: [PATCH] Pass dynflags down through to pragState so we no longer need to use defaultDynFlags there --- compiler/main/DriverPipeline.hs | 2 +- compiler/main/GHC.hs | 2 +- compiler/main/HeaderInfo.hs | 20 +++++++++++--------- compiler/parser/Lexer.x | 10 ++++------ 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 1a8f60d..7c515fe 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -613,7 +613,7 @@ runPhase (Unlit sf) _stop hsc_env _basename _suff input_fn get_output_fn maybe_l runPhase (Cpp sf) _stop hsc_env basename suff input_fn get_output_fn maybe_loc = do let dflags0 = hsc_dflags hsc_env - src_opts <- getOptionsFromFile input_fn + src_opts <- getOptionsFromFile dflags0 input_fn (dflags,unhandled_flags) <- parseDynamicFlags dflags0 (map unLoc src_opts) checkProcessArgsResult unhandled_flags (basename <.> suff) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 3b8f51e..7d3ef50 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -1936,7 +1936,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) let dflags = hsc_dflags hsc_env -- case we bypass the preprocessing stage? let - local_opts = getOptions buf src_fn + local_opts = getOptions dflags buf src_fn -- (dflags', _errs) <- parseDynamicFlags dflags (map unLoc local_opts) -- XXX: shouldn't we be reporting the errors? diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index a9e2051..9b92308 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -93,9 +93,10 @@ getImpMod (ImportDecl located_mod _ _ _ _) = located_mod -------------------------------------------------------------- -getOptionsFromFile :: FilePath -- input file +getOptionsFromFile :: DynFlags + -> FilePath -- input file -> IO [Located String] -- options, if any -getOptionsFromFile filename +getOptionsFromFile dflags filename = Control.Exception.bracket (openBinaryFile filename ReadMode) (hClose) @@ -106,7 +107,7 @@ getOptionsFromFile filename loop handle buf | len buf == 0 = return [] | otherwise - = case getOptions' buf filename of + = case getOptions' dflags buf filename of (Nothing, opts) -> return opts (Just buf', opts) -> do nextBlock <- hGetStringBufferBlock handle blockSize newBuf <- appendStringBuffers buf' nextBlock @@ -115,22 +116,23 @@ getOptionsFromFile filename else do opts' <- loop handle newBuf return (opts++opts') -getOptions :: StringBuffer -> FilePath -> [Located String] -getOptions buf filename - = case getOptions' buf filename of +getOptions :: DynFlags -> StringBuffer -> FilePath -> [Located String] +getOptions dflags buf filename + = case getOptions' dflags buf filename of (_,opts) -> opts -- The token parser is written manually because Happy can't -- return a partial result when it encounters a lexer error. -- We want to extract options before the buffer is passed through -- CPP, so we can't use the same trick as 'getImports'. -getOptions' :: StringBuffer -- Input buffer +getOptions' :: DynFlags + -> StringBuffer -- Input buffer -> FilePath -- Source file. Used for msgs only. -> ( Maybe StringBuffer -- Just => we can use more input , [Located String] -- Options. ) -getOptions' buf filename - = parseToks (lexAll (pragState buf loc)) +getOptions' dflags buf filename + = parseToks (lexAll (pragState dflags buf loc)) where loc = mkSrcLoc (mkFastString filename) 1 0 getToken (_buf,L _loc tok) = tok diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index c935b2a..dfef90a 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1597,14 +1597,12 @@ qqEnabled flags = testBit flags qqBit -- PState for parsing options pragmas -- -pragState :: StringBuffer -> SrcLoc -> PState -pragState buf loc = +pragState :: DynFlags -> StringBuffer -> SrcLoc -> PState +pragState dynflags buf loc = PState { - buffer = buf, + buffer = buf, messages = emptyMessages, - -- XXX defaultDynFlags is not right, but we don't have a real - -- dflags handy - dflags = defaultDynFlags, + dflags = dynflags, last_loc = mkSrcSpan loc loc, last_offs = 0, last_len = 0, -- 1.7.10.4