summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/main/CodeOutput.lhs5
-rw-r--r--compiler/main/DriverPipeline.hs27
-rw-r--r--compiler/main/HscMain.hs28
3 files changed, 37 insertions, 23 deletions
diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs
index 1b7871ca8d..a180789d2b 100644
--- a/compiler/main/CodeOutput.lhs
+++ b/compiler/main/CodeOutput.lhs
@@ -49,7 +49,8 @@ codeOutput :: DynFlags
-> ForeignStubs
-> [PackageId]
-> Stream IO RawCmmGroup () -- Compiled C--
- -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-})
+ -> IO (FilePath,
+ (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}))
codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
=
@@ -80,7 +81,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream
HscInterpreted -> panic "codeOutput: HscInterpreted";
HscNothing -> panic "codeOutput: HscNothing"
}
- ; return stubs_exist
+ ; return (filenm, stubs_exist)
}
doOutput :: String -> (Handle -> IO a) -> IO a
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index ff486e4c17..240cbf43d8 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -108,7 +108,7 @@ compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch)
compile' ::
(Compiler (HscStatus, ModIface, ModDetails),
Compiler (InteractiveStatus, ModIface, ModDetails),
- Compiler (HscStatus, ModIface, ModDetails))
+ Compiler (FileOutputStatus, ModIface, ModDetails))
-> HscEnv
-> ModSummary -- ^ summary for module being compiled
-> Int -- ^ module N ...
@@ -440,6 +440,10 @@ compileFile hsc_env stop_phase (src, mb_phase) = do
-- When linking, the -o argument refers to the linker's output.
-- otherwise, we use it as the name for the pipeline's output.
output
+ -- If we are dong -fno-code, then act as if the output is
+ -- 'Temporary'. This stops GHC trying to copy files to their
+ -- final location.
+ | HscNothing <- hscTarget dflags = Temporary
| StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent
-- -o foo applies to linker
| Just o_file <- mb_o_file = SpecificFile o_file
@@ -1011,7 +1015,7 @@ runPhase (Hsc src_flavour) input_fn dflags0
-- than the source file (else we wouldn't be in HscNoRecomp)
-- but we touch it anyway, to keep 'make' happy (we think).
return (StopLn, o_file)
- (HscRecomp hasStub _)
+ (HscRecomp hasStub mOutputFilename)
-> do case hasStub of
Nothing -> return ()
Just stub_c ->
@@ -1019,12 +1023,19 @@ runPhase (Hsc src_flavour) input_fn dflags0
setStubO stub_o
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
- when (isHsBoot src_flavour) $ do
- liftIO $ touchObjectFile dflags' o_file
- whenGeneratingDynamicToo dflags' $ do
- let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
- liftIO $ touchObjectFile dflags' dyn_o_file
- return (next_phase, output_fn)
+ outputFilename <-
+ case mOutputFilename of
+ Just x -> return x
+ Nothing ->
+ if isHsBoot src_flavour
+ then do liftIO $ touchObjectFile dflags' o_file
+ whenGeneratingDynamicToo dflags' $ do
+ let dyn_o_file = addBootSuffix (replaceExtension o_file (dynObjectSuf dflags'))
+ liftIO $ touchObjectFile dflags' dyn_o_file
+ return o_file
+ else return $ panic "runPhase Hsc: No output filename"
+
+ return (next_phase, outputFilename)
-----------------------------------------------------------------------------
-- Cmm phase
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 2f2b53efba..b7a37c3de2 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -34,6 +34,7 @@ module HscMain
-- * Compiling complete source files
, Compiler
, HscStatus' (..)
+ , FileOutputStatus
, InteractiveStatus, HscStatus
, hscCompileOneShot
, hscCompileBatch
@@ -540,11 +541,12 @@ data HscStatus' a
-- result type. Therefore we need to artificially distinguish some types. We do
-- this by adding type tags which will simply be ignored by the caller.
type HscStatus = HscStatus' ()
+type FileOutputStatus = HscStatus' (Maybe FilePath)
type InteractiveStatus = HscStatus' (Maybe (CompiledByteCode, ModBreaks))
-- INVARIANT: result is @Nothing@ <=> input was a boot file
-type OneShotResult = HscStatus
-type BatchResult = (HscStatus, ModIface, ModDetails)
+type OneShotResult = FileOutputStatus
+type BatchResult = (FileOutputStatus, ModIface, ModDetails)
type NothingResult = (HscStatus, ModIface, ModDetails)
type InteractiveResult = (InteractiveStatus, ModIface, ModDetails)
@@ -687,21 +689,21 @@ hscOneShotCompiler = HsCompiler {
, hscBackend = \tc_result mod_summary mb_old_hash -> do
dflags <- getDynFlags
case hscTarget dflags of
- HscNothing -> return (HscRecomp Nothing ())
+ HscNothing -> return (HscRecomp Nothing Nothing)
_otherw -> genericHscBackend hscOneShotCompiler
tc_result mod_summary mb_old_hash
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, _) <- hscSimpleIface tc_result mb_old_iface
hscWriteIface iface changed mod_summary
- return (HscRecomp Nothing ())
+ return (HscRecomp Nothing Nothing)
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify' guts0
(iface, changed, _details, cgguts) <- hscNormalIface guts mb_old_iface
hscWriteIface iface changed mod_summary
- hasStub <- hscGenHardCode cgguts mod_summary
- return (HscRecomp hasStub ())
+ (outputFilename, hasStub) <- hscGenHardCode cgguts mod_summary
+ return (HscRecomp hasStub (Just outputFilename))
}
-- Compile Haskell, boot and extCore in OneShot mode.
@@ -737,18 +739,18 @@ hscBatchCompiler = HsCompiler {
, hscGenBootOutput = \tc_result mod_summary mb_old_iface -> do
(iface, changed, details) <- hscSimpleIface tc_result mb_old_iface
hscWriteIface iface changed mod_summary
- return (HscRecomp Nothing (), iface, details)
+ return (HscRecomp Nothing Nothing, iface, details)
, hscGenOutput = \guts0 mod_summary mb_old_iface -> do
guts <- hscSimplify' guts0
(iface, changed, details, cgguts) <- hscNormalIface guts mb_old_iface
hscWriteIface iface changed mod_summary
- hasStub <- hscGenHardCode cgguts mod_summary
- return (HscRecomp hasStub (), iface, details)
+ (outputFilename, hasStub) <- hscGenHardCode cgguts mod_summary
+ return (HscRecomp hasStub (Just outputFilename), iface, details)
}
-- | Compile Haskell, boot and extCore in batch mode.
-hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
+hscCompileBatch :: Compiler (FileOutputStatus, ModIface, ModDetails)
hscCompileBatch = genericHscCompile hscBatchCompiler batchMsg
hscBatchBackendOnly :: TcGblEnv -> Compiler BatchResult
@@ -1256,7 +1258,7 @@ hscWriteIface iface no_change mod_summary = do
-- | Compile to hard-code.
hscGenHardCode :: CgGuts -> ModSummary
- -> Hsc (Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f
+ -> Hsc (FilePath, Maybe FilePath) -- ^ @Just f@ <=> _stub.c is f
hscGenHardCode cgguts mod_summary = do
hsc_env <- getHscEnv
liftIO $ do
@@ -1303,11 +1305,11 @@ hscGenHardCode cgguts mod_summary = do
return a
rawcmms1 = Stream.mapM dump rawcmms0
- (_stub_h_exists, stub_c_exists)
+ (output_filename, (_stub_h_exists, stub_c_exists))
<- {-# SCC "codeOutput" #-}
codeOutput dflags this_mod location foreign_stubs
dependencies rawcmms1
- return stub_c_exists
+ return (output_filename, stub_c_exists)
hscInteractive :: (ModIface, ModDetails, CgGuts)
View Lorry Controller Status