-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.29 2000/11/17 13:33:17 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.40 2000/12/07 16:39:40 simonmar Exp $
--
-- GHC Driver
--
import HscTypes
import Outputable
import Module
+import ErrUtils
import CmdLineOpts
import Config
import Util
+import Time ( getClockTime )
import Directory
import System
import IOExts
-- what the suffix of the intermediate files should be, etc.
-- The following compilation pipeline algorithm is fairly hacky. A
--- better way to do this would be to express the whole comilation as a
+-- better way to do this would be to express the whole compilation as a
-- data flow DAG, where the nodes are the intermediate files and the
-- edges are the compilation phases. This framework would also work
-- nicely if a haskell dependency generator was included in the
-- concurrently, automatically taking advantage of extra processors on
-- the host machine. For example, when compiling two Haskell files
-- where one depends on the other, the data flow graph would determine
--- that the C compiler from the first comilation can be overlapped
--- with the hsc comilation for the second file.
+-- that the C compiler from the first compilation can be overlapped
+-- with the hsc compilation for the second file.
data IntermediateFileType
= Temporary
run_phase Unlit _basename _suff input_fn output_fn
= do unlit <- readIORef v_Pgm_L
unlit_flags <- getOpts opt_L
- run_something "Literate pre-processor"
+ runSomething "Literate pre-processor"
("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
return True
let include_paths = map (\p -> "-I"++p) (cmdline_include_paths
++ pkg_include_dirs)
- verb <- is_verbose
- run_something "C pre-processor"
+ verb <- getVerbFlag
+
+ runSomething "C pre-processor"
(unwords
(["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
cpp, verb]
++ [ "-x", "c", input_fn, ">>", output_fn ]
))
else do
- run_something "Ineffective C pre-processor"
+ runSomething "Ineffective C pre-processor"
("echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}' > "
++ output_fn ++ " && cat " ++ input_fn
++ " >> " ++ output_fn)
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
do_recomp <- readIORef v_Recomp
todo <- readIORef v_GhcMode
- o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
+ o_file' <- odir_ify (basename ++ '.':phaseInputExt Ln)
+ o_file <- osuf_ify o_file'
source_unchanged <-
if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
then return False
HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
- HscOK details maybe_iface maybe_stub_h maybe_stub_c
- _maybe_interpreted_code pcs -> do
+ HscNoRecomp pcs details iface ->
+ do {
+ runSomething "Touching object file" ("touch " ++ o_file);
+ return False;
+ };
+
+ HscRecomp pcs details iface maybe_stub_h maybe_stub_c
+ _maybe_interpreted_code -> do
-- deal with stubs
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o
- let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
- return keep_going
+ return True
}
-----------------------------------------------------------------------------
mangle <- readIORef v_Do_asm_mangling
(md_c_flags, md_regd_c_flags) <- machdepCCOpts
- verb <- is_verbose
+ verb <- getVerbFlag
o2 <- readIORef v_minus_o2_for_C
let opt_flag | o2 = "-O2"
excessPrecision <- readIORef v_Excess_precision
- run_something "C Compiler"
+ runSomething "C Compiler"
(unwords ([ cc, "-x", "c", cc_help, "-o", output_fn ]
++ md_c_flags
++ (if cc_phase == HCc && mangle
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
++ split_opt
-#ifdef mingw32_TARGET_OS
- ++ [" -mno-cygwin"]
-#endif
++ (if excessPrecision then [] else [ "-ffloat-store" ])
++ include_paths
++ pkg_extra_cc_opts
then do n_regs <- readState stolen_x86_regs
return [ show n_regs ]
else return []
- run_something "Assembly Mangler"
+ runSomething "Assembly Mangler"
(unwords (mangler :
mangler_opts
++ [ input_fn, output_fn ]
-- allocate a tmp file to put the no. of split .s files in (sigh)
n_files <- newTempName "n_files"
- run_something "Split Assembly File"
+ runSomething "Split Assembly File"
(unwords [ splitter
, input_fn
, split_s_prefix
cmdline_include_paths <- readIORef v_Include_paths
let cmdline_include_flags = map (\p -> "-I"++p) cmdline_include_paths
- run_something "Assembler"
+ runSomething "Assembler"
(unwords (as : as_opts
++ cmdline_include_flags
++ [ "-c", input_fn, "-o", output_fn ]
let output_o = newdir real_odir
(basename ++ "__" ++ show n ++ ".o")
real_o <- osuf_ify output_o
- run_something "Assembler"
+ runSomething "Assembler"
(unwords (as : as_opts
++ [ "-c", "-o", real_o, input_s ]
))
doLink :: [String] -> IO ()
doLink o_files = do
ln <- readIORef v_Pgm_l
- verb <- is_verbose
+ verb <- getVerbFlag
static <- readIORef v_Static
let imp = if static then "" else "_imp"
no_hs_main <- readIORef v_NoHsMain
else []
#endif
(md_c_flags, _) <- machdepCCOpts
- run_something "Linker"
+ runSomething "Linker"
(unwords
([ ln, verb, "-o", output_fn ]
++ md_c_flags
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
- do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
+ do init_driver_state <- readIORef v_InitDriverState
+ writeIORef v_Driver_state init_driver_state
+
+ pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
defaultHscLang filename
runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
-> IO CompResult
data CompResult
- = CompOK ModDetails -- new details (HST additions)
- (Maybe (ModIface, Linkable))
- -- summary and code; Nothing => compilation not reqd
- -- (old summary and code are still valid)
- PersistentCompilerState -- updated PCS
+ = CompOK PersistentCompilerState -- updated PCS
+ ModDetails -- new details (HST additions)
+ ModIface -- new iface (HIT additions)
+ (Maybe Linkable)
+ -- new code; Nothing => compilation was not reqd
+ -- (old code is still valid)
| CompErrs PersistentCompilerState -- updated PCS
compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
- verb <- readIORef v_Verbose
- when verb (hPutStrLn stderr
- (showSDoc (text "compile: compiling"
- <+> ppr (name_of_summary summary))))
-
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
+ init_driver_state <- readIORef v_InitDriverState
+ writeIORef v_Driver_state init_driver_state
+
+ showPass init_dyn_flags
+ (showSDoc (text "Compiling" <+> ppr (name_of_summary summary)))
- let location = ms_location summary
- let input_fn = unJust (ml_hs_file location) "compile:hs"
- let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
+ let verb = verbosity init_dyn_flags
+ let location = ms_location summary
+ let input_fn = unJust "compile:hs" (ml_hs_file location)
+ let input_fnpp = unJust "compile:hspp" (ml_hspp_file location)
- when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
+ when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
opts <- getOptionsFromSource input_fnpp
processArgs dynamic_flags opts []
source_unchanged
location old_iface hst hit pcs
- case hsc_result of {
- HscFail pcs -> return (CompErrs pcs);
+ case hsc_result of
+ HscFail pcs -> return (CompErrs pcs)
- HscOK details maybe_iface
- maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do
-
- -- if no compilation happened, bail out early
- case maybe_iface of {
- Nothing -> return (CompOK details Nothing pcs);
- Just iface -> do
+ HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
+ HscRecomp pcs details iface
+ maybe_stub_h maybe_stub_c maybe_interpreted_code -> do
+
let (basename, _) = splitFilename input_fn
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
let stub_unlinked = case maybe_stub_o of
Nothing -> []
Just stub_o -> [ DotO stub_o ]
- hs_unlinked <-
+ (hs_unlinked, unlinked_time) <-
case hsc_lang of
-- in interpreted mode, just return the compiled code
-- as our "unlinked" object.
HscInterpreted ->
case maybe_interpreted_code of
- Just (code,itbl_env) -> return [Trees code itbl_env]
- Nothing -> panic "compile: no interpreted code"
+ Just (code,itbl_env) -> do tm <- getClockTime
+ return ([Trees code itbl_env], tm)
+ Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
_other -> do pipe <- genPipeline (StopBefore Ln) "" True
-- the base name and use it as the base of
-- the output object file.
let (basename, suffix) = splitFilename input_fn
- o_file <- pipeLoop pipe output_fn False False basename suffix
- return [ DotO o_file ]
+ o_file <- pipeLoop pipe output_fn False False
+ basename suffix
+ o_time <- getModificationTime o_file
+ return ([DotO o_file], o_time)
+
+ let linkable = LM unlinked_time (moduleName (ms_mod summary))
+ (hs_unlinked ++ stub_unlinked)
- let linkable = LM (moduleName (ms_mod summary))
- (hs_unlinked ++ stub_unlinked)
+ return (CompOK pcs details iface (Just linkable))
- return (CompOK details (Just (iface, linkable)) pcs)
- }
- }
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
case maybe_stub_h of
Nothing -> return ()
Just tmp_stub_h -> do
- run_something "Copy stub .h file"
+ runSomething "Copy stub .h file"
("cp " ++ tmp_stub_h ++ ' ':stub_h)
-- #include <..._stub.h> in .hc file
case maybe_stub_c of
Nothing -> return Nothing
Just tmp_stub_c -> do -- copy the _stub.c file into the current dir
- run_something "Copy stub .c file"
+ runSomething "Copy stub .c file"
(unwords [
"rm -f", stub_c, "&&",
- "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
+ "echo \'#include \"Stg.h\"\n#include \""++stub_h++"\"\' >"++stub_c, " &&",
"cat", tmp_stub_c, ">> ", stub_c
])
projects / ghc-hetmet.git / blobdiff