Merge branch 'master' of darcs.haskell.org:/srv/darcs//ghc
authorIan Lynagh <ian@well-typed.com>
Thu, 21 Feb 2013 01:31:50 +0000 (01:31 +0000)
committerIan Lynagh <ian@well-typed.com>
Thu, 21 Feb 2013 01:31:50 +0000 (01:31 +0000)
compiler/main/CodeOutput.lhs
compiler/main/DriverPipeline.hs
compiler/main/GHC.hs
compiler/main/GhcMonad.hs

index 047cc01..817d789 100644 (file)
@@ -145,12 +145,14 @@ outputAsm dflags filenm cmm_stream
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
 
        let filenmDyn = filenm ++ "-dyn"
-           withHandles f = doOutput filenm $ \h ->
-                           ifGeneratingDynamicToo dflags
-                               (doOutput filenmDyn $ \dynH ->
-                                   f [(h, dflags),
-                                      (dynH, doDynamicToo dflags)])
-                               (f [(h, dflags)])
+           withHandles f = do debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
+                              doOutput filenm $ \h ->
+                               ifGeneratingDynamicToo dflags
+                                   (do debugTraceMsg dflags 4 (text "Outputing dynamic-too asm to" <+> text filenmDyn)
+                                       doOutput filenmDyn $ \dynH ->
+                                         f [(h, dflags),
+                                            (dynH, doDynamicToo dflags)])
+                                   (f [(h, dflags)])
 
        _ <- {-# SCC "OutputAsm" #-} withHandles $
            \hs -> {-# SCC "NativeCodeGen" #-}
index 62ff424..fa3b9dc 100644 (file)
@@ -482,6 +482,7 @@ data PipelineOutput
         -- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.
   | SpecificFile FilePath
         -- ^ The output must go into the specified file.
+    deriving Show
 
 -- | Run a compilation pipeline, consisting of multiple phases.
 --
@@ -563,8 +564,9 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
                            SpecificFile fn -> SpecificFile (replaceExtension fn (objectSuf dflags'))
                            Persistent -> Persistent
                            Temporary -> Temporary
+                 env' = env { output_spec = output' }
              hsc_env' <- newHscEnv dflags'
-             _ <- runPipeline' start_phase stop_phase hsc_env' env input_fn
+             _ <- runPipeline' start_phase stop_phase hsc_env' env' input_fn
                                output' maybe_loc maybe_stub_o
              return ()
          return r
@@ -1023,8 +1025,11 @@ 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) $
+                    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)
 
 -----------------------------------------------------------------------------
@@ -1275,8 +1280,15 @@ runPhase As input_fn dflags
                           , SysTools.FileOption "" outputFilename
                           ])
 
+        liftIO $ debugTraceMsg dflags 4 (text "Running the assembler")
         runAssembler input_fn output_fn
-        whenGeneratingDynamicToo dflags $
+        -- 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))
 
index ee40a13..483da4b 100644 (file)
@@ -17,7 +17,6 @@ module GHC (
         runGhc, runGhcT, initGhcMonad,
         gcatch, gbracket, gfinally,
         printException,
-        printExceptionAndWarnings,
         handleSourceError,
         needsTemplateHaskell,
 
index 02769bc..66034e0 100644 (file)
@@ -18,7 +18,7 @@ module GhcMonad (
         Session(..), withSession, modifySession, withTempSession,
 
         -- ** Warnings
-        logWarnings, printException, printExceptionAndWarnings,
+        logWarnings, printException,
         WarnErrLogger, defaultWarnErrLogger
   ) where
 
@@ -189,10 +189,6 @@ printException err = do
   dflags <- getSessionDynFlags
   liftIO $ printBagOfErrors dflags (srcErrorMessages err)
 
-{-# DEPRECATED printExceptionAndWarnings "use printException instead" #-}
-printExceptionAndWarnings :: GhcMonad m => SourceError -> m ()
-printExceptionAndWarnings = printException
-
 -- | A function called to log warnings and errors.
 type WarnErrLogger = GhcMonad m => Maybe SourceError -> m ()