[commit: ghc] master: Change how -dynamic-too works (c517125)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/c5171252055bfa40dbbb11ba20323845afbecb3b

>---------------------------------------------------------------

commit c5171252055bfa40dbbb11ba20323845afbecb3b
Author: Ian Lynagh <ian at well-typed.com>
Date:   Fri Mar 8 14:02:22 2013 +0000

    Change how -dynamic-too works
    
    We now run the tail of the pipeline twice, rather than trying to
    do both ways in lockstep.

>---------------------------------------------------------------

 compiler/main/DriverPipeline.hs | 31 +++++++++++--------------------
 compiler/main/HscMain.hs        |  1 +
 2 files changed, 12 insertions(+), 20 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 08f1b98..50c7cb6 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -725,7 +725,17 @@ pipeLoop phase input_fn = do
      -> do liftIO $ debugTraceMsg dflags 4
                                   (ptext (sLit "Running phase") <+> ppr phase)
            (next_phase, output_fn) <- runPhase phase input_fn dflags
-           pipeLoop next_phase output_fn
+           r <- pipeLoop next_phase output_fn
+           case next_phase of
+               HscOut {} ->
+                   whenGeneratingDynamicToo dflags $ do
+                       setDynFlags $ doDynamicToo dflags
+                       -- TODO shouldn't ignore result:
+                       _ <- pipeLoop next_phase output_fn
+                       return ()
+               _ ->
+                   return ()
+           return r
 
 -- -----------------------------------------------------------------------------
 -- In each phase, we need to know into what filename to generate the
@@ -1025,9 +1035,6 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
                 do -- In the case of hs-boot files, generate a dummy .o-boot
                    -- stamp file for the benefit of Make
                    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 (RealPhase next_phase, o_file)
             HscRecomp cgguts mod_summary
               -> do output_fn <- phaseOutputFilename next_phase
@@ -1292,16 +1299,6 @@ runPhase (RealPhase As) input_fn dflags
 
         liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
         runAssembler input_fn output_fn
-        -- If we're compiling a Haskell module (isHaskellishFile), and
-        -- we're doing -dynamic-too, then we also need to assemble the
-        -- -dyn assembly file.
-        env <- getPipeEnv
-        when (pe_isHaskellishFile env) $ whenGeneratingDynamicToo dflags $ do
-            liftIO $ debugTraceMsg dflags 4
-                         (text "Running the assembler again for -dynamic-too")
-            runAssembler (input_fn ++ "-dyn")
-                         (replaceExtension output_fn (dynObjectSuf dflags))
-
         return (RealPhase next_phase, output_fn)
 
 
@@ -1517,12 +1514,6 @@ runPhase (RealPhase MergeStub) input_fn dflags
          panic "runPhase(MergeStub): no stub"
        Just stub_o -> do
          liftIO $ joinObjectFiles dflags [input_fn, stub_o] output_fn
-         whenGeneratingDynamicToo dflags $ do
-           liftIO $ debugTraceMsg dflags 4
-                        (text "Merging stub again for -dynamic-too")
-           let dyn_input_fn  = replaceExtension input_fn  (dynObjectSuf dflags)
-               dyn_output_fn = replaceExtension output_fn (dynObjectSuf dflags)
-           liftIO $ joinObjectFiles dflags [dyn_input_fn, stub_o] dyn_output_fn
          return (RealPhase StopLn, output_fn)
 
 -- warning suppression
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 0aab82f..90a42fb 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1129,6 +1129,7 @@ hscWriteIface dflags iface no_change mod_summary = do
     whenGeneratingDynamicToo dflags $ do
         -- TODO: We should do a no_change check for the dynamic
         --       interface file too
+        -- TODO: Should handle the dynamic hi filename properly
         let dynIfaceFile = replaceExtension ifaceFile (dynHiSuf dflags)
             dynIfaceFile' = addBootSuffix_maybe (mi_boot iface) dynIfaceFile
             dynDflags = doDynamicToo dflags