Make codeOutput and friends return the filename that they have created
authorIan Lynagh <ian@well-typed.com>
Sat, 2 Mar 2013 23:49:41 +0000 (23:49 +0000)
committerIan Lynagh <ian@well-typed.com>
Sat, 2 Mar 2013 23:49:41 +0000 (23:49 +0000)
compiler/main/CodeOutput.lhs
compiler/main/DriverPipeline.hs
compiler/main/HscMain.hs

index 1b7871c..a180789 100644 (file)
@@ -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
index ff486e4..240cbf4 100644 (file)
@@ -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
index 2f2b53e..b7a37c3 100644 (file)
@@ -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)