summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/CodeOutput.lhs4
-rw-r--r--compiler/main/DriverPipeline.hs12
-rw-r--r--compiler/main/DynFlags.hs2
-rw-r--r--compiler/main/GHC.hs6
-rw-r--r--compiler/main/HscMain.hs20
5 files changed, 19 insertions, 25 deletions
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index d6c096a595..ce25727703 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -45,6 +45,7 @@ import System.IO
\begin{code}
codeOutput :: DynFlags
-> Module
+ -> FilePath
-> ModLocation
-> ForeignStubs
-> [PackageId]
@@ -52,7 +53,7 @@ codeOutput :: DynFlags
-> 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
@@ -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;
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 840a0470e2..de717b05d4 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -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
@@ -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 ->
@@ -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)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2fbb0105e5..5a0f6f9f2b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -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
@@ -1213,7 +1212,6 @@ defaultDynFlags mySettings =
ghcMode = CompManager,
ghcLink = LinkBinary,
hscTarget = defaultHscTarget (sTargetPlatform mySettings),
- hscOutName = "",
extCoreName = "",
verbosity = 0,
optLevel = 0,
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c72f1f1be6..3e5fe9cea9 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -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
@@ -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
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index c97e3ec724..a6d45081c3 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -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,
@@ -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)
@@ -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
@@ -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"
@@ -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
View Lorry Controller Status