Rename driver phases C(obj)cpp to C(obj)cplusplus
[ghc.git] / compiler / main / DriverPipeline.hs
index 68957ca..845cc95 100644 (file)
@@ -1,5 +1,5 @@
-{-# OPTIONS -fno-cse #-}
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation #-}
+{-# OPTIONS_GHC -fno-cse #-}
 -- -fno-cse is needed for GLOBAL_VAR's to behave properly
 
 -----------------------------------------------------------------------------
@@ -20,20 +20,29 @@ module DriverPipeline (
 
         -- Interfaces for the compilation manager (interpreted/batch-mode)
    preprocess,
-   compile, compile',
+   compileOne, compileOne',
    link,
 
+        -- Exports for hooks to override runPhase and link
+   PhasePlus(..), CompPipeline(..), PipeEnv(..), PipeState(..),
+   phaseOutputFilename, getPipeState, getPipeEnv,
+   hscPostBackendPhase, getLocation, setModLocation, setDynFlags,
+   runPhase, exeFileName,
+   mkExtraObjToLinkIntoBinary, mkNoteObjsToLinkIntoBinary,
+   maybeCreateManifest, runPhase_MoveBinary,
+   linkingNeeded, checkLinkInfo, writeInterfaceOnlyMode
   ) where
 
 #include "HsVersions.h"
 
+import PipelineMonad
 import Packages
 import HeaderInfo
 import DriverPhases
 import SysTools
 import HscMain
 import Finder
-import HscTypes
+import HscTypes hiding ( Hsc )
 import Outputable
 import Module
 import UniqFM           ( eltsUFM )
@@ -45,12 +54,13 @@ import Util
 import StringBuffer     ( hGetStringBuffer )
 import BasicTypes       ( SuccessFlag(..) )
 import Maybes           ( expectJust )
-import ParserCoreUtils  ( getCoreModuleName )
 import SrcLoc
 import FastString
 import LlvmCodeGen      ( llvmFixupAsm )
 import MonadUtils
 import Platform
+import TcRnTypes
+import Hooks
 
 import Exception
 import Data.IORef       ( readIORef )
@@ -77,7 +87,7 @@ preprocess :: HscEnv
            -> IO (DynFlags, FilePath)
 preprocess hsc_env (filename, mb_phase) =
   ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename)
-  runPipeline anyHsc hsc_env (filename, mb_phase)
+  runPipeline anyHsc hsc_env (filename, fmap RealPhase mb_phase)
         Nothing Temporary Nothing{-no ModLocation-} Nothing{-no stub-}
 
 -- ---------------------------------------------------------------------------
@@ -94,33 +104,31 @@ preprocess hsc_env (filename, mb_phase) =
 --
 -- NB.  No old interface can also mean that the source has changed.
 
-compile :: HscEnv
-        -> ModSummary      -- ^ summary for module being compiled
-        -> Int             -- ^ module N ...
-        -> Int             -- ^ ... of M
-        -> Maybe ModIface  -- ^ old interface, if we have one
-        -> Maybe Linkable  -- ^ old linkable, if we have one
-        -> SourceModified
-        -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
-
-compile = compile' (hscCompileNothing, hscCompileInteractive, hscCompileBatch)
-
-compile' :: 
-           (Compiler (HscStatus, ModIface, ModDetails),
-            Compiler (InteractiveStatus, ModIface, ModDetails),
-            Compiler (HscStatus, ModIface, ModDetails))
-        -> HscEnv
-        -> ModSummary      -- ^ summary for module being compiled
-        -> Int             -- ^ module N ...
-        -> Int             -- ^ ... of M
-        -> Maybe ModIface  -- ^ old interface, if we have one
-        -> Maybe Linkable  -- ^ old linkable, if we have one
-        -> SourceModified
-        -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
-
-compile' (nothingCompiler, interactiveCompiler, batchCompiler)
-        hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
-        source_modified0
+compileOne :: HscEnv
+           -> ModSummary      -- ^ summary for module being compiled
+           -> Int             -- ^ module N ...
+           -> Int             -- ^ ... of M
+           -> Maybe ModIface  -- ^ old interface, if we have one
+           -> Maybe Linkable  -- ^ old linkable, if we have one
+           -> SourceModified
+           -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
+
+compileOne = compileOne' Nothing (Just batchMsg)
+
+compileOne' :: Maybe TcGblEnv
+            -> Maybe Messager
+            -> HscEnv
+            -> ModSummary      -- ^ summary for module being compiled
+            -> Int             -- ^ module N ...
+            -> Int             -- ^ ... of M
+            -> Maybe ModIface  -- ^ old interface, if we have one
+            -> Maybe Linkable  -- ^ old linkable, if we have one
+            -> SourceModified
+            -> IO HomeModInfo   -- ^ the complete HomeModInfo, if successful
+
+compileOne' m_tc_result mHscMessage
+            hsc_env0 summary mod_index nmods mb_old_iface maybe_old_linkable
+            source_modified0
  = do
    let dflags0     = ms_hspp_opts summary
        this_mod    = ms_mod summary
@@ -128,8 +136,19 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
        location    = ms_location summary
        input_fn    = expectJust "compile:hs" (ml_hs_file location)
        input_fnpp  = ms_hspp_file summary
-
-   debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
+       mod_graph   = hsc_mod_graph hsc_env0
+       needsTH     = any (xopt Opt_TemplateHaskell . ms_hspp_opts) mod_graph
+       needsQQ     = any (xopt Opt_QuasiQuotes     . ms_hspp_opts) mod_graph
+       needsLinker = needsTH || needsQQ
+       isDynWay    = any (== WayDyn) (ways dflags0)
+       isProfWay   = any (== WayProf) (ways dflags0)
+   -- #8180 - when using TemplateHaskell, switch on -dynamic-too so
+   -- the linker can correctly load the object files.
+   let dflags1 = if needsLinker && dynamicGhc && not isDynWay && not isProfWay
+                  then gopt_set dflags0 Opt_BuildDynamicToo
+                  else dflags0
+
+   debugTraceMsg dflags1 2 (text "compile: input file" <+> text input_fnpp)
 
    let basename = dropExtension input_fn
 
@@ -137,8 +156,8 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
   -- This is needed when we try to compile the .hc file later, if it
   -- imports a _stub.h file that we created here.
    let current_dir = takeDirectory basename
-       old_paths   = includePaths dflags0
-       dflags      = dflags0 { includePaths = current_dir : old_paths }
+       old_paths   = includePaths dflags1
+       dflags      = dflags1 { includePaths = current_dir : old_paths }
        hsc_env     = hsc_env0 {hsc_dflags = dflags}
 
    -- Figure out what lang we're generating
@@ -149,92 +168,123 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
    output_fn <- getOutputFilename next_phase
                         Temporary basename dflags next_phase (Just location)
 
-   let dflags' = dflags { hscTarget = hsc_lang,
-                                hscOutName = output_fn,
-                                extCoreName = basename ++ ".hcr" }
-   let hsc_env' = hsc_env { hsc_dflags = dflags' }
-
    -- -fforce-recomp should also work with --make
    let force_recomp = gopt Opt_ForceRecomp dflags
        source_modified
-         | force_recomp || isNothing maybe_old_linkable = SourceModified
+         | force_recomp = SourceModified
          | otherwise = source_modified0
        object_filename = ml_obj_file location
 
-   let handleBatch HscNoRecomp
-           = ASSERT (isJust maybe_old_linkable)
-             return maybe_old_linkable
-
-       handleBatch (HscRecomp hasStub _)
-           | isHsBoot src_flavour
-               = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
-                       liftIO $ touchObjectFile dflags' object_filename
-                    return maybe_old_linkable
-
-           | otherwise
-               = do (hs_unlinked, unlinked_time) <-
-                        case hsc_lang of
-                          HscNothing ->
-                            return ([], ms_hs_date summary)
-                          -- We're in --make mode: finish the compilation pipeline.
-                          _other -> do
-                            maybe_stub_o <- case hasStub of
-                               Nothing -> return Nothing
-                               Just stub_c -> do
-                                 stub_o <- compileStub hsc_env' stub_c
-                                 return (Just stub_o)
-                            _ <- runPipeline StopLn hsc_env' (output_fn,Nothing)
-                                              (Just basename)
-                                              Persistent
-                                              (Just location)
-                                              maybe_stub_o
-                                  -- The object filename comes from the ModLocation
-                            o_time <- getModificationUTCTime object_filename
-                            return ([DotO object_filename], o_time)
-                    
-                    let linkable = LM unlinked_time this_mod hs_unlinked
-                    return (Just linkable)
-
-       handleInterpreted HscNoRecomp
-           = ASSERT (isJust maybe_old_linkable)
-             return maybe_old_linkable
-       handleInterpreted (HscRecomp _hasStub Nothing)
-           = ASSERT (isHsBoot src_flavour)
-             return maybe_old_linkable
-       handleInterpreted (HscRecomp hasStub (Just (comp_bc, modBreaks)))
-           = do stub_o <- case hasStub of
-                            Nothing -> return []
-                            Just stub_c -> do
-                              stub_o <- compileStub hsc_env' stub_c
-                              return [DotO stub_o]
-
-                let hs_unlinked = [BCOs comp_bc modBreaks]
-                    unlinked_time = ms_hs_date summary
-                  -- Why do we use the timestamp of the source file here,
-                  -- rather than the current time?  This works better in
-                  -- the case where the local clock is out of sync
-                  -- with the filesystem's clock.  It's just as accurate:
-                  -- if the source is modified, then the linkable will
-                  -- be out of date.
-                let linkable = LM unlinked_time this_mod
-                               (hs_unlinked ++ stub_o)
-                return (Just linkable)
-
-   let -- runCompiler :: Compiler result -> (result -> Maybe Linkable)
-       --            -> m HomeModInfo
-       runCompiler compiler handle
-           = do (result, iface, details)
-                    <- compiler hsc_env' summary source_modified mb_old_iface
-                                (Just (mod_index, nmods))
-                linkable <- handle result
-                return (HomeModInfo{ hm_details  = details,
-                                     hm_iface    = iface,
-                                     hm_linkable = linkable })
-   -- run the compiler
-   case hsc_lang of
-      HscInterpreted -> runCompiler interactiveCompiler handleInterpreted
-      HscNothing     -> runCompiler nothingCompiler     handleBatch
-      _other         -> runCompiler batchCompiler       handleBatch
+   let always_do_basic_recompilation_check = case hsc_lang of
+                                             HscInterpreted -> True
+                                             _ -> False
+
+   e <- genericHscCompileGetFrontendResult
+            always_do_basic_recompilation_check
+            m_tc_result mHscMessage
+            hsc_env summary source_modified mb_old_iface (mod_index, nmods)
+
+   case e of
+       Left iface ->
+           do details <- genModDetails hsc_env iface
+              MASSERT(isJust maybe_old_linkable)
+              return (HomeModInfo{ hm_details  = details,
+                                   hm_iface    = iface,
+                                   hm_linkable = maybe_old_linkable })
+
+       Right (tc_result, mb_old_hash) ->
+           -- run the compiler
+           case hsc_lang of
+               HscInterpreted ->
+                   case ms_hsc_src summary of
+                   t | isHsBootOrSig t ->
+                       do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                          return (HomeModInfo{ hm_details  = details,
+                                               hm_iface    = iface,
+                                               hm_linkable = maybe_old_linkable })
+                   _ -> do guts0 <- hscDesugar hsc_env summary tc_result
+                           guts <- hscSimplify hsc_env guts0
+                           (iface, _changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
+                           (hasStub, comp_bc, modBreaks) <- hscInteractive hsc_env cgguts summary
+
+                           stub_o <- case hasStub of
+                                     Nothing -> return []
+                                     Just stub_c -> do
+                                         stub_o <- compileStub hsc_env stub_c
+                                         return [DotO stub_o]
+
+                           let hs_unlinked = [BCOs comp_bc modBreaks]
+                               unlinked_time = ms_hs_date summary
+                             -- Why do we use the timestamp of the source file here,
+                             -- rather than the current time?  This works better in
+                             -- the case where the local clock is out of sync
+                             -- with the filesystem's clock.  It's just as accurate:
+                             -- if the source is modified, then the linkable will
+                             -- be out of date.
+                           let linkable = LM unlinked_time this_mod
+                                          (hs_unlinked ++ stub_o)
+
+                           return (HomeModInfo{ hm_details  = details,
+                                                hm_iface    = iface,
+                                                hm_linkable = Just linkable })
+               HscNothing ->
+                   do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                      when (gopt Opt_WriteInterface dflags) $
+                         hscWriteIface dflags iface changed summary
+                      let linkable = if isHsBootOrSig src_flavour
+                                     then maybe_old_linkable
+                                     else Just (LM (ms_hs_date summary) this_mod [])
+                      return (HomeModInfo{ hm_details  = details,
+                                           hm_iface    = iface,
+                                           hm_linkable = linkable })
+
+               _ ->
+                   case ms_hsc_src summary of
+                   HsBootFile ->
+                       do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                          hscWriteIface dflags iface changed summary
+                          touchObjectFile dflags object_filename
+                          return (HomeModInfo{ hm_details  = details,
+                                               hm_iface    = iface,
+                                               hm_linkable = maybe_old_linkable })
+
+                   HsigFile ->
+                       do (iface, changed, details) <-
+                                    hscSimpleIface hsc_env tc_result mb_old_hash
+                          hscWriteIface dflags iface changed summary
+                          compileEmptyStub dflags hsc_env basename location
+
+                          -- Same as Hs
+                          o_time <- getModificationUTCTime object_filename
+                          let linkable =
+                                  LM o_time this_mod [DotO object_filename]
+
+                          return (HomeModInfo{ hm_details  = details,
+                                               hm_iface    = iface,
+                                               hm_linkable = Just linkable })
+
+                   HsSrcFile ->
+                        do guts0 <- hscDesugar hsc_env summary tc_result
+                           guts <- hscSimplify hsc_env guts0
+                           (iface, changed, details, cgguts) <- hscNormalIface hsc_env guts mb_old_hash
+                           hscWriteIface dflags iface changed summary
+
+                           -- We're in --make mode: finish the compilation pipeline.
+                           let mod_name = ms_mod_name summary
+                           _ <- runPipeline StopLn hsc_env
+                                             (output_fn,
+                                              Just (HscOut src_flavour mod_name (HscRecomp cgguts summary)))
+                                             (Just basename)
+                                             Persistent
+                                             (Just location)
+                                             Nothing
+                                 -- The object filename comes from the ModLocation
+                           o_time <- getModificationUTCTime object_filename
+                           let linkable = LM o_time this_mod [DotO object_filename]
+
+                           return (HomeModInfo{ hm_details  = details,
+                                                hm_iface    = iface,
+                                                hm_linkable = Just linkable })
 
 -----------------------------------------------------------------------------
 -- stub .h and .c files (for foreign export support)
@@ -253,6 +303,21 @@ compileStub hsc_env stub_c = do
 
         return stub_o
 
+compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> IO ()
+compileEmptyStub dflags hsc_env basename location = do
+  -- To maintain the invariant that every Haskell file
+  -- compiles to object code, we make an empty (but
+  -- valid) stub object file for signatures
+  empty_stub <- newTempName dflags "c"
+  writeFile empty_stub ""
+  _ <- runPipeline StopLn hsc_env
+                  (empty_stub, Nothing)
+                  (Just basename)
+                  Persistent
+                  (Just location)
+                  Nothing
+  return ()
+
 -- ---------------------------------------------------------------------------
 -- Link
 
@@ -269,20 +334,26 @@ link :: GhcLink                 -- interactive or batch
 -- exports main, i.e., we have good reason to believe that linking
 -- will succeed.
 
-link LinkInMemory _ _ _
-    = if cGhcWithInterpreter == "YES"
-      then -- Not Linking...(demand linker will do the job)
-           return Succeeded
-      else panicBadLink LinkInMemory
+link ghcLink dflags
+  = lookupHook linkHook l dflags ghcLink dflags
+  where
+    l LinkInMemory _ _ _
+      = if cGhcWithInterpreter == "YES"
+        then -- Not Linking...(demand linker will do the job)
+             return Succeeded
+        else panicBadLink LinkInMemory
+
+    l NoLink _ _ _
+      = return Succeeded
 
-link NoLink _ _ _
-   = return Succeeded
+    l LinkBinary dflags batch_attempt_linking hpt
+      = link' dflags batch_attempt_linking hpt
 
-link LinkBinary dflags batch_attempt_linking hpt
-   = link' dflags batch_attempt_linking hpt
+    l LinkStaticLib dflags batch_attempt_linking hpt
+      = link' dflags batch_attempt_linking hpt
 
-link LinkDynLib dflags batch_attempt_linking hpt
-   = link' dflags batch_attempt_linking hpt
+    l LinkDynLib dflags batch_attempt_linking hpt
+      = link' dflags batch_attempt_linking hpt
 
 panicBadLink :: GhcLink -> a
 panicBadLink other = panic ("link: GHC not built to link this way: " ++
@@ -297,6 +368,10 @@ link' dflags batch_attempt_linking hpt
    | batch_attempt_linking
    = do
         let
+            staticLink = case ghcLink dflags of
+                          LinkStaticLib -> True
+                          _ -> platformBinariesAreStaticLibs (targetPlatform dflags)
+
             home_mod_infos = eltsUFM hpt
 
             -- the packages we depend on
@@ -316,9 +391,9 @@ link' dflags batch_attempt_linking hpt
         let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
             obj_files = concatMap getOfiles linkables
 
-            exe_file = exeFileName dflags
+            exe_file = exeFileName staticLink dflags
 
-        linking_needed <- linkingNeeded dflags linkables pkg_deps
+        linking_needed <- linkingNeeded dflags staticLink linkables pkg_deps
 
         if not (gopt Opt_ForceRecomp dflags) && not linking_needed
            then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required."))
@@ -329,9 +404,10 @@ link' dflags batch_attempt_linking hpt
 
         -- Don't showPass in Batch mode; doLink will do that for us.
         let link = case ghcLink dflags of
-                LinkBinary  -> linkBinary
-                LinkDynLib  -> linkDynLibCheck
-                other       -> panicBadLink other
+                LinkBinary    -> linkBinary
+                LinkStaticLib -> linkStaticLibCheck
+                LinkDynLib    -> linkDynLibCheck
+                other         -> panicBadLink other
         link dflags obj_files pkg_deps
 
         debugTraceMsg dflags 3 (text "link: done")
@@ -345,18 +421,18 @@ link' dflags batch_attempt_linking hpt
         return Succeeded
 
 
-linkingNeeded :: DynFlags -> [Linkable] -> [PackageId] -> IO Bool
-linkingNeeded dflags linkables pkg_deps = do
+linkingNeeded :: DynFlags -> Bool -> [Linkable] -> [PackageKey] -> IO Bool
+linkingNeeded dflags staticLink linkables pkg_deps = do
         -- if the modification time on the executable is later than the
         -- modification times on all of the objects and libraries, then omit
         -- linking (unless the -fforce-recomp flag was given).
-  let exe_file = exeFileName dflags
+  let exe_file = exeFileName staticLink dflags
   e_exe_time <- tryIO $ getModificationUTCTime exe_file
   case e_exe_time of
     Left _  -> return True
     Right t -> do
         -- first check object files and extra_ld_inputs
-        let extra_ld_inputs = ldInputs dflags
+        let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
         e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
         let (errs,extra_times) = splitEithers e_extra_times
         let obj_times =  map linkableTime linkables ++ extra_times
@@ -366,9 +442,8 @@ linkingNeeded dflags linkables pkg_deps = do
 
         -- next, check libraries. XXX this only checks Haskell libraries,
         -- not extra_libraries or -l things from the command line.
-        let pkg_map = pkgIdMap (pkgState dflags)
-            pkg_hslibs  = [ (libraryDirs c, lib)
-                          | Just c <- map (lookupPackage pkg_map) pkg_deps,
+        let pkg_hslibs  = [ (libraryDirs c, lib)
+                          | Just c <- map (lookupPackage dflags) pkg_deps,
                             lib <- packageHsLibs dflags c ]
 
         pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
@@ -382,7 +457,7 @@ linkingNeeded dflags linkables pkg_deps = do
 
 -- Returns 'False' if it was, and we can avoid linking, because the
 -- previous binary was linked with "the same options".
-checkLinkInfo :: DynFlags -> [PackageId] -> FilePath -> IO Bool
+checkLinkInfo :: DynFlags -> [PackageKey] -> FilePath -> IO Bool
 checkLinkInfo dflags pkg_deps exe_file
  | not (platformSupportsSavingLinkOpts (platformOS (targetPlatform dflags)))
  -- ToDo: Windows and OS X do not use the ELF binary format, so
@@ -433,7 +508,7 @@ compileFile hsc_env stop_phase (src, mb_phase) = do
         throwGhcExceptionIO (CmdLineError ("does not exist: " ++ src))
 
    let
-        dflags = hsc_dflags hsc_env
+        dflags    = hsc_dflags hsc_env
         split     = gopt Opt_SplitObjs dflags
         mb_o_file = outputFile dflags
         ghc_link  = ghcLink dflags      -- Set by -c or -no-link
@@ -441,18 +516,22 @@ 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
+         | isJust mb_o_file = SpecificFile
                 -- -o foo applies to the file we are compiling now
          | otherwise = Persistent
 
         stop_phase' = case stop_phase of
-                        As | split -> SplitAs
-                        _          -> stop_phase
+                        As | split -> SplitAs
+                        _            -> stop_phase
 
    ( _, out_file) <- runPipeline stop_phase' hsc_env
-                            (src, mb_phase) Nothing output
+                            (src, fmap RealPhase mb_phase) Nothing output
                             Nothing{-no ModLocation-} Nothing
    return out_file
 
@@ -464,26 +543,15 @@ doLink dflags stop_phase o_files
 
   | otherwise
   = case ghcLink dflags of
-        NoLink     -> return ()
-        LinkBinary -> linkBinary      dflags o_files []
-        LinkDynLib -> linkDynLibCheck dflags o_files []
-        other      -> panicBadLink other
+        NoLink        -> return ()
+        LinkBinary    -> linkBinary         dflags o_files []
+        LinkStaticLib -> linkStaticLibCheck dflags o_files []
+        LinkDynLib    -> linkDynLibCheck    dflags o_files []
+        other         -> panicBadLink other
 
 
 -- ---------------------------------------------------------------------------
 
-data PipelineOutput
-  = Temporary
-        -- ^ Output should be to a temporary file: we're going to
-        -- run more compilation steps on this output later.
-  | Persistent
-        -- ^ We want a persistent file, i.e. a file in the current directory
-        -- derived from the input filename, but with the appropriate extension.
-        -- 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.
 --
 -- This is the interface to the compilation pipeline, which runs
@@ -496,12 +564,12 @@ data PipelineOutput
 runPipeline
   :: Phase                      -- ^ When to stop
   -> HscEnv                     -- ^ Compilation environment
-  -> (FilePath,Maybe Phase)     -- ^ Input filename (and maybe -x suffix)
+  -> (FilePath,Maybe PhasePlus) -- ^ Input filename (and maybe -x suffix)
   -> Maybe FilePath             -- ^ original basename (if different from ^^^)
   -> PipelineOutput             -- ^ Output filename
   -> Maybe ModLocation          -- ^ A ModLocation, if this is a Haskell module
   -> Maybe FilePath             -- ^ stub object, if we have one
-  -> IO (DynFlags, FilePath)     -- ^ (final flags, output filename)
+  -> IO (DynFlags, FilePath)    -- ^ (final flags, output filename)
 runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
              mb_basename output maybe_loc maybe_stub_o
 
@@ -518,13 +586,14 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
                       | otherwise             = input_basename
 
              -- If we were given a -x flag, then use that phase to start from
-             start_phase = fromMaybe (startPhase suffix') mb_phase
+             start_phase = fromMaybe (RealPhase (startPhase suffix')) mb_phase
 
-             isHaskell (Unlit _) = True
-             isHaskell (Cpp   _) = True
-             isHaskell (HsPp  _) = True
-             isHaskell (Hsc   _) = True
-             isHaskell _         = False
+             isHaskell (RealPhase (Unlit _)) = True
+             isHaskell (RealPhase (Cpp   _)) = True
+             isHaskell (RealPhase (HsPp  _)) = True
+             isHaskell (RealPhase (Hsc   _)) = True
+             isHaskell (HscOut {})           = True
+             isHaskell _                     = False
 
              isHaskellishFile = isHaskell start_phase
 
@@ -543,10 +612,13 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
          -- before B in a normal compilation pipeline.
 
          let happensBefore' = happensBefore dflags
-         when (not (start_phase `happensBefore'` stop_phase)) $
-               throwGhcExceptionIO (UsageError
-                           ("cannot compile this file to desired target: "
-                              ++ input_fn))
+         case start_phase of
+             RealPhase start_phase' ->
+                 when (not (start_phase' `happensBefore'` stop_phase)) $
+                       throwGhcExceptionIO (UsageError
+                                   ("cannot compile this file to desired target: "
+                                      ++ input_fn))
+             HscOut {} -> return ()
 
          debugTraceMsg dflags 4 (text "Running the pipeline")
          r <- runPipeline' start_phase hsc_env env input_fn
@@ -556,24 +628,20 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase)
          -- -dynamic-too, but couldn't do the -dynamic-too fast
          -- path, then rerun the pipeline for the dyn way
          let dflags = extractDynFlags hsc_env
-         when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
-             debugTraceMsg dflags 4
-                 (text "Running the pipeline again for -dynamic-too")
-             let dflags' = doDynamicToo dflags
-                 -- TODO: This should use -dyno
-                 output' = case output of
-                           SpecificFile fn -> SpecificFile (replaceExtension fn (objectSuf dflags'))
-                           Persistent -> Persistent
-                           Temporary -> Temporary
-                 env' = env { output_spec = output' }
-             hsc_env' <- newHscEnv dflags'
-             _ <- runPipeline' start_phase hsc_env' env' input_fn
-                               maybe_loc maybe_stub_o
-             return ()
+         -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
+         when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do
+           when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
+               debugTraceMsg dflags 4
+                   (text "Running the pipeline again for -dynamic-too")
+               let dflags' = dynamicTooMkDynamicDynFlags dflags
+               hsc_env' <- newHscEnv dflags'
+               _ <- runPipeline' start_phase hsc_env' env input_fn
+                                 maybe_loc maybe_stub_o
+               return ()
          return r
 
 runPipeline'
-  :: Phase                      -- ^ When to start
+  :: PhasePlus                  -- ^ When to start
   -> HscEnv                     -- ^ Compilation environment
   -> PipeEnv
   -> FilePath                   -- ^ Input filename
@@ -588,88 +656,18 @@ runPipeline' start_phase hsc_env env input_fn
 
   evalP (pipeLoop start_phase input_fn) env state
 
--- -----------------------------------------------------------------------------
--- The pipeline uses a monad to carry around various bits of information
-
--- PipeEnv: invariant information passed down
-data PipeEnv = PipeEnv {
-       pe_isHaskellishFile :: Bool,
-       stop_phase   :: Phase,       -- ^ Stop just before this phase
-       src_filename :: String,      -- ^ basename of original input source
-       src_basename :: String,      -- ^ basename of original input source
-       src_suffix   :: String,      -- ^ its extension
-       output_spec  :: PipelineOutput -- ^ says where to put the pipeline output
-  }
-
--- PipeState: information that might change during a pipeline run
-data PipeState = PipeState {
-       hsc_env   :: HscEnv,
-          -- ^ only the DynFlags change in the HscEnv.  The DynFlags change
-          -- at various points, for example when we read the OPTIONS_GHC
-          -- pragmas in the Cpp phase.
-       maybe_loc :: Maybe ModLocation,
-          -- ^ the ModLocation.  This is discovered during compilation,
-          -- in the Hsc phase where we read the module header.
-       maybe_stub_o :: Maybe FilePath
-          -- ^ the stub object.  This is set by the Hsc phase if a stub
-          -- object was created.  The stub object will be joined with
-          -- the main compilation object using "ld -r" at the end.
-  }
-
-getPipeEnv :: CompPipeline PipeEnv
-getPipeEnv = P $ \env state -> return (state, env)
-
-getPipeState :: CompPipeline PipeState
-getPipeState = P $ \_env state -> return (state, state)
-
-instance HasDynFlags CompPipeline where
-    getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state))
-
-setDynFlags :: DynFlags -> CompPipeline ()
-setDynFlags dflags = P $ \_env state ->
-  return (state{hsc_env= (hsc_env state){ hsc_dflags = dflags }}, ())
-
-setModLocation :: ModLocation -> CompPipeline ()
-setModLocation loc = P $ \_env state ->
-  return (state{ maybe_loc = Just loc }, ())
-
-setStubO :: FilePath -> CompPipeline ()
-setStubO stub_o = P $ \_env state ->
-  return (state{ maybe_stub_o = Just stub_o }, ())
-
-newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) }
-
-evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO a
-evalP f env st = liftM snd $ unP f env st
-
-instance Monad CompPipeline where
-  return a = P $ \_env state -> return (state, a)
-  P m >>= k = P $ \env state -> do (state',a) <- m env state
-                                   unP (k a) env state'
-
-instance MonadIO CompPipeline where
-    liftIO m = P $ \_env state -> do a <- m; return (state, a)
-
-phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
-phaseOutputFilename next_phase = do
-  PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
-  PipeState{maybe_loc, hsc_env} <- getPipeState
-  let dflags = hsc_dflags hsc_env
-  liftIO $ getOutputFilename stop_phase output_spec
-                             src_basename dflags next_phase maybe_loc
-
 -- ---------------------------------------------------------------------------
 -- outer pipeline loop
 
 -- | pipeLoop runs phases until we reach the stop phase
-pipeLoop :: Phase -> FilePath -> CompPipeline (DynFlags, FilePath)
+pipeLoop :: PhasePlus -> FilePath -> CompPipeline (DynFlags, FilePath)
 pipeLoop phase input_fn = do
   env <- getPipeEnv
   dflags <- getDynFlags
   let happensBefore' = happensBefore dflags
       stopPhase = stop_phase env
-  case () of
-   _ | phase `eqPhase` stopPhase            -- All done
+  case phase of
+   RealPhase realPhase | realPhase `eqPhase` stopPhase            -- All done
      -> -- Sometimes, a compilation phase doesn't actually generate any output
         -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this
         -- stage, but we wanted to keep the output, then we have to explicitly
@@ -690,73 +688,95 @@ pipeLoop phase input_fn = do
                return (dflags, final_fn)
 
 
-     | not (phase `happensBefore'` stopPhase)
+     | not (realPhase `happensBefore'` stopPhase)
         -- Something has gone wrong.  We'll try to cover all the cases when
         -- this could happen, so if we reach here it is a panic.
         -- eg. it might happen if the -C flag is used on a source file that
         -- has {-# OPTIONS -fasm #-}.
-     -> panic ("pipeLoop: at phase " ++ show phase ++
+     -> panic ("pipeLoop: at phase " ++ show realPhase ++
            " but I wanted to stop at phase " ++ show stopPhase)
 
-     | otherwise
+   _
      -> 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
+           (next_phase, output_fn) <- runHookedPhase phase input_fn dflags
+           r <- pipeLoop next_phase output_fn
+           case phase of
+               HscOut {} ->
+                   whenGeneratingDynamicToo dflags $ do
+                       setDynFlags $ dynamicTooMkDynamicDynFlags dflags
+                       -- TODO shouldn't ignore result:
+                       _ <- pipeLoop phase input_fn
+                       return ()
+               _ ->
+                   return ()
+           return r
+
+runHookedPhase :: PhasePlus -> FilePath -> DynFlags
+               -> CompPipeline (PhasePlus, FilePath)
+runHookedPhase pp input dflags =
+  lookupHook runPhaseHook runPhase dflags pp input dflags
 
 -- -----------------------------------------------------------------------------
 -- In each phase, we need to know into what filename to generate the
 -- output.  All the logic about which filenames we generate output
 -- into is embodied in the following function.
 
+phaseOutputFilename :: Phase{-next phase-} -> CompPipeline FilePath
+phaseOutputFilename next_phase = do
+  PipeEnv{stop_phase, src_basename, output_spec} <- getPipeEnv
+  PipeState{maybe_loc, hsc_env} <- getPipeState
+  let dflags = hsc_dflags hsc_env
+  liftIO $ getOutputFilename stop_phase output_spec
+                             src_basename dflags next_phase maybe_loc
+
 getOutputFilename
   :: Phase -> PipelineOutput -> String
   -> DynFlags -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
-getOutputFilename stop_phase output basename
- = func
- where
-        func dflags next_phase maybe_location
-           | is_last_phase, Persistent <- output     = persistent_fn
-           | is_last_phase, SpecificFile f <- output = return f
-           | keep_this_output                        = persistent_fn
-           | otherwise                               = newTempName dflags suffix
-           where
-                hcsuf      = hcSuf dflags
-                odir       = objectDir dflags
-                osuf       = objectSuf dflags
-                keep_hc    = gopt Opt_KeepHcFiles dflags
-                keep_s     = gopt Opt_KeepSFiles dflags
-                keep_bc    = gopt Opt_KeepLlvmFiles dflags
-
-                myPhaseInputExt HCc       = hcsuf
-                myPhaseInputExt MergeStub = osuf
-                myPhaseInputExt StopLn    = osuf
-                myPhaseInputExt other     = phaseInputExt other
-
-                is_last_phase = next_phase `eqPhase` stop_phase
-
-                -- sometimes, we keep output from intermediate stages
-                keep_this_output =
-                     case next_phase of
-                             As      | keep_s     -> True
-                             LlvmOpt | keep_bc    -> True
-                             HCc     | keep_hc    -> True
-                             _other               -> False
-
-                suffix = myPhaseInputExt next_phase
-
-                -- persistent object files get put in odir
-                persistent_fn
-                   | StopLn <- next_phase = return odir_persistent
-                   | otherwise            = return persistent
-
-                persistent = basename <.> suffix
-
-                odir_persistent
-                   | Just loc <- maybe_location = ml_obj_file loc
-                   | Just d <- odir = d </> persistent
-                   | otherwise      = persistent
-
+getOutputFilename stop_phase output basename dflags next_phase maybe_location
+ | is_last_phase, Persistent   <- output = persistent_fn
+ | is_last_phase, SpecificFile <- output = case outputFile dflags of
+                                           Just f -> return f
+                                           Nothing ->
+                                               panic "SpecificFile: No filename"
+ | keep_this_output                      = persistent_fn
+ | otherwise                             = newTempName dflags suffix
+    where
+          hcsuf      = hcSuf dflags
+          odir       = objectDir dflags
+          osuf       = objectSuf dflags
+          keep_hc    = gopt Opt_KeepHcFiles dflags
+          keep_s     = gopt Opt_KeepSFiles dflags
+          keep_bc    = gopt Opt_KeepLlvmFiles dflags
+
+          myPhaseInputExt HCc       = hcsuf
+          myPhaseInputExt MergeStub = osuf
+          myPhaseInputExt StopLn    = osuf
+          myPhaseInputExt other     = phaseInputExt other
+
+          is_last_phase = next_phase `eqPhase` stop_phase
+
+          -- sometimes, we keep output from intermediate stages
+          keep_this_output =
+               case next_phase of
+                       As _    | keep_s     -> True
+                       LlvmOpt | keep_bc    -> True
+                       HCc     | keep_hc    -> True
+                       _other               -> False
+
+          suffix = myPhaseInputExt next_phase
+
+          -- persistent object files get put in odir
+          persistent_fn
+             | StopLn <- next_phase = return odir_persistent
+             | otherwise            = return persistent
+
+          persistent = basename <.> suffix
+
+          odir_persistent
+             | Just loc <- maybe_location = ml_obj_file loc
+             | Just d <- odir = d </> persistent
+             | otherwise      = persistent
 
 -- -----------------------------------------------------------------------------
 -- | Each phase in the pipeline returns the next phase to execute, and the
@@ -766,12 +786,12 @@ getOutputFilename stop_phase output basename
 -- what the rest of the phases will be until part-way through the
 -- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
 -- of a source file can change the latter stages of the pipeline from
--- taking the via-C route to using the native code generator.
+-- taking the LLVM route to using the native code generator.
 --
-runPhase :: Phase       -- ^ Run this phase
+runPhase :: PhasePlus   -- ^ Run this phase
          -> FilePath    -- ^ name of the input file
          -> DynFlags    -- ^ for convenience, we pass the current dflags in
-         -> CompPipeline (Phase,               -- next phase to run
+         -> CompPipeline (PhasePlus,           -- next phase to run
                           FilePath)            -- output filename
 
         -- Invariant: the output filename always contains the output
@@ -782,31 +802,30 @@ runPhase :: Phase       -- ^ Run this phase
 -------------------------------------------------------------------------------
 -- Unlit phase
 
-runPhase (Unlit sf) input_fn dflags
+runPhase (RealPhase (Unlit sf)) input_fn dflags
   = do
        output_fn <- phaseOutputFilename (Cpp sf)
 
-       let unlit_flags = getOpts dflags opt_L
-           flags = map SysTools.Option unlit_flags ++
-                   [ -- The -h option passes the file name for unlit to
+       let flags = [ -- The -h option passes the file name for unlit to
                      -- put in a #line directive
                      SysTools.Option     "-h"
-                   , SysTools.Option $ escape $ normalise input_fn
+                     -- See Note [Don't normalise input filenames].
+                   , SysTools.Option $ escape input_fn
                    , SysTools.FileOption "" input_fn
                    , SysTools.FileOption "" output_fn
                    ]
 
        liftIO $ SysTools.runUnlit dflags flags
 
-       return (Cpp sf, output_fn)
+       return (RealPhase (Cpp sf), output_fn)
   where
        -- escape the characters \, ", and ', but don't try to escape
        -- Unicode or anything else (so we don't use Util.charToC
        -- here).  If we get this wrong, then in
-       -- Coverage.addTicksToBinds where we check that the filename in
+       -- Coverage.isGoodTickSrcSpan where we check that the filename in
        -- a SrcLoc is the same as the source filenaame, the two will
        -- look bogusly different. See test:
-       -- libraries/hpc/tests/function/subdir/tough2.lhs
+       -- libraries/hpc/tests/function/subdir/tough2.hs
        escape ('\\':cs) = '\\':'\\': escape cs
        escape ('\"':cs) = '\\':'\"': escape cs
        escape ('\'':cs) = '\\':'\'': escape cs
@@ -817,7 +836,7 @@ runPhase (Unlit sf) input_fn dflags
 -- Cpp phase : (a) gets OPTIONS out of file
 --             (b) runs cpp if necessary
 
-runPhase (Cpp sf) input_fn dflags0
+runPhase (RealPhase (Cpp sf)) input_fn dflags0
   = do
        src_opts <- liftIO $ getOptionsFromFile dflags0 input_fn
        (dflags1, unhandled_flags, warns)
@@ -832,10 +851,10 @@ runPhase (Cpp sf) input_fn dflags0
 
            -- no need to preprocess CPP, just pass input file along
            -- to the next phase of the pipeline.
-           return (HsPp sf, input_fn)
+           return (RealPhase (HsPp sf), input_fn)
         else do
             output_fn <- phaseOutputFilename (HsPp sf)
-            liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-}
+            liftIO $ doCpp dflags1 True{-raw-}
                            input_fn output_fn
             -- re-read the pragmas now that we've preprocessed the file
             -- See #2464,#3457
@@ -849,19 +868,18 @@ runPhase (Cpp sf) input_fn dflags0
 
             setDynFlags dflags2
 
-            return (HsPp sf, output_fn)
+            return (RealPhase (HsPp sf), output_fn)
 
 -------------------------------------------------------------------------------
 -- HsPp phase
 
-runPhase (HsPp sf) input_fn dflags
+runPhase (RealPhase (HsPp sf)) input_fn dflags
   = do
        if not (gopt Opt_Pp dflags) then
            -- no need to preprocess, just pass input file along
            -- to the next phase of the pipeline.
-          return (Hsc sf, input_fn)
+          return (RealPhase (Hsc sf), input_fn)
         else do
-            let hspp_opts = getOpts dflags opt_F
             PipeEnv{src_basename, src_suffix} <- getPipeEnv
             let orig_fn = src_basename <.> src_suffix
             output_fn <- phaseOutputFilename (Hsc sf)
@@ -869,8 +887,7 @@ runPhase (HsPp sf) input_fn dflags
                            ( [ SysTools.Option     orig_fn
                              , SysTools.Option     input_fn
                              , SysTools.FileOption "" output_fn
-                             ] ++
-                             map SysTools.Option hspp_opts
+                             ]
                            )
 
             -- re-read pragmas now that we've parsed the file (see #3674)
@@ -881,14 +898,14 @@ runPhase (HsPp sf) input_fn dflags
             liftIO $ checkProcessArgsResult dflags1 unhandled_flags
             liftIO $ handleFlagWarnings dflags1 warns
 
-            return (Hsc sf, output_fn)
+            return (RealPhase (Hsc sf), output_fn)
 
 -----------------------------------------------------------------------------
 -- Hsc phase
 
 -- Compilation of a single module, in "legacy" mode (_not_ under
 -- the direction of the compilation manager).
-runPhase (Hsc src_flavour) input_fn dflags0
+runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
  = do   -- normal Hsc mode, not mkdependHS
 
         PipeEnv{ stop_phase=stop,
@@ -905,51 +922,25 @@ runPhase (Hsc src_flavour) input_fn dflags0
         setDynFlags dflags
 
   -- gather the imports and module name
-        (hspp_buf,mod_name,imps,src_imps) <- liftIO $
-            case src_flavour of
-                ExtCoreFile -> do  -- no explicit imports in ExtCore input.
-                    m <- getCoreModuleName input_fn
-                    return (Nothing, mkModuleName m, [], [])
-
-                _           -> do
-                    buf <- hGetStringBuffer input_fn
-                    (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
-                    return (Just buf, mod_name, imps, src_imps)
-
-  -- Build a ModLocation to pass to hscMain.
-  -- The source filename is rather irrelevant by now, but it's used
-  -- by hscMain for messages.  hscMain also needs
-  -- the .hi and .o filenames, and this is as good a way
-  -- as any to generate them, and better than most. (e.g. takes
-  -- into accout the -osuf flags)
-        location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
-
-  -- Boot-ify it if necessary
-        let location2 | isHsBoot src_flavour = addBootSuffixLocn location1
-                      | otherwise            = location1
-
-
-  -- Take -ohi into account if present
-  -- This can't be done in mkHomeModuleLocation because
-  -- it only applies to the module being compiles
-        let ohi = outputHi dflags
-            location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
-                      | otherwise      = location2
+        (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
+          do
+            buf <- hGetStringBuffer input_fn
+            (src_imps,imps,L _ mod_name) <- getImports dflags buf input_fn (basename <.> suff)
+            return (Just buf, mod_name, imps, src_imps)
 
   -- Take -o into account if present
   -- Very like -ohi, but we must *only* do this if we aren't linking
   -- (If we're linking then the -o applies to the linked thing, not to
   -- the object file for one module.)
   -- Note the nasty duplication with the same computation in compileFile above
-        let expl_o_file = outputFile dflags
-            location4 | Just ofile <- expl_o_file
-                      , isNoLink (ghcLink dflags)
-                      = location3 { ml_obj_file = ofile }
-                      | otherwise = location3
-
-            o_file = ml_obj_file location4      -- The real object file
+        location <- getLocation src_flavour mod_name
 
-        setModLocation location4
+        let o_file = ml_obj_file location -- The real object file
+            hi_file = ml_hi_file location
+            dest_file | writeInterfaceOnlyMode dflags
+                            = hi_file
+                      | otherwise
+                            = o_file
 
   -- Figure out if the source has changed, for recompilation avoidance.
   --
@@ -960,7 +951,6 @@ runPhase (Hsc src_flavour) input_fn dflags0
   -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
         src_timestamp <- liftIO $ getModificationUTCTime (basename <.> suff)
 
-        let hsc_lang = hscTarget dflags
         source_unchanged <- liftIO $
           if not (isStopLn stop)
                 -- SourceModified unconditionally if
@@ -968,27 +958,18 @@ runPhase (Hsc src_flavour) input_fn dflags0
                 --      (b) we aren't going all the way to .o file (e.g. ghc -S)
              then return SourceModified
                 -- Otherwise look at file modification dates
-             else do o_file_exists <- doesFileExist o_file
-                     if not o_file_exists
+             else do dest_file_exists <- doesFileExist dest_file
+                     if not dest_file_exists
                         then return SourceModified       -- Need to recompile
-                        else do t2 <- getModificationUTCTime o_file
+                        else do t2 <- getModificationUTCTime dest_file
                                 if t2 > src_timestamp
                                   then return SourceUnmodified
                                   else return SourceModified
 
-  -- get the DynFlags
-        let next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
-        output_fn  <- phaseOutputFilename next_phase
-
-        let dflags' = dflags { hscTarget = hsc_lang,
-                               hscOutName = output_fn,
-                               extCoreName = basename ++ ".hcr" }
-
-        setDynFlags dflags'
         PipeState{hsc_env=hsc_env'} <- getPipeState
 
   -- Tell the finder cache about this module
-        mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location4
+        mod <- liftIO $ addHomeModuleToFinder hsc_env' mod_name location
 
   -- Make the ModSummary to hand to hscMain
         let
@@ -997,69 +978,88 @@ runPhase (Hsc src_flavour) input_fn dflags0
                                         ms_hspp_file = input_fn,
                                         ms_hspp_opts = dflags,
                                         ms_hspp_buf  = hspp_buf,
-                                        ms_location  = location4,
+                                        ms_location  = location,
                                         ms_hs_date   = src_timestamp,
                                         ms_obj_date  = Nothing,
+                                        ms_iface_date   = Nothing,
                                         ms_textual_imps = imps,
                                         ms_srcimps      = src_imps }
 
   -- run the compiler!
         result <- liftIO $ hscCompileOneShot hsc_env'
                                mod_summary source_unchanged
-                               Nothing -- No iface
-                               Nothing -- No "module i of n" progress info
+
+        return (HscOut src_flavour mod_name result,
+                panic "HscOut doesn't have an input filename")
+
+runPhase (HscOut src_flavour mod_name result) _ dflags = do
+        location <- getLocation src_flavour mod_name
+        setModLocation location
+
+        let o_file = ml_obj_file location -- The real object file
+            hsc_lang = hscTarget dflags
+            next_phase = hscPostBackendPhase dflags src_flavour hsc_lang
 
         case result of
-          HscNoRecomp
-              -> do liftIO $ touchObjectFile dflags' o_file
-                    -- The .o file must have a later modification date
-                    -- 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 _)
-              -> do case hasStub of
-                      Nothing -> return ()
-                      Just stub_c ->
-                          do stub_o <- liftIO $ compileStub hsc_env' stub_c
-                             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)
+            HscNotGeneratingCode ->
+                return (RealPhase next_phase,
+                        panic "No output filename from Hsc when no-code")
+            HscUpToDate ->
+                do liftIO $ touchObjectFile dflags o_file
+                   -- The .o file must have a later modification date
+                   -- than the source file (else we wouldn't get Nothing)
+                   -- but we touch it anyway, to keep 'make' happy (we think).
+                   return (RealPhase StopLn, o_file)
+            HscUpdateBoot ->
+                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
+                   return (RealPhase next_phase, o_file)
+            HscUpdateSig ->
+                do -- We need to create a REAL but empty .o file
+                   -- because we are going to attempt to put it in a library
+                   PipeState{hsc_env=hsc_env'} <- getPipeState
+                   let input_fn = expectJust "runPhase" (ml_hs_file location)
+                       basename = dropExtension input_fn
+                   liftIO $ compileEmptyStub dflags hsc_env' basename location
+                   return (RealPhase next_phase, o_file)
+            HscRecomp cgguts mod_summary
+              -> do output_fn <- phaseOutputFilename next_phase
+
+                    PipeState{hsc_env=hsc_env'} <- getPipeState
+
+                    (outputFilename, mStub) <- liftIO $ hscGenHardCode hsc_env' cgguts mod_summary output_fn
+                    case mStub of
+                        Nothing -> return ()
+                        Just stub_c ->
+                            do stub_o <- liftIO $ compileStub hsc_env' stub_c
+                               setStubO stub_o
+
+                    return (RealPhase next_phase, outputFilename)
 
 -----------------------------------------------------------------------------
 -- Cmm phase
 
-runPhase CmmCpp input_fn dflags
+runPhase (RealPhase CmmCpp) input_fn dflags
   = do
        output_fn <- phaseOutputFilename Cmm
-       liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-}
+       liftIO $ doCpp dflags False{-not raw-}
                       input_fn output_fn
-       return (Cmm, output_fn)
+       return (RealPhase Cmm, output_fn)
 
-runPhase Cmm input_fn dflags
+runPhase (RealPhase Cmm) input_fn dflags
   = do
-        PipeEnv{src_basename} <- getPipeEnv
         let hsc_lang = hscTarget dflags
 
         let next_phase = hscPostBackendPhase dflags HsSrcFile hsc_lang
 
         output_fn <- phaseOutputFilename next_phase
 
-        let dflags' = dflags { hscTarget = hsc_lang,
-                               hscOutName = output_fn,
-                               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 (next_phase, output_fn)
+        return (RealPhase next_phase, output_fn)
 
 -----------------------------------------------------------------------------
 -- Cc phase
@@ -1067,11 +1067,10 @@ runPhase Cmm input_fn dflags
 -- we don't support preprocessing .c files (with -E) now.  Doing so introduces
 -- way too many hacks, and I can't say I've ever used it anyway.
 
-runPhase cc_phase input_fn dflags
-   | any (cc_phase `eqPhase`) [Cc, Ccpp, HCc, Cobjc, Cobjcpp]
+runPhase (RealPhase cc_phase) input_fn dflags
+   | any (cc_phase `eqPhase`) [Cc, Ccplusplus, HCc, Cobjc, Cobjcplusplus]
    = do
         let platform = targetPlatform dflags
-            cc_opts = getOpts dflags opt_c
             hcc = cc_phase `eqPhase` HCc
 
         let cmdline_include_paths = includePaths dflags
@@ -1083,7 +1082,7 @@ runPhase cc_phase input_fn dflags
         -- files; this is the Value Add(TM) that using ghc instead of
         -- gcc gives you :)
         pkg_include_dirs <- liftIO $ getPackageIncludePath dflags pkgs
-        let include_paths = foldr (\ x xs -> "-I" : x : xs) []
+        let include_paths = foldr (\ x xs -> ("-I" ++ x) : xs) []
                               (cmdline_include_paths ++ pkg_include_dirs)
 
         let gcc_extra_viac_flags = extraGccViaCFlags dflags
@@ -1100,24 +1099,23 @@ runPhase cc_phase input_fn dflags
              else getPackageExtraCcOpts dflags pkgs
 
         framework_paths <-
-            case platformOS platform of
-            OSDarwin ->
-                do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs
-                   let cmdlineFrameworkPaths = frameworkPaths dflags
-                   return $ map ("-F"++)
-                                (cmdlineFrameworkPaths ++ pkgFrameworkPaths)
-            _ ->
-                return []
+            if platformUsesFrameworks platform
+            then do pkgFrameworkPaths <- liftIO $ getPackageFrameworkPath dflags pkgs
+                    let cmdlineFrameworkPaths = frameworkPaths dflags
+                    return $ map ("-F"++)
+                                 (cmdlineFrameworkPaths ++ pkgFrameworkPaths)
+            else return []
 
         let split_objs = gopt Opt_SplitObjs dflags
             split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
                       | otherwise         = [ ]
 
-        let cc_opt | optLevel dflags >= 2 = "-O2"
-                   | otherwise            = "-O"
+        let cc_opt | optLevel dflags >= 2 = [ "-O2" ]
+                   | optLevel dflags >= 1 = [ "-O" ]
+                   | otherwise            = []
 
         -- Decide next phase
-        let next_phase = As
+        let next_phase = As False
         output_fn <- phaseOutputFilename next_phase
 
         let
@@ -1137,10 +1135,12 @@ runPhase cc_phase input_fn dflags
                 -- very weakly typed, being derived from C--.
                 ["-fno-strict-aliasing"]
 
-        let gcc_lang_opt | cc_phase `eqPhase` Ccpp  = "c++"
-                         | cc_phase `eqPhase` Cobjc = "objective-c"
-                         | cc_phase `eqPhase` Cobjcpp = "objective-c++"
-                         | otherwise                = "c"
+        ghcVersionH <- liftIO $ getGhcVersionPathName dflags
+
+        let gcc_lang_opt | cc_phase `eqPhase` Ccplusplus    = "c++"
+                         | cc_phase `eqPhase` Cobjc   = "objective-c"
+                         | cc_phase `eqPhase` Cobjcplusplus = "objective-c++"
+                         | otherwise                  = "c"
         liftIO $ SysTools.runCc dflags (
                 -- force the C compiler to interpret this file as C when
                 -- compiling .hc files, by adding the -x c option.
@@ -1160,7 +1160,7 @@ runPhase cc_phase input_fn dflags
                 -- way we do the import depends on whether we're currently compiling
                 -- the base package or not.
                        ++ (if platformOS platform == OSMinGW32 &&
-                              thisPackage dflags == basePackageId
+                              thisPackage dflags == basePackageKey
                                 then [ "-DCOMPILING_BASE_PACKAGE" ]
                                 else [])
 
@@ -1176,7 +1176,8 @@ runPhase cc_phase input_fn dflags
                            else [])
 
                        -- GCC 4.6+ doesn't like -Wimplicit when compiling C++.
-                       ++ (if (cc_phase /= Ccpp && cc_phase /= Cobjcpp)
+                       ++ (if (cc_phase /= Ccplusplus &&
+                               cc_phase /= Cobjcplusplus)
                              then ["-Wimplicit"]
                              else [])
 
@@ -1184,21 +1185,23 @@ runPhase cc_phase input_fn dflags
                              then gcc_extra_viac_flags ++ more_hcc_opts
                              else [])
                        ++ verbFlags
-                       ++ [ "-S", cc_opt ]
-                       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
+                       ++ [ "-S" ]
+                       ++ cc_opt
+                       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt
+                          , "-include", ghcVersionH
+                          ]
                        ++ framework_paths
-                       ++ cc_opts
                        ++ split_opt
                        ++ include_paths
                        ++ pkg_extra_cc_opts
                        ))
 
-        return (next_phase, output_fn)
+        return (RealPhase next_phase, output_fn)
 
 -----------------------------------------------------------------------------
 -- Splitting phase
 
-runPhase Splitter input_fn dflags
+runPhase (RealPhase Splitter) input_fn dflags
   = do  -- tmp_pfx is the prefix used for the split .s files
 
         split_s_prefix <- liftIO $ SysTools.newTempName dflags "split"
@@ -1222,14 +1225,14 @@ runPhase Splitter input_fn dflags
                                  [ split_s_prefix ++ "__" ++ show n ++ ".s"
                                  | n <- [1..n_files]]
 
-        return (SplitAs,
+        return (RealPhase SplitAs,
                 "**splitter**") -- we don't use the filename in SplitAs
 
 -----------------------------------------------------------------------------
 -- As, SpitAs phase : Assembler
 
 -- This is for calling the assembler on a regular assembly file (not split).
-runPhase As input_fn dflags
+runPhase (RealPhase (As with_cpp)) input_fn dflags
   = do
         -- LLVM from version 3.0 onwards doesn't support the OS X system
         -- assembler, so we use clang as the assembler instead. (#5636)
@@ -1246,8 +1249,8 @@ runPhase As input_fn dflags
                         | otherwise = return SysTools.runAs
 
         as_prog <- whichAsProg
-        let as_opts = getOpts dflags opt_a
-            cmdline_include_paths = includePaths dflags
+        let cmdline_include_paths = includePaths dflags
+        let pic_c_flags = picCCOpts dflags
 
         next_phase <- maybeMergeStub
         output_fn <- phaseOutputFilename next_phase
@@ -1256,10 +1259,13 @@ runPhase As input_fn dflags
         -- might be a hierarchical module.
         liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
 
+        ccInfo <- liftIO $ getCompilerInfo dflags
         let runAssembler inputFilename outputFilename
                 = liftIO $ as_prog dflags
-                       (map SysTools.Option as_opts
-                       ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
+                       ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
+
+                       -- See Note [-fPIC for assembler]
+                       ++ map SysTools.Option pic_c_flags
 
         -- We only support SparcV9 and better because V8 lacks an atomic CAS
         -- instruction so we have to make sure that the assembler accepts the
@@ -1271,8 +1277,13 @@ runPhase As input_fn dflags
                        ++ (if platformArch (targetPlatform dflags) == ArchSPARC
                            then [SysTools.Option "-mcpu=v9"]
                            else [])
-
-                       ++ [ SysTools.Option "-x", SysTools.Option "assembler-with-cpp"
+                       ++ (if any (ccInfo ==) [Clang, AppleClang, AppleClang51]
+                            then [SysTools.Option "-Qunused-arguments"]
+                            else [])
+                       ++ [ SysTools.Option "-x"
+                          , if with_cpp
+                              then SysTools.Option "assembler-with-cpp"
+                              else SysTools.Option "assembler"
                           , SysTools.Option "-c"
                           , SysTools.FileOption "" inputFilename
                           , SysTools.Option "-o"
@@ -1281,22 +1292,12 @@ runPhase 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 (next_phase, output_fn)
+        return (RealPhase next_phase, output_fn)
 
 
 -- This is for calling the assembler on a split assembly file (so a collection
 -- of assembly files)
-runPhase SplitAs _input_fn dflags
+runPhase (RealPhase SplitAs) _input_fn dflags
   = do
         -- we'll handle the stub_o file in this phase, so don't MergeStub,
         -- just jump straight to StopLn afterwards.
@@ -1307,6 +1308,9 @@ runPhase SplitAs _input_fn dflags
             osuf = objectSuf dflags
             split_odir  = base_o ++ "_" ++ osuf ++ "_split"
 
+        let pic_c_flags = picCCOpts dflags
+
+        -- this also creates the hierarchy
         liftIO $ createDirectoryIfMissing True split_odir
 
         -- remove M_split/ *.o, because we're going to archive M_split/ *.o
@@ -1315,8 +1319,6 @@ runPhase SplitAs _input_fn dflags
         liftIO $ mapM_ removeFile $
                 map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
 
-        let as_opts = getOpts dflags opt_a
-
         let (split_s_prefix, n) = case splitInfo dflags of
                                   Nothing -> panic "No split info"
                                   Just x -> x
@@ -1328,8 +1330,7 @@ runPhase SplitAs _input_fn dflags
                           takeFileName base_o ++ "__" ++ show n <.> osuf
 
         let assemble_file n
-              = SysTools.runAs dflags
-                         (map SysTools.Option as_opts ++
+              = SysTools.runAs dflags (
 
         -- We only support SparcV9 and better because V8 lacks an atomic CAS
         -- instruction so we have to make sure that the assembler accepts the
@@ -1342,6 +1343,9 @@ runPhase SplitAs _input_fn dflags
                            then [SysTools.Option "-mcpu=v9"]
                            else []) ++
 
+                          -- See Note [-fPIC for assembler]
+                          map SysTools.Option pic_c_flags ++
+
                           [ SysTools.Option "-c"
                           , SysTools.Option "-o"
                           , SysTools.FileOption "" (split_obj n)
@@ -1376,23 +1380,22 @@ runPhase SplitAs _input_fn dflags
         -- join them into a single .o file
         liftIO $ joinObjectFiles dflags (map split_obj [1..n]) output_fn
 
-        return (next_phase, output_fn)
+        return (RealPhase next_phase, output_fn)
 
 -----------------------------------------------------------------------------
 -- LlvmOpt phase
 
-runPhase LlvmOpt input_fn dflags
+runPhase (RealPhase LlvmOpt) input_fn dflags
   = do
     ver <- liftIO $ readIORef (llvmVersion dflags)
 
-    let lo_opts  = getOpts dflags opt_lo
-        opt_lvl  = max 0 (min 2 $ optLevel dflags)
+    let opt_lvl  = max 0 (min 2 $ optLevel dflags)
         -- don't specify anything if user has specified commands. We do this
         -- for opt but not llc since opt is very specifically for optimisation
         -- passes only, so if the user is passing us extra options we assume
         -- they know what they are doing and don't get in the way.
-        optFlag  = if null lo_opts
-                       then [SysTools.Option (llvmOpts !! opt_lvl)]
+        optFlag  = if null (getOpts dflags opt_lo)
+                       then map SysTools.Option $ words (llvmOpts ver !! opt_lvl)
                        else []
         tbaa | ver < 29                 = "" -- no tbaa in 2.8 and earlier
              | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
@@ -1406,27 +1409,32 @@ runPhase LlvmOpt input_fn dflags
                     SysTools.Option "-o",
                     SysTools.FileOption "" output_fn]
                 ++ optFlag
-                ++ [SysTools.Option tbaa]
-                ++ map SysTools.Option lo_opts)
+                ++ [SysTools.Option tbaa])
 
-    return (LlvmLlc, output_fn)
+    return (RealPhase LlvmLlc, output_fn)
   where 
         -- we always (unless -optlo specified) run Opt since we rely on it to
         -- fix up some pretty big deficiencies in the code we generate
-        llvmOpts = ["-mem2reg", "-O1", "-O2"]
+        llvmOpts ver = [ "-mem2reg -globalopt"
+                       , if ver >= 34 then "-O1 -globalopt" else "-O1"
+                         -- LLVM 3.4 -O1 doesn't eliminate aliases reliably (bug #8855)
+                       , "-O2"
+                       ]
 
 -----------------------------------------------------------------------------
 -- LlvmLlc phase
 
-runPhase LlvmLlc input_fn dflags
+runPhase (RealPhase LlvmLlc) input_fn dflags
   = do
     ver <- liftIO $ readIORef (llvmVersion dflags)
 
-    let lc_opts = getOpts dflags opt_lc
-        opt_lvl = max 0 (min 2 $ optLevel dflags)
-        rmodel | gopt Opt_PIC dflags          = "pic"
-               | not (gopt Opt_Static dflags) = "dynamic-no-pic"
-               | otherwise                    = "static"
+    let opt_lvl = max 0 (min 2 $ optLevel dflags)
+        -- iOS requires external references to be loaded indirectly from the
+        -- DATA segment or dyld traps at runtime writing into TEXT: see #7722
+        rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic"
+               | gopt Opt_PIC dflags                         = "pic"
+               | not (gopt Opt_Static dflags)                = "dynamic-no-pic"
+               | otherwise                                   = "static"
         tbaa | ver < 29                 = "" -- no tbaa in 2.8 and earlier
              | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
              | otherwise                = "--enable-tbaa=false"
@@ -1435,22 +1443,29 @@ runPhase LlvmLlc input_fn dflags
     let next_phase = case gopt Opt_NoLlvmMangler dflags of
                          False                            -> LlvmMangle
                          True | gopt Opt_SplitObjs dflags -> Splitter
-                         True                             -> As
+                         True                             -> As False
                         
     output_fn <- phaseOutputFilename next_phase
 
+    -- AVX can cause LLVM 3.2 to generate a C-like frame pointer
+    -- prelude, see #9391
+    when (ver == 32 && isAvxEnabled dflags) $ liftIO $ errorMsg dflags $ text
+      "Note: LLVM 3.2 has known problems with AVX instructions (see trac #9391)"
+
     liftIO $ SysTools.runLlvmLlc dflags
                 ([ SysTools.Option (llvmOpts !! opt_lvl),
                     SysTools.Option $ "-relocation-model=" ++ rmodel,
                     SysTools.FileOption "" input_fn,
                     SysTools.Option "-o", SysTools.FileOption "" output_fn]
-                ++ map SysTools.Option lc_opts
                 ++ [SysTools.Option tbaa]
                 ++ map SysTools.Option fpOpts
                 ++ map SysTools.Option abiOpts
-                ++ map SysTools.Option sseOpts)
+                ++ map SysTools.Option sseOpts
+                ++ map SysTools.Option (avxOpts ver)
+                ++ map SysTools.Option avx512Opts
+                ++ map SysTools.Option stackAlignOpts)
 
-    return (next_phase, output_fn)
+    return (RealPhase next_phase, output_fn)
   where
         -- Bug in LLVM at O3 on OSX.
         llvmOpts = if platformOS (targetPlatform dflags) == OSDarwin
@@ -1479,40 +1494,52 @@ runPhase LlvmLlc input_fn dflags
 
         sseOpts | isSse4_2Enabled dflags = ["-mattr=+sse42"]
                 | isSse2Enabled dflags   = ["-mattr=+sse2"]
+                | isSseEnabled dflags    = ["-mattr=+sse"]
                 | otherwise              = []
 
+        avxOpts ver | isAvx512fEnabled dflags = ["-mattr=+avx512f"]
+                    | isAvx2Enabled dflags    = ["-mattr=+avx2"]
+                    | isAvxEnabled dflags     = ["-mattr=+avx"]
+                    | ver == 32               = ["-mattr=-avx"] -- see #9391
+                    | otherwise               = []
+
+        avx512Opts =
+          [ "-mattr=+avx512cd" | isAvx512cdEnabled dflags ] ++
+          [ "-mattr=+avx512er" | isAvx512erEnabled dflags ] ++
+          [ "-mattr=+avx512pf" | isAvx512pfEnabled dflags ]
+
+        stackAlignOpts =
+            case platformArch (targetPlatform dflags) of
+              ArchX86_64 | isAvxEnabled dflags -> ["-stack-alignment=32"]
+              _                                -> []
+
 -----------------------------------------------------------------------------
 -- LlvmMangle phase
 
-runPhase LlvmMangle input_fn dflags
+runPhase (RealPhase LlvmMangle) input_fn dflags
   = do
-      let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As
+      let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As False
       output_fn <- phaseOutputFilename next_phase
       liftIO $ llvmFixupAsm dflags input_fn output_fn
-      return (next_phase, output_fn)
+      return (RealPhase next_phase, output_fn)
 
 -----------------------------------------------------------------------------
 -- merge in stub objects
 
-runPhase MergeStub input_fn dflags
+runPhase (RealPhase MergeStub) input_fn dflags
  = do
      PipeState{maybe_stub_o} <- getPipeState
      output_fn <- phaseOutputFilename StopLn
+     liftIO $ createDirectoryIfMissing True (takeDirectory output_fn)
      case maybe_stub_o of
        Nothing ->
          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 (StopLn, output_fn)
+         return (RealPhase StopLn, output_fn)
 
 -- warning suppression
-runPhase other _input_fn _dflags =
+runPhase (RealPhase other) _input_fn _dflags =
    panic ("runPhase: don't know how to run phase " ++ show other)
 
 maybeMergeStub :: CompPipeline Phase
@@ -1521,6 +1548,46 @@ maybeMergeStub
      PipeState{maybe_stub_o} <- getPipeState
      if isJust maybe_stub_o then return MergeStub else return StopLn
 
+getLocation :: HscSource -> ModuleName -> CompPipeline ModLocation
+getLocation src_flavour mod_name = do
+    dflags <- getDynFlags
+
+    PipeEnv{ src_basename=basename,
+             src_suffix=suff } <- getPipeEnv
+
+    -- Build a ModLocation to pass to hscMain.
+    -- The source filename is rather irrelevant by now, but it's used
+    -- by hscMain for messages.  hscMain also needs
+    -- the .hi and .o filenames, and this is as good a way
+    -- as any to generate them, and better than most. (e.g. takes
+    -- into account the -osuf flags)
+    location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
+
+    -- Boot-ify it if necessary
+    let location2 | HsBootFile <- src_flavour = addBootSuffixLocn location1
+                  | otherwise                 = location1
+
+
+    -- Take -ohi into account if present
+    -- This can't be done in mkHomeModuleLocation because
+    -- it only applies to the module being compiles
+    let ohi = outputHi dflags
+        location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
+                  | otherwise      = location2
+
+    -- Take -o into account if present
+    -- Very like -ohi, but we must *only* do this if we aren't linking
+    -- (If we're linking then the -o applies to the linked thing, not to
+    -- the object file for one module.)
+    -- Note the nasty duplication with the same computation in compileFile above
+    let expl_o_file = outputFile dflags
+        location4 | Just ofile <- expl_o_file
+                  , isNoLink (ghcLink dflags)
+                  = location3 { ml_obj_file = ofile }
+                  | otherwise = location3
+
+    return location4
+
 -----------------------------------------------------------------------------
 -- MoveBinary sort-of-phase
 -- After having produced a binary, move it somewhere else and generate a
@@ -1557,13 +1624,12 @@ mkExtraObj dflags extn xs
  = do cFile <- newTempName dflags extn
       oFile <- newTempName dflags "o"
       writeFile cFile xs
-      let rtsDetails = getPackageDetails (pkgState dflags) rtsPackageId
+      let rtsDetails = getPackageDetails dflags rtsPackageKey
       SysTools.runCc dflags
                      ([Option        "-c",
                        FileOption "" cFile,
                        Option        "-o",
                        FileOption "" oFile]
-                      ++ map SysTools.Option (getOpts dflags opt_c) -- see #5528
                       ++ map (FileOption "-I") (includeDirs rtsDetails))
       return oFile
 
@@ -1582,31 +1648,32 @@ mkExtraObjToLinkIntoBinary dflags = do
 
    mkExtraObj dflags "c" (showSDoc dflags main)
 
-  where
-    main
-      | gopt Opt_NoHsMain dflags = empty
-      | otherwise = vcat [
-             ptext (sLit "#include \"Rts.h\""),
-             ptext (sLit "extern StgClosure ZCMain_main_closure;"),
-             ptext (sLit "int main(int argc, char *argv[])"),
-             char '{',
-             ptext (sLit "    RtsConfig __conf = defaultRtsConfig;"),
-             ptext (sLit "    __conf.rts_opts_enabled = ")
-                 <> text (show (rtsOptsEnabled dflags)) <> semi,
-             case rtsOpts dflags of
-                Nothing   -> empty
-                Just opts -> ptext (sLit "    __conf.rts_opts= ") <>
-                               text (show opts) <> semi,
-             ptext (sLit "    return hs_main(argc, argv, &ZCMain_main_closure,__conf);"),
-             char '}',
-             char '\n' -- final newline, to keep gcc happy
-           ]
+ where
+  main
+   | gopt Opt_NoHsMain dflags = Outputable.empty
+   | otherwise = vcat [
+      text "#include \"Rts.h\"",
+      text "extern StgClosure ZCMain_main_closure;",
+      text "int main(int argc, char *argv[])",
+      char '{',
+      text " RtsConfig __conf = defaultRtsConfig;",
+      text " __conf.rts_opts_enabled = "
+          <> text (show (rtsOptsEnabled dflags)) <> semi,
+      case rtsOpts dflags of
+         Nothing   -> Outputable.empty
+         Just opts -> ptext (sLit "    __conf.rts_opts= ") <>
+                        text (show opts) <> semi,
+      text " __conf.rts_hs_main = rtsTrue;",
+      text " return hs_main(argc,argv,&ZCMain_main_closure,__conf);",
+      char '}',
+      char '\n' -- final newline, to keep gcc happy
+     ]
 
 -- Write out the link info section into a new assembly file. Previously
 -- this was included as inline assembly in the main.c file but this
 -- is pretty fragile. gas gets upset trying to calculate relative offsets
 -- that span the .note section (notably .text) when debug info is present
-mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageId] -> IO [FilePath]
+mkNoteObjsToLinkIntoBinary :: DynFlags -> [PackageKey] -> IO [FilePath]
 mkNoteObjsToLinkIntoBinary dflags dep_packages = do
    link_info <- getLinkInfo dflags dep_packages
 
@@ -1621,7 +1688,17 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
                                    text elfSectionNote,
                                    text "\n",
 
-          text "\t.ascii \"", info', text "\"\n" ]
+          text "\t.ascii \"", info', text "\"\n",
+
+          -- ALL generated assembly must have this section to disable
+          -- executable stacks.  See also
+          -- compiler/nativeGen/AsmCodeGen.hs for another instance
+          -- where we need to do this.
+          (if platformHasGnuNonexecStack (targetPlatform dflags)
+           then text ".section .note.GNU-stack,\"\",@progbits\n"
+           else Outputable.empty)
+
+           ]
           where
             info' = text $ escape info
 
@@ -1637,12 +1714,12 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do
 -- link.  We save this information in the binary, and the next time we
 -- link, if nothing else has changed, we use the link info stored in
 -- the existing binary to decide whether to re-link or not.
-getLinkInfo :: DynFlags -> [PackageId] -> IO String
+getLinkInfo :: DynFlags -> [PackageKey] -> IO String
 getLinkInfo dflags dep_packages = do
    package_link_opts <- getPackageLinkOpts dflags dep_packages
-   pkg_frameworks <- case platformOS (targetPlatform dflags) of
-                     OSDarwin -> getPackageFrameworks dflags dep_packages
-                     _        -> return []
+   pkg_frameworks <- if platformUsesFrameworks (targetPlatform dflags)
+                     then getPackageFrameworks dflags dep_packages
+                     else return []
    let extra_ld_inputs = ldInputs dflags
    let
       link_info = (package_link_opts,
@@ -1650,7 +1727,7 @@ getLinkInfo dflags dep_packages = do
                    rtsOpts dflags,
                    rtsOptsEnabled dflags,
                    gopt Opt_NoHsMain dflags,
-                   extra_ld_inputs,
+                   map showOpt extra_ld_inputs,
                    getOpts dflags opt_l)
    --
    return (show link_info)
@@ -1715,13 +1792,13 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 -----------------------------------------------------------------------------
 -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
 
-getHCFilePackages :: FilePath -> IO [PackageId]
+getHCFilePackages :: FilePath -> IO [PackageKey]
 getHCFilePackages filename =
   Exception.bracket (openFile filename ReadMode) hClose $ \h -> do
     l <- hGetLine h
     case l of
       '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
-          return (map stringToPackageId (words rest))
+          return (map stringToPackageKey (words rest))
       _other ->
           return []
 
@@ -1738,12 +1815,15 @@ getHCFilePackages filename =
 -- read any interface files), so the user must explicitly specify all
 -- the packages.
 
-linkBinary :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
-linkBinary dflags o_files dep_packages = do
+linkBinary :: DynFlags -> [FilePath] -> [PackageKey] -> IO ()
+linkBinary = linkBinary' False
+
+linkBinary' :: Bool -> DynFlags -> [FilePath] -> [PackageKey] -> IO ()
+linkBinary' staticLink dflags o_files dep_packages = do
     let platform = targetPlatform dflags
         mySettings = settings dflags
         verbFlags = getVerbFlags dflags
-        output_fn = exeFileName dflags
+        output_fn = exeFileName staticLink dflags
 
     -- get the full list of packages to link with, by combining the
     -- explicit packages with the auto packages and all of their
@@ -1776,6 +1856,15 @@ linkBinary dflags o_files dep_packages = do
                               then []
                               else ["-Wl,-rpath-link", "-Wl," ++ l]
               in ["-L" ++ l] ++ rpathlink ++ rpath
+         | osMachOTarget (platformOS platform) &&
+           dynLibLoader dflags == SystemDependent &&
+           not (gopt Opt_Static dflags) &&
+           gopt Opt_RPath dflags
+            = let libpath = if gopt Opt_RelativeDynlibPaths dflags
+                            then "@loader_path" </>
+                                 (l `makeRelativeTo` full_output_fn)
+                            else l
+              in ["-L" ++ l] ++ ["-Wl,-rpath", "-Wl," ++ libpath]
          | otherwise = ["-L" ++ l]
 
     let lib_paths = libraryPaths dflags
@@ -1784,48 +1873,55 @@ linkBinary dflags o_files dep_packages = do
     extraLinkObj <- mkExtraObjToLinkIntoBinary dflags
     noteLinkObjs <- mkNoteObjsToLinkIntoBinary dflags dep_packages
 
-    pkg_link_opts <- getPackageLinkOpts dflags dep_packages
+    pkg_link_opts <- do
+        (package_hs_libs, extra_libs, other_flags) <- getPackageLinkOpts dflags dep_packages
+        return $ if staticLink
+            then package_hs_libs -- If building an executable really means making a static
+                                 -- library (e.g. iOS), then we only keep the -l options for
+                                 -- HS packages, because libtool doesn't accept other options.
+                                 -- In the case of iOS these need to be added by hand to the
+                                 -- final link in Xcode.
+            else other_flags ++ package_hs_libs ++ extra_libs -- -Wl,-u,<sym> contained in other_flags
+                                                              -- needs to be put before -l<package>,
+                                                              -- otherwise Solaris linker fails linking
+                                                              -- a binary with unresolved symbols in RTS
+                                                              -- which are defined in base package
+                                                              -- the reason for this is a note in ld(1) about
+                                                              -- '-u' option: "The placement of this option
+                                                              -- on the command line is significant.
+                                                              -- This option must be placed before the library
+                                                              -- that defines the symbol."
 
     pkg_framework_path_opts <-
-        case platformOS platform of
-        OSDarwin ->
-            do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
-               return $ map ("-F" ++) pkg_framework_paths
-        _ ->
-            return []
+        if platformUsesFrameworks platform
+        then do pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
+                return $ map ("-F" ++) pkg_framework_paths
+        else return []
 
     framework_path_opts <-
-        case platformOS platform of
-        OSDarwin ->
-            do let framework_paths = frameworkPaths dflags
-               return $ map ("-F" ++) framework_paths
-        _ ->
-            return []
+        if platformUsesFrameworks platform
+        then do let framework_paths = frameworkPaths dflags
+                return $ map ("-F" ++) framework_paths
+        else return []
 
     pkg_framework_opts <-
-        case platformOS platform of
-        OSDarwin ->
-            do pkg_frameworks <- getPackageFrameworks dflags dep_packages
-               return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
-        _ ->
-            return []
+        if platformUsesFrameworks platform
+        then do pkg_frameworks <- getPackageFrameworks dflags dep_packages
+                return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
+        else return []
 
     framework_opts <-
-        case platformOS platform of
-        OSDarwin ->
-            do let frameworks = cmdlineFrameworks dflags
-               -- reverse because they're added in reverse order from
-               -- the cmd line:
-               return $ concat [ ["-framework", fw] | fw <- reverse frameworks ]
-        _ ->
-            return []
+        if platformUsesFrameworks platform
+        then do let frameworks = cmdlineFrameworks dflags
+                -- reverse because they're added in reverse order from
+                -- the cmd line:
+                return $ concat [ ["-framework", fw]
+                                | fw <- reverse frameworks ]
+        else return []
 
         -- probably _stub.o files
     let extra_ld_inputs = ldInputs dflags
 
-        -- opts from -optl-<blah> (including -l<blah> options)
-    let extra_ld_opts = getOpts dflags opt_l
-
     -- Here are some libs that need to be linked at the *end* of
     -- the command line, because they contain symbols that are referred to
     -- by the RTS.  We can't therefore use the ordinary way opts for these.
@@ -1842,14 +1938,17 @@ linkBinary dflags o_files dep_packages = do
             let os = platformOS (targetPlatform dflags)
             in if os == OSOsf3 then ["-lpthread", "-lexc"]
                else if os `elem` [OSMinGW32, OSFreeBSD, OSOpenBSD,
-                                  OSNetBSD, OSHaiku, OSQNXNTO]
+                                  OSNetBSD, OSHaiku, OSQNXNTO, OSiOS, OSDarwin]
                then []
                else ["-lpthread"]
          | otherwise               = []
 
     rc_objs <- maybeCreateManifest dflags output_fn
 
-    SysTools.runLink dflags (
+    let link = if staticLink
+                   then SysTools.runLibtool
+                   else SysTools.runLink
+    link dflags (
                        map SysTools.Option verbFlags
                       ++ [ SysTools.Option "-o"
                          , SysTools.FileOption "" output_fn
@@ -1872,11 +1971,24 @@ linkBinary dflags o_files dep_packages = do
                       --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
                       -- on x86.
                       ++ (if sLdSupportsCompactUnwind mySettings &&
-                             platformOS   platform == OSDarwin &&
-                             platformArch platform `elem` [ArchX86, ArchX86_64]
+                             not staticLink &&
+                             (platformOS platform == OSDarwin || platformOS platform == OSiOS) &&
+                             case platformArch platform of
+                               ArchX86 -> True
+                               ArchX86_64 -> True
+                               ArchARM {} -> True
+                               ArchARM64  -> True
+                               _ -> False
                           then ["-Wl,-no_compact_unwind"]
                           else [])
 
+                      -- '-no_pie'
+                      -- iOS uses 'dynamic-no-pic', so we must pass this to ld to suppress a warning; see #7722
+                      ++ (if platformOS platform == OSiOS &&
+                             not staticLink
+                          then ["-Wl,-no_pie"]
+                          else [])
+
                       -- '-Wl,-read_only_relocs,suppress'
                       -- ld gives loads of warnings like:
                       --     ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
@@ -1884,15 +1996,16 @@ linkBinary dflags o_files dep_packages = do
                       -- whether this is something we ought to fix, but
                       -- for now this flags silences them.
                       ++ (if platformOS   platform == OSDarwin &&
-                             platformArch platform == ArchX86
+                             platformArch platform == ArchX86 &&
+                             not staticLink
                           then ["-Wl,-read_only_relocs,suppress"]
                           else [])
 
                       ++ o_files
+                      ++ lib_path_opts)
                       ++ extra_ld_inputs
-                      ++ lib_path_opts
-                      ++ extra_ld_opts
-                      ++ rc_objs
+                      ++ map SysTools.Option (
+                         rc_objs
                       ++ framework_path_opts
                       ++ framework_opts
                       ++ pkg_lib_path_opts
@@ -1910,18 +2023,22 @@ linkBinary dflags o_files dep_packages = do
         throwGhcExceptionIO (InstallationError ("cannot move binary"))
 
 
-exeFileName :: DynFlags -> FilePath
-exeFileName dflags
+exeFileName :: Bool -> DynFlags -> FilePath
+exeFileName staticLink dflags
   | Just s <- outputFile dflags =
-      if platformOS (targetPlatform dflags) == OSMinGW32
-      then if null (takeExtension s)
-           then s <.> "exe"
-           else s
-      else s
+      case platformOS (targetPlatform dflags) of
+          OSMinGW32 -> s <?.> "exe"
+          _         -> if staticLink
+                         then s <?.> "a"
+                         else s
   | otherwise =
       if platformOS (targetPlatform dflags) == OSMinGW32
       then "main.exe"
-      else "a.out"
+      else if staticLink
+           then "liba.a"
+           else "a.out"
+ where s <?.> ext | null (takeExtension s) = s <.> ext
+                  | otherwise              = s
 
 maybeCreateManifest
    :: DynFlags
@@ -1963,12 +2080,10 @@ maybeCreateManifest dflags exe_filename
                -- show is a bit hackish above, but we need to escape the
                -- backslashes in the path.
 
-         let wr_opts = getOpts dflags opt_windres
          runWindres dflags $ map SysTools.Option $
                ["--input="++rc_filename,
                 "--output="++rc_obj_filename,
                 "--output-format=coff"]
-               ++ wr_opts
                -- no FileOptions here: windres doesn't like seeing
                -- backslashes, apparently
 
@@ -1978,7 +2093,7 @@ maybeCreateManifest dflags exe_filename
  | otherwise = return []
 
 
-linkDynLibCheck :: DynFlags -> [String] -> [PackageId] -> IO ()
+linkDynLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
 linkDynLibCheck dflags o_files dep_packages
  = do
     when (haveRtsOptsFlags dflags) $ do
@@ -1988,12 +2103,19 @@ linkDynLibCheck dflags o_files dep_packages
 
     linkDynLib dflags o_files dep_packages
 
+linkStaticLibCheck :: DynFlags -> [String] -> [PackageKey] -> IO ()
+linkStaticLibCheck dflags o_files dep_packages
+ = do
+    when (platformOS (targetPlatform dflags) `notElem` [OSiOS, OSDarwin]) $
+      throwGhcExceptionIO (ProgramError "Static archive creation only supported on Darwin/OS X/iOS")
+    linkBinary' True dflags o_files dep_packages
+
 -- -----------------------------------------------------------------------------
 -- Running CPP
 
-doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
-doCpp dflags raw include_cc_opts input_fn output_fn = do
-    let hscpp_opts = getOpts dflags opt_P ++ picPOpts dflags
+doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
+doCpp dflags raw input_fn output_fn = do
+    let hscpp_opts = picPOpts dflags
     let cmdline_include_paths = includePaths dflags
 
     pkg_include_dirs <- getPackageIncludePath dflags []
@@ -2002,10 +2124,6 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
 
     let verbFlags = getVerbFlags dflags
 
-    let cc_opts
-          | include_cc_opts = getOpts dflags opt_c
-          | otherwise       = []
-
     let cpp_prog args | raw       = SysTools.runCpp dflags args
                       | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
 
@@ -2017,25 +2135,48 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
         -- remember, in code we *compile*, the HOST is the same our TARGET,
         -- and BUILD is the same as our HOST.
 
-    let sse2 = isSse2Enabled dflags
-        sse4_2 = isSse4_2Enabled dflags
-        sse_defs =
-          [ "-D__SSE__=1" | sse2 || sse4_2 ] ++
-          [ "-D__SSE2__=1" | sse2 || sse4_2 ] ++
-          [ "-D__SSE4_2__=1" | sse4_2 ]
+    let sse_defs =
+          [ "-D__SSE__=1"    | isSseEnabled    dflags ] ++
+          [ "-D__SSE2__=1"   | isSse2Enabled   dflags ] ++
+          [ "-D__SSE4_2__=1" | isSse4_2Enabled dflags ]
+
+    let avx_defs =
+          [ "-D__AVX__=1"  | isAvxEnabled  dflags ] ++
+          [ "-D__AVX2__=1" | isAvx2Enabled dflags ] ++
+          [ "-D__AVX512CD__=1" | isAvx512cdEnabled dflags ] ++
+          [ "-D__AVX512ER__=1" | isAvx512erEnabled dflags ] ++
+          [ "-D__AVX512F__=1"  | isAvx512fEnabled  dflags ] ++
+          [ "-D__AVX512PF__=1" | isAvx512pfEnabled dflags ]
 
     backend_defs <- getBackendDefs dflags
 
+#ifdef GHCI
+    let th_defs = [ "-D__GLASGOW_HASKELL_TH__=YES" ]
+#else
+    let th_defs = [ "-D__GLASGOW_HASKELL_TH__=NO" ]
+#endif
+    -- Default CPP defines in Haskell source
+    ghcVersionH <- getGhcVersionPathName dflags
+    let hsSourceCppOpts =
+          [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt
+          , "-include", ghcVersionH
+          ]
+
     cpp_prog       (   map SysTools.Option verbFlags
                     ++ map SysTools.Option include_paths
                     ++ map SysTools.Option hsSourceCppOpts
                     ++ map SysTools.Option target_defs
                     ++ map SysTools.Option backend_defs
+                    ++ map SysTools.Option th_defs
                     ++ map SysTools.Option hscpp_opts
-                    ++ map SysTools.Option cc_opts
                     ++ map SysTools.Option sse_defs
+                    ++ map SysTools.Option avx_defs
+        -- Set the language mode to assembler-with-cpp when preprocessing. This
+        -- alleviates some of the C99 macro rules relating to whitespace and the hash
+        -- operator, which we tend to abuse. Clang in particular is not very happy
+        -- about this.
                     ++ [ SysTools.Option     "-x"
-                       , SysTools.Option     "c"
+                       , SysTools.Option     "assembler-with-cpp"
                        , SysTools.Option     input_fn
         -- We hackily use Option instead of FileOption here, so that the file
         -- name is not back-slashed on Windows.  cpp is capable of
@@ -2052,16 +2193,13 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
 getBackendDefs :: DynFlags -> IO [String]
 getBackendDefs dflags | hscTarget dflags == HscLlvm = do
     llvmVer <- figureLlvmVersion dflags
-    return [ "-D__GLASGOW_HASKELL_LLVM__="++show llvmVer ]
+    return $ case llvmVer of
+               Just n -> [ "-D__GLASGOW_HASKELL_LLVM__="++show n ]
+               _      -> []
 
 getBackendDefs _ =
     return []
 
-hsSourceCppOpts :: [String]
--- Default CPP defines in Haskell source
-hsSourceCppOpts =
-        [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
-
 -- ---------------------------------------------------------------------------
 -- join object files into a single relocatable object file, using ld -r
 
@@ -2069,22 +2207,28 @@ joinObjectFiles :: DynFlags -> [FilePath] -> FilePath -> IO ()
 joinObjectFiles dflags o_files output_fn = do
   let mySettings = settings dflags
       ldIsGnuLd = sLdIsGnuLd mySettings
-      ld_r args = SysTools.runLink dflags ([
-                            SysTools.Option "-nostdlib",
-                            SysTools.Option "-nodefaultlibs",
-                            SysTools.Option "-Wl,-r"
-                            ]
-                            -- gcc on sparc sets -Wl,--relax implicitly, but
-                            -- -r and --relax are incompatible for ld, so
-                            -- disable --relax explicitly.
-                         ++ (if platformArch (targetPlatform dflags) == ArchSPARC
-                             && ldIsGnuLd
-                                then [SysTools.Option "-Wl,-no-relax"]
-                                else [])
-                         ++ map SysTools.Option ld_build_id
-                         ++ [ SysTools.Option "-o",
-                              SysTools.FileOption "" output_fn ]
-                         ++ args)
+      osInfo = platformOS (targetPlatform dflags)
+      ld_r args cc = SysTools.runLink dflags ([
+                       SysTools.Option "-nostdlib",
+                       SysTools.Option "-Wl,-r"
+                     ]
+                     ++ (if any (cc ==) [Clang, AppleClang, AppleClang51]
+                          then []
+                          else [SysTools.Option "-nodefaultlibs"])
+                     ++ (if osInfo == OSFreeBSD
+                          then [SysTools.Option "-L/usr/lib"]
+                          else [])
+                        -- gcc on sparc sets -Wl,--relax implicitly, but
+                        -- -r and --relax are incompatible for ld, so
+                        -- disable --relax explicitly.
+                     ++ (if platformArch (targetPlatform dflags) == ArchSPARC
+                         && ldIsGnuLd
+                            then [SysTools.Option "-Wl,-no-relax"]
+                            else [])
+                     ++ map SysTools.Option ld_build_id
+                     ++ [ SysTools.Option "-o",
+                          SysTools.FileOption "" output_fn ]
+                     ++ args)
 
       -- suppress the generation of the .note.gnu.build-id section,
       -- which we don't need and sometimes causes ld to emit a
@@ -2092,25 +2236,40 @@ joinObjectFiles dflags o_files output_fn = do
       ld_build_id | sLdSupportsBuildId mySettings = ["-Wl,--build-id=none"]
                   | otherwise                     = []
 
+  ccInfo <- getCompilerInfo dflags
   if ldIsGnuLd
      then do
           script <- newTempName dflags "ldscript"
-          writeFile script $ "INPUT(" ++ unwords o_files ++ ")"
-          ld_r [SysTools.FileOption "" script]
+          cwd <- getCurrentDirectory
+          let o_files_abs = map (cwd </>) o_files
+          writeFile script $ "INPUT(" ++ unwords o_files_abs ++ ")"
+          ld_r [SysTools.FileOption "" script] ccInfo
+     else if sLdSupportsFilelist mySettings
+     then do
+          filelist <- newTempName dflags "filelist"
+          writeFile filelist $ unlines o_files
+          ld_r [SysTools.Option "-Wl,-filelist",
+                SysTools.FileOption "-Wl," filelist] ccInfo
      else do
-          ld_r (map (SysTools.FileOption "") o_files)
+          ld_r (map (SysTools.FileOption "") o_files) ccInfo
 
 -- -----------------------------------------------------------------------------
 -- Misc.
 
+writeInterfaceOnlyMode :: DynFlags -> Bool
+writeInterfaceOnlyMode dflags =
+ gopt Opt_WriteInterface dflags &&
+ HscNothing == hscTarget dflags
+
 -- | What phase to run after one of the backend code generators has run
 hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
 hscPostBackendPhase _ HsBootFile _    =  StopLn
+hscPostBackendPhase _ HsigFile _      =  StopLn
 hscPostBackendPhase dflags _ hsc_lang =
   case hsc_lang of
         HscC -> HCc
         HscAsm | gopt Opt_SplitObjs dflags -> Splitter
-               | otherwise                 -> As
+               | otherwise                 -> As False
         HscLlvm        -> LlvmOpt
         HscNothing     -> StopLn
         HscInterpreted -> StopLn
@@ -2125,3 +2284,111 @@ haveRtsOptsFlags dflags =
          isJust (rtsOpts dflags) || case rtsOptsEnabled dflags of
                                         RtsOptsSafeOnly -> False
                                         _ -> True
+
+-- | Find out path to @ghcversion.h@ file
+getGhcVersionPathName :: DynFlags -> IO FilePath
+getGhcVersionPathName dflags = do
+  dirs <- getPackageIncludePath dflags [rtsPackageKey]
+
+  found <- filterM doesFileExist (map (</> "ghcversion.h") dirs)
+  case found of
+      []    -> throwGhcExceptionIO (InstallationError ("ghcversion.h missing"))
+      (x:_) -> return x
+
+-- Note [-fPIC for assembler]
+-- When compiling .c source file GHC's driver pipeline basically
+-- does the following two things:
+--   1. ${CC}              -S 'PIC_CFLAGS' source.c
+--   2. ${CC} -x assembler -c 'PIC_CFLAGS' source.S
+--
+-- Why do we need to pass 'PIC_CFLAGS' both to C compiler and assembler?
+-- Because on some architectures (at least sparc32) assembler also chooses
+-- the relocation type!
+-- Consider the following C module:
+--
+--     /* pic-sample.c */
+--     int v;
+--     void set_v (int n) { v = n; }
+--     int  get_v (void)  { return v; }
+--
+--     $ gcc -S -fPIC pic-sample.c
+--     $ gcc -c       pic-sample.s -o pic-sample.no-pic.o # incorrect binary
+--     $ gcc -c -fPIC pic-sample.s -o pic-sample.pic.o    # correct binary
+--
+--     $ objdump -r -d pic-sample.pic.o    > pic-sample.pic.o.od
+--     $ objdump -r -d pic-sample.no-pic.o > pic-sample.no-pic.o.od
+--     $ diff -u pic-sample.pic.o.od pic-sample.no-pic.o.od
+--
+-- Most of architectures won't show any difference in this test, but on sparc32
+-- the following assembly snippet:
+--
+--    sethi   %hi(_GLOBAL_OFFSET_TABLE_-8), %l7
+--
+-- generates two kinds or relocations, only 'R_SPARC_PC22' is correct:
+--
+--       3c:  2f 00 00 00     sethi  %hi(0), %l7
+--    -                       3c: R_SPARC_PC22        _GLOBAL_OFFSET_TABLE_-0x8
+--    +                       3c: R_SPARC_HI22        _GLOBAL_OFFSET_TABLE_-0x8
+
+{- Note [Don't normalise input filenames]
+
+Summary
+  We used to normalise input filenames when starting the unlit phase. This
+  broke hpc in `--make` mode with imported literate modules (#2991).
+
+Introduction
+  1) --main
+  When compiling a module with --main, GHC scans its imports to find out which
+  other modules it needs to compile too. It turns out that there is a small
+  difference between saying `ghc --make A.hs`, when `A` imports `B`, and
+  specifying both modules on the command line with `ghc --make A.hs B.hs`. In
+  the former case, the filename for B is inferred to be './B.hs' instead of
+  'B.hs'.
+
+  2) unlit
+  When GHC compiles a literate haskell file, the source code first needs to go
+  through unlit, which turns it into normal Haskell source code. At the start
+  of the unlit phase, in `Driver.Pipeline.runPhase`, we call unlit with the
+  option `-h` and the name of the original file. We used to normalise this
+  filename using System.FilePath.normalise, which among other things removes
+  an initial './'. unlit then uses that filename in #line directives that it
+  inserts in the transformed source code.
+
+  3) SrcSpan
+  A SrcSpan represents a portion of a source code file. It has fields
+  linenumber, start column, end column, and also a reference to the file it
+  originated from. The SrcSpans for a literate haskell file refer to the
+  filename that was passed to unlit -h.
+
+  4) -fhpc
+  At some point during compilation with -fhpc, in the function
+  `deSugar.Coverage.isGoodTickSrcSpan`, we compare the filename that a
+  `SrcSpan` refers to with the name of the file we are currently compiling.
+  For some reason I don't yet understand, they can sometimes legitimally be
+  different, and then hpc ignores that SrcSpan.
+
+Problem
+  When running `ghc --make -fhpc A.hs`, where `A.hs` imports the literate
+  module `B.lhs`, `B` is inferred to be in the file `./B.lhs` (1). At the
+  start of the unlit phase, the name `./B.lhs` is normalised to `B.lhs` (2).
+  Therefore the SrcSpans of `B` refer to the file `B.lhs` (3), but we are
+  still compiling `./B.lhs`. Hpc thinks these two filenames are different (4),
+  doesn't include ticks for B, and we have unhappy customers (#2991).
+
+Solution
+  Do not normalise `input_fn` when starting the unlit phase.
+
+Alternative solution
+  Another option would be to not compare the two filenames on equality, but to
+  use System.FilePath.equalFilePath. That function first normalises its
+  arguments. The problem is that by the time we need to do the comparison, the
+  filenames have been turned into FastStrings, probably for performance
+  reasons, so System.FilePath.equalFilePath can not be used directly.
+
+Archeology
+  The call to `normalise` was added in a commit called "Fix slash
+  direction on Windows with the new filePath code" (c9b6b5e8). The problem
+  that commit was addressing has since been solved in a different manner, in a
+  commit called "Fix the filename passed to unlit" (1eedbc6b). So the
+  `normalise` is no longer necessary.
+-}