import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import Config
-import RdrName ( GlobalRdrEnv )
import Panic
import Util
import StringBuffer ( hGetStringBuffer )
import SrcLoc ( srcLocSpan, mkSrcLoc )
import FastString ( mkFastString )
import Bag ( listToBag, emptyBag )
+import SrcLoc ( Located(..) )
import EXCEPTION
import DATA_IOREF ( readIORef, writeIORef, IORef )
| otherwise -- Normal source file
-> do
- maybe_stub_o <- compileStub dflags' stub_c_exists
- let stub_unlinked = case maybe_stub_o of
- Nothing -> []
- Just stub_o -> [ DotO stub_o ]
+ stub_unlinked <-
+ if stub_c_exists then do
+ stub_o <- compileStub dflags' object_filename
+ return [ DotO stub_o ]
+ else
+ return []
(hs_unlinked, unlinked_time) <-
case hsc_lang of
#endif
Nothing -> panic "compile: no interpreted code"
+ HscNothing
+ -> return ([], ms_hs_date mod_summary)
+
-- We're in --make mode: finish the compilation pipeline.
_other
-> do runPipeline StopLn dflags (output_fn,Nothing) Persistent
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
-compileStub dflags stub_c_exists
- | not stub_c_exists = return Nothing
- | stub_c_exists = do
+-- The _stub.c file is derived from the haskell source file (but stored
+-- in hscStubCOutName in the dflags for some reason, probably historical).
+-- Consequently, we derive the _stub.o filename from the haskell object
+-- filename.
+--
+-- This isn't necessarily the same as the object filename we
+-- would get if we just compiled the _stub.c file using the pipeline.
+-- For example:
+--
+-- ghc src/A.hs -odir obj
+--
+-- results in obj/A.o, and src/A_stub.c. If we compile src/A_stub.c with
+-- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
+-- obj/A_stub.o.
+
+compileStub dflags object_filename = do
+ let (o_base, o_ext) = splitFilename object_filename
+ stub_o = o_base ++ "_stub" `joinFileExt` o_ext
+
-- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags
- (_, stub_o) <- runPipeline StopLn dflags
- (stub_c,Nothing) Persistent Nothing{-no ModLocation-}
- return (Just stub_o)
+ runPipeline StopLn dflags (stub_c,Nothing)
+ (SpecificFile stub_o) Nothing{-no ModLocation-}
+
+ return stub_o
-- ---------------------------------------------------------------------------
return Succeeded
else do
- debugTraceMsg dflags 1 "Linking ..."
-
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 dopt Opt_RecompChecking dflags && not linking_needed
+ then do debugTraceMsg dflags 1 (exe_file ++ " is up to date, linking not required.")
+ return Succeeded
+ else do
+
+ debugTraceMsg dflags 1 "Linking ..."
+
-- Don't showPass in Batch mode; doLink will do that for us.
staticLink dflags obj_files pkg_deps
odir_persistent
| Just loc <- maybe_location = ml_obj_file loc
- | Just d <- odir = replaceFilenameDirectory persistent d
+ | Just d <- odir = d `joinFileName` persistent
| otherwise = persistent
; return (Nothing, mkModule m) }
other -> do { buf <- hGetStringBuffer input_fn
- ; (_,_,mod_name) <- getImports dflags buf input_fn
+ ; (_,_,L _ mod_name) <- getImports dflags buf input_fn
; return (Just buf, mod_name) }
-- Build a ModLocation to pass to hscMain.
stub_h_exists stub_c_exists
_maybe_interpreted_code -> do
- -- Deal with stubs
- maybe_stub_o <- compileStub dflags' stub_c_exists
- case maybe_stub_o of
- Nothing -> return ()
- Just stub_o -> consIORef v_Ld_inputs stub_o
+ when stub_c_exists $ do
+ stub_o <- compileStub dflags' o_file
+ consIORef v_Ld_inputs stub_o
-- In the case of hs-boot files, generate a dummy .o-boot
-- stamp file for the benefit of Make
staticLink :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
staticLink dflags o_files dep_packages = do
let verb = getVerbFlag dflags
+ output_fn = exeFileName dflags
-- get the full list of packages to link with, by combining the
-- explicit packages with the auto packages and all of their
-- dependencies, and eliminating duplicates.
- let o_file = outputFile dflags
-#if defined(mingw32_HOST_OS)
- let output_fn = case o_file of { Just s -> s; Nothing -> "main.exe"; }
-#else
- let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
-#endif
-
pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
if success then return ()
else throwDyn (InstallationError ("cannot move binary to PVM dir")))
+
+exeFileName :: DynFlags -> FilePath
+exeFileName dflags
+ | Just s <- outputFile dflags = s
+ | otherwise =
+#if defined(mingw32_HOST_OS)
+ "main.exe"
+#else
+ "a.out"
+#endif
+
-----------------------------------------------------------------------------
-- Making a DLL (only for Win32)
projects / ghc-hetmet.git / blobdiff