+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- GHC Driver
--
-----------------------------------------------------------------------------
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module DriverPipeline (
-- Run a series of compilation steps in a pipeline, for a
-- collection of source files.
stub_o = o_base ++ "_stub" `joinFileExt` o_ext
-- compile the _stub.c file w/ gcc
- let (stub_c,_) = mkStubPaths dflags (moduleName mod) location
+ let (stub_c,_,_) = mkStubPaths dflags (moduleName mod) location
runPipeline StopLn dflags (stub_c,Nothing) Nothing
(SpecificFile stub_o) Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Link
-link :: GhcLink -- interactive or batch
- -> DynFlags -- dynamic flags
- -> Bool -- attempt linking in batch mode?
- -> HomePackageTable -- what to link
+link :: GhcLink -- interactive or batch
+ -> DynFlags -- dynamic flags
+ -> Bool -- attempt linking in batch mode?
+ -> HomePackageTable -- what to link
-> IO SuccessFlag
-- For the moment, in the batch linker, we don't bother to tell doLink
#ifdef GHCI
link LinkInMemory dflags batch_attempt_linking hpt
= do -- Not Linking...(demand linker will do the job)
- return Succeeded
+ return Succeeded
#endif
link NoLink dflags batch_attempt_linking hpt
link LinkBinary dflags batch_attempt_linking hpt
| batch_attempt_linking
- = do
- let
- home_mod_infos = eltsUFM hpt
+ = do
+ let
+ home_mod_infos = eltsUFM hpt
- -- the packages we depend on
- pkg_deps = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
+ -- the packages we depend on
+ pkg_deps = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
- -- the linkables to link
- linkables = map (expectJust "link".hm_linkable) home_mod_infos
+ -- the linkables to link
+ linkables = map (expectJust "link".hm_linkable) home_mod_infos
debugTraceMsg dflags 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
- -- check for the -no-link flag
- if isNoLink (ghcLink dflags)
- then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
- return Succeeded
- else do
-
- let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
- obj_files = concatMap getOfiles linkables
-
- exe_file = exeFileName dflags
-
- -- if the modification time on the executable is later than the
- -- modification times on all of the objects, then omit linking
- -- (unless the -no-recomp flag was given).
- e_exe_time <- IO.try $ getModificationTime exe_file
- let linking_needed
- | Left _ <- e_exe_time = True
- | Right t <- e_exe_time =
- any (t <) (map linkableTime linkables)
-
- if not (dopt Opt_ForceRecomp dflags) && not linking_needed
- then do debugTraceMsg dflags 2 (text exe_file <+> ptext SLIT("is up to date, linking not required."))
- return Succeeded
- else do
-
- debugTraceMsg dflags 1 (ptext SLIT("Linking") <+> text exe_file
- <+> text "...")
-
- -- Don't showPass in Batch mode; doLink will do that for us.
- let link = case ghcLink dflags of
- LinkBinary -> linkBinary
- LinkDynLib -> linkDynLib
- link dflags obj_files pkg_deps
+ -- check for the -no-link flag
+ if isNoLink (ghcLink dflags)
+ then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
+ return Succeeded
+ else do
+
+ let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
+ obj_files = concatMap getOfiles linkables
+
+ exe_file = exeFileName dflags
+
+ -- if the modification time on the executable is later than the
+ -- modification times on all of the objects, then omit linking
+ -- (unless the -no-recomp flag was given).
+ e_exe_time <- IO.try $ getModificationTime exe_file
+ extra_ld_inputs <- readIORef v_Ld_inputs
+ extra_times <- mapM (IO.try . getModificationTime) extra_ld_inputs
+ let other_times = map linkableTime linkables
+ ++ [ t' | Right t' <- extra_times ]
+ linking_needed
+ | Left _ <- e_exe_time = True
+ | Right t <- e_exe_time = any (t <) other_times
+
+ if not (dopt Opt_ForceRecomp dflags) && not linking_needed
+ then do debugTraceMsg dflags 2 (text exe_file <+> ptext SLIT("is up to date, linking not required."))
+ return Succeeded
+ else do
+
+ debugTraceMsg dflags 1 (ptext SLIT("Linking") <+> text exe_file
+ <+> text "...")
+
+ -- Don't showPass in Batch mode; doLink will do that for us.
+ let link = case ghcLink dflags of
+ LinkBinary -> linkBinary
+ LinkDynLib -> linkDynLib
+ link dflags obj_files pkg_deps
debugTraceMsg dflags 3 (text "link: done")
- -- linkBinary only returns if it succeeds
+ -- linkBinary only returns if it succeeds
return Succeeded
| otherwise
= do debugTraceMsg dflags 3 (text "link(batch): upsweep (partially) failed OR" $$
text " Main.main not exported; not linking.")
return Succeeded
-
+
-- -----------------------------------------------------------------------------
-- Compile files in one-shot mode.
= do -- normal Hsc mode, not mkdependHS
-- we add the current directory (i.e. the directory in which
- -- the .hs files resides) to the import path, since this is
+ -- the .hs files resides) to the include path, since this is
-- what gcc does, and it's probably what you want.
let current_dir = directoryOf basename
rc_obj_filename <- newTempName dflags (objectSuf dflags)
writeFile rc_filename $
- "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
+ "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
-- magic numbers :-)
+ -- show is a bit hackish above, but we need to esacpe the
+ -- backslashes in the path.
let wr_opts = getOpts dflags opt_windres
runWindres dflags $ map SysTools.Option $