Skip to content

Commit

Permalink
Remove DynFlags's hscOutName field
Browse files Browse the repository at this point in the history
We now just pass the output filename as an argument instead
  • Loading branch information
Ian Lynagh committed Apr 26, 2013
1 parent 4ae3def commit cee55b9
Show file tree
Hide file tree
Showing 6 changed files with 19 additions and 27 deletions.
4 changes: 2 additions & 2 deletions compiler/main/CodeOutput.lhs
Expand Up @@ -45,14 +45,15 @@ import System.IO
\begin{code}
codeOutput :: DynFlags
-> Module
-> FilePath
-> ModLocation
-> ForeignStubs
-> [PackageId]
-> Stream IO RawCmmGroup () -- Compiled C--
-> IO (FilePath,
(Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}))
codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
codeOutput dflags this_mod filenm location foreign_stubs pkg_deps cmm_stream
=
do {
-- Lint each CmmGroup as it goes past
Expand All @@ -72,7 +73,6 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
}
; showPass dflags "CodeOutput"
; let filenm = hscOutName dflags
; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
; case hscTarget dflags of {
HscAsm -> outputAsm dflags filenm linted_cmm_stream;
Expand Down
12 changes: 4 additions & 8 deletions compiler/main/DriverPipeline.hs
Expand Up @@ -148,8 +148,7 @@ compileOne' m_tc_result mHscMessage
output_fn <- getOutputFilename next_phase
Temporary basename dflags next_phase (Just location)

let dflags' = dflags { hscOutName = output_fn,
extCoreName = basename ++ ".hcr" }
let dflags' = dflags { extCoreName = basename ++ ".hcr" }
let hsc_env' = hsc_env { hsc_dflags = dflags' }

-- -fforce-recomp should also work with --make
Expand Down Expand Up @@ -1039,11 +1038,9 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
HscRecomp cgguts mod_summary
-> do output_fn <- phaseOutputFilename next_phase

let dflags' = dflags { hscOutName = output_fn }
setDynFlags dflags'
PipeState{hsc_env=hsc_env'} <- getPipeState

(outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary
(outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary output_fn
case mStub of
Nothing -> return ()
Just stub_c ->
Expand Down Expand Up @@ -1071,13 +1068,12 @@ runPhase (RealPhase Cmm) input_fn dflags

output_fn <- phaseOutputFilename next_phase

let dflags' = dflags { hscOutName = output_fn,
extCoreName = src_basename ++ ".hcr" }
let dflags' = dflags { extCoreName = src_basename ++ ".hcr" }

setDynFlags dflags'
PipeState{hsc_env} <- getPipeState

liftIO $ hscCompileCmmFile hsc_env input_fn
liftIO $ hscCompileCmmFile hsc_env input_fn output_fn

return (RealPhase next_phase, output_fn)

Expand Down
2 changes: 0 additions & 2 deletions compiler/main/DynFlags.hs
Expand Up @@ -560,7 +560,6 @@ data DynFlags = DynFlags {
ghcLink :: GhcLink,
hscTarget :: HscTarget,
settings :: Settings,
hscOutName :: String, -- ^ Name of the output file
extCoreName :: String, -- ^ Name of the .hcr output file
verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels]
optLevel :: Int, -- ^ Optimisation level
Expand Down Expand Up @@ -1213,7 +1212,6 @@ defaultDynFlags mySettings =
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget (sTargetPlatform mySettings),
hscOutName = "",
extCoreName = "",
verbosity = 0,
optLevel = 0,
Expand Down
6 changes: 3 additions & 3 deletions compiler/main/GHC.hs
Expand Up @@ -892,8 +892,8 @@ compileToCoreSimplified = compileCore True
-- The resulting .o, .hi, and executable files, if any, are stored in the
-- current directory, and named according to the module name.
-- This has only so far been tested with a single self-contained module.
compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m ()
compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> FilePath -> m ()
compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) output_fn = do
dflags <- getSessionDynFlags
currentTime <- liftIO $ getCurrentTime
cwd <- liftIO $ getCurrentDirectory
Expand All @@ -919,7 +919,7 @@ compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
}

hsc_env <- getSession
liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm)
liftIO $ hscCompileCore hsc_env simplify (cm_safe cm) modSum (cm_binds cm) output_fn


compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
Expand Down
20 changes: 10 additions & 10 deletions compiler/main/HscMain.hs
Expand Up @@ -1136,9 +1136,9 @@ hscWriteIface dflags iface no_change mod_summary = do
writeIfaceFile dynDflags dynIfaceFile' iface

-- | Compile to hard-code.
hscGenHardCode :: HscEnv -> CgGuts -> ModSummary
hscGenHardCode :: HscEnv -> CgGuts -> ModSummary -> FilePath
-> IO (FilePath, Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f
hscGenHardCode hsc_env cgguts mod_summary = do
hscGenHardCode hsc_env cgguts mod_summary output_filename = do
let CgGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need.
cg_module = this_mod,
Expand Down Expand Up @@ -1184,8 +1184,8 @@ hscGenHardCode hsc_env cgguts mod_summary = do

(output_filename, (_stub_h_exists, stub_c_exists))
<- {-# SCC "codeOutput" #-}
codeOutput dflags this_mod location foreign_stubs
dependencies rawcmms1
codeOutput dflags this_mod output_filename location
foreign_stubs dependencies rawcmms1
return (output_filename, stub_c_exists)


Expand Down Expand Up @@ -1226,8 +1226,8 @@ hscInteractive _ _ = panic "GHC not compiled with interpreter"

------------------------------

hscCompileCmmFile :: HscEnv -> FilePath -> IO ()
hscCompileCmmFile hsc_env filename = runHsc hsc_env $ do
hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO ()
hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
let dflags = hsc_dflags hsc_env
cmm <- ioMsgMaybe $ parseCmmFile dflags filename
liftIO $ do
Expand All @@ -1236,7 +1236,7 @@ hscCompileCmmFile hsc_env filename = runHsc hsc_env $ do
dumpIfSet_dyn dflags Opt_D_dump_cmm "Parsed Cmm" (ppr cmm)
(_, cmmgroup) <- cmmPipeline hsc_env initTopSRT cmm
rawCmms <- cmmToRawCmm dflags (Stream.yield cmmgroup)
_ <- codeOutput dflags no_mod no_loc NoStubs [] rawCmms
_ <- codeOutput dflags no_mod output_filename no_loc NoStubs [] rawCmms
return ()
where
no_mod = panic "hscCmmFile: no_mod"
Expand Down Expand Up @@ -1556,13 +1556,13 @@ hscParseThingWithLocation source linenumber parser str
return thing

hscCompileCore :: HscEnv -> Bool -> SafeHaskellMode -> ModSummary
-> CoreProgram -> IO ()
hscCompileCore hsc_env simplify safe_mode mod_summary binds
-> CoreProgram -> FilePath -> IO ()
hscCompileCore hsc_env simplify safe_mode mod_summary binds output_filename
= runHsc hsc_env $ do
guts <- maybe_simplify (mkModGuts (ms_mod mod_summary) safe_mode binds)
(iface, changed, _details, cgguts) <- hscNormalIface' guts Nothing
liftIO $ hscWriteIface (hsc_dflags hsc_env) iface changed mod_summary
_ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary
_ <- liftIO $ hscGenHardCode hsc_env cgguts mod_summary output_filename
return ()

where
Expand Down
2 changes: 0 additions & 2 deletions ghc/Main.hs
Expand Up @@ -159,8 +159,6 @@ main' postLoadMode dflags0 args flagWarnings = do
dflags2 = dflags1{ ghcMode = mode,
hscTarget = lang,
ghcLink = link,
-- leave out hscOutName for now
hscOutName = panic "Main.main:hscOutName not set",
verbosity = case postLoadMode of
DoEval _ -> 0
_other -> 1
Expand Down

0 comments on commit cee55b9

Please sign in to comment.