-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.10 2000/10/27 13:50:25 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.48 2001/01/16 21:05:51 qrczak Exp $
--
-- GHC Driver
--
--
-----------------------------------------------------------------------------
+#include "../includes/config.h"
+
module DriverPipeline (
-- interfaces for the batch-mode driver
GhcMode(..), getGhcMode, v_GhcMode,
- genPipeline, runPipeline,
+ genPipeline, runPipeline, pipeLoop,
-- interfaces for the compilation manager (interpreted/batch-mode)
- preprocess, compile,
+ preprocess, compile, CompResult(..),
-- batch-mode linking interface
doLink,
+ -- DLL building
+ doMkDLL
) where
#include "HsVersions.h"
-import CmSummarise
-import CmLink
+import CmStaticInfo
+import CmTypes
+import GetImports
import DriverState
import DriverUtil
import DriverMkDepend
import HscTypes
import Outputable
import Module
+import ErrUtils
import CmdLineOpts
import Config
+import Panic
import Util
-import MkIface ( pprIface )
+import Time ( getClockTime )
import Directory
import System
import IOExts
import Monad
import Maybe
+import PackedString
+import MatchPS
+
-----------------------------------------------------------------------------
-- GHC modes of operation
data GhcMode
= DoMkDependHS -- ghc -M
- | DoMkDLL -- ghc -mk-dll
+ | DoMkDLL -- ghc --mk-dll
| StopBefore Phase -- ghc -E | -C | -S | -c
| DoMake -- ghc --make
| DoInteractive -- ghc --interactive
modeFlag :: String -> Maybe GhcMode
modeFlag "-M" = Just $ DoMkDependHS
+modeFlag "--mk-dll" = Just $ DoMkDLL
modeFlag "-E" = Just $ StopBefore Hsc
modeFlag "-C" = Just $ StopBefore HCc
modeFlag "-S" = Just $ StopBefore As
([(flag,one)], rest) -> return (rest, one, flag)
(_ , _ ) ->
throwDyn (OtherError
- "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
+ "only one of the flags -M, -E, -C, -S, -c, --make, --interactive, -mk-dll is allowed")
-----------------------------------------------------------------------------
-- genPipeline
-- 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
| Persistent
- deriving (Eq)
+ deriving (Eq, Show)
genPipeline
:: GhcMode -- when to stop
-> String -- "stop after" flag (for error messages)
+ -> Bool -- True => output is persistent
+ -> HscLang -- preferred output language for hsc
-> String -- original filename
-> IO [ -- list of phases to run for this file
(Phase,
String) -- output file suffix
]
-genPipeline todo stop_flag filename
+genPipeline todo stop_flag persistent_output lang filename
= do
split <- readIORef v_Split_object_files
mangle <- readIORef v_Do_asm_mangling
- lang <- readIORef v_Hsc_Lang
keep_hc <- readIORef v_Keep_hc_files
keep_raw_s <- readIORef v_Keep_raw_s_files
keep_s <- readIORef v_Keep_s_files
+ osuf <- readIORef v_Object_suf
let
----------- ----- ---- --- -- -- - - -
(_basename, suffix) = splitFilename filename
- start_phase = startPhase suffix
+ start = startPhase suffix
+
+ -- special case for mkdependHS: .hspp files go through MkDependHS
+ start_phase | todo == DoMkDependHS && start == Hsc = MkDependHS
+ | otherwise = start
haskellish = haskellish_suffix suffix
cish = cish_suffix suffix
- -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
- real_lang | suffix == "hc" = HscC
- | otherwise = lang
+ -- for a .hc file we need to force lang to HscC
+ real_lang | start_phase == HCc = HscC
+ | otherwise = lang
let
----------- ----- ---- --- -- -- - - -
++ filename))
else do
- -- if we can't find the phase we're supposed to stop before,
- -- something has gone wrong.
- case todo of
- StopBefore phase ->
- when (phase /= Ln
- && phase `notElem` pipeline
- && not (phase == As && SplitAs `elem` pipeline)) $
- throwDyn (OtherError
- ("flag " ++ stop_flag
- ++ " is incompatible with source file `" ++ filename ++ "'"))
- _ -> return ()
-
let
----------- ----- ---- --- -- -- - - -
+ myPhaseInputExt Ln = case osuf of Nothing -> phaseInputExt Ln
+ Just s -> s
+ myPhaseInputExt other = phaseInputExt other
+
annotatePipeline
:: [Phase] -- raw pipeline
-> Phase -- phase to stop before
annotatePipeline [] _ = []
annotatePipeline (Ln:_) _ = []
annotatePipeline (phase:next_phase:ps) stop =
- (phase, keep_this_output, phaseInputExt next_phase)
+ (phase, keep_this_output, myPhaseInputExt next_phase)
: annotatePipeline (next_phase:ps) stop
where
keep_this_output
- | next_phase == stop = Persistent
- | otherwise =
- case next_phase of
+ | next_phase == stop
+ = if persistent_output then Persistent else Temporary
+ | otherwise
+ = case next_phase of
Ln -> Persistent
Mangle | keep_raw_s -> Persistent
As | keep_s -> Persistent
-- the suffix on an output file is determined by the next phase
-- in the pipeline, so we add linking to the end of the pipeline
-- to force the output from the final phase to be a .o file.
- stop_phase = case todo of StopBefore phase -> phase
- DoMkDependHS -> Ln
- DoLink -> Ln
+ stop_phase = case todo of
+ StopBefore As | split -> SplitAs
+ StopBefore phase -> phase
+ DoMkDependHS -> Ln
+ DoLink -> Ln
annotated_pipeline = annotatePipeline (pipeline ++ [ Ln ]) stop_phase
phase_ne p (p1,_,_) = (p1 /= p)
----------- ----- ---- --- -- -- - - -
- return $
- dropWhile (phase_ne start_phase) .
- foldr (\p ps -> if phase_ne stop_phase p then p:ps else []) []
- $ annotated_pipeline
+ -- if we can't find the phase we're supposed to stop before,
+ -- something has gone wrong. This test carefully avoids the
+ -- case where we aren't supposed to do any compilation, because the file
+ -- is already in linkable form (for example).
+ if start_phase `elem` pipeline &&
+ (stop_phase /= Ln && stop_phase `notElem` pipeline)
+ then throwDyn (OtherError
+ ("flag " ++ stop_flag
+ ++ " is incompatible with source file `" ++ filename ++ "'"))
+ else do
+
+ return (
+ takeWhile (phase_ne stop_phase ) $
+ dropWhile (phase_ne start_phase) $
+ annotated_pipeline
+ )
runPipeline
return ofile
else do -- carry on ...
- -- sadly, ghc -E is supposed to write the file to stdout. We
- -- generate <file>.cpp, so we also have to cat the file here.
- when (null phases && phase == Cpp) $
- run_something "Dump pre-processed file to stdout"
- ("cat " ++ output_fn)
-
pipeLoop phases output_fn do_linking use_ofile orig_basename orig_suffix
where
Just s -> return s
Nothing -> error "outputFileName"
else if keep == Persistent
- then do f <- odir_ify (orig_basename ++ '.':suffix)
- osuf_ify f
+ then odir_ify (orig_basename ++ '.':suffix)
else newTempName suffix
-------------------------------------------------------------------------------
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
-------------------------------------------------------------------------------
-- Cpp phase
-run_phase Cpp _basename _suff input_fn output_fn
+run_phase Cpp basename suff input_fn output_fn
= do src_opts <- getOptionsFromSource input_fn
- _ <- processArgs dynamic_flags src_opts []
+ unhandled_flags <- processArgs dynamic_flags src_opts []
+
+ when (not (null unhandled_flags))
+ (throwDyn (OtherError (
+ basename ++ "." ++ suff
+ ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t"
+ ++ unwords unhandled_flags)) (ExitFailure 1))
do_cpp <- readState cpp_flag
if do_cpp
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, "&&",
+ (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}'", ">", output_fn, "&&",
cpp, verb]
++ include_paths
++ hs_src_cpp_opts
++ [ "-x", "c", input_fn, ">>", output_fn ]
))
else do
- run_something "Ineffective C pre-processor"
- ("echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}' > "
+ runSomething "Ineffective C pre-processor"
+ ("echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}' > "
++ output_fn ++ " && cat " ++ input_fn
++ " >> " ++ output_fn)
return True
run_phase MkDependHS basename suff input_fn _output_fn = do
src <- readFile input_fn
- let imports = getImports src
+ let (import_sources, import_normals, module_name) = getImports src
- deps <- mapM (findDependency basename) imports
+ deps_sources <- mapM (findDependency True basename) import_sources
+ deps_normals <- mapM (findDependency False basename) import_normals
+ let deps = deps_sources ++ deps_normals
- osuf_opt <- readIORef v_Output_suf
+ osuf_opt <- readIORef v_Object_suf
let osuf = case osuf_opt of
- Nothing -> "o"
+ Nothing -> phaseInputExt Ln
Just s -> s
extra_suffixes <- readIORef v_Dep_suffixes
hdl <- readIORef v_Dep_tmp_hdl
- -- std dependeny of the object(s) on the source file
+ -- std dependency of the object(s) on the source file
hPutStrLn hdl (unwords objs ++ " : " ++ basename ++ '.':suff)
let genDep (dep, False {- not an hi file -}) =
ohi <- readIORef v_Output_hi
hisuf <- readIORef v_Hi_suf
let hifile = case ohi of
- Nothing -> current_dir ++ {-ToDo: modname!!-}basename
- ++ hisuf
+ Nothing -> basename ++ '.':hisuf
Just fn -> fn
-- figure out if the source has changed, for recompilation avoidance.
-- only do this if we're eventually going to generate a .o file.
-- (ToDo: do when generating .hc files too?)
--
- -- Setting source_unchanged to "-fsource_unchanged" means that M.o seems
+ -- Setting source_unchanged to True means that M.o seems
-- to be up to date wrt M.hs; so no need to recompile unless imports have
-- changed (which the compiler itself figures out).
- -- Setting source_unchanged to "" tells the compiler that M.o is out of
+ -- Setting source_unchanged to False tells the compiler that M.o is out of
-- 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 ""
+ then return False
else do t1 <- getModificationTime (basename ++ '.':suff)
o_file_exists <- doesFileExist o_file
if not o_file_exists
- then return "" -- Need to recompile
+ then return False -- Need to recompile
else do t2 <- getModificationTime o_file
if t2 > t1
- then return "-fsource-unchanged"
- else return ""
-
- -- build a bogus ModSummary to pass to hscMain.
- let summary = ModSummary {
- ms_mod = (mkModuleInThisPackage . mkModuleName)
- {-ToDo: modname!!-}basename,
- ms_location = error "no loc",
- ms_ppsource = Just (input_fn, error "no fingerprint"),
- ms_imports = error "no imports"
- }
+ then return True
+ else return False
+
+ -- build a ModuleLocation to pass to hscMain.
+ let location = ModuleLocation {
+ ml_hs_file = Nothing,
+ ml_hspp_file = Just input_fn,
+ ml_hi_file = Just hifile,
+ ml_obj_file = Just o_file
+ }
-- get the DynFlags
dyn_flags <- readIORef v_DynFlags
-- run the compiler!
pcs <- initPersistentCompilerState
- result <- hscMain dyn_flags{ hscOutName = output_fn }
- summary
+ result <- hscMain OneShot
+ dyn_flags{ hscOutName = output_fn }
+ source_unchanged
+ location
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
emptyModuleEnv -- HomeIfaceTable
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;
+ };
- -- deal with stubs
+ 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
case maybe_stub_o of
Nothing -> return ()
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"
pkg_extra_cc_opts <- getPackageExtraCcOpts
+ split_objs <- readIORef v_Split_object_files
+ let split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
+ | otherwise = [ ]
+
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
++ [ verb, "-S", "-Wimplicit", opt_flag ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
-#ifdef mingw32_TARGET_OS
- ++ [" -mno-cygwin"]
-#endif
+ ++ split_opt
++ (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
-- As phase
run_phase As _basename _suff input_fn output_fn
- = do as <- readIORef v_Pgm_a
+ = do as <- readIORef v_Pgm_a
as_opts <- getOpts opt_a
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
+
o_file <- readIORef v_Output_file
let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
let lib_path_opts = map ("-L"++) lib_paths
pkg_libs <- getPackageLibraries
- let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
+ let pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
libs <- readIORef v_Cmdline_libraries
let lib_opts = map ("-l"++) (reverse libs)
-- opts from -optl-<blah>
extra_ld_opts <- getStaticOpts v_Opt_l
- run_something "Linker"
- (unwords
+ rts_pkg <- getPackageDetails ["rts"]
+ std_pkg <- getPackageDetails ["std"]
+#ifdef mingw32_TARGET_OS
+ let extra_os = if static || no_hs_main
+ then []
+ else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
+ head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+#endif
+ (md_c_flags, _) <- machdepCCOpts
+ runSomething "Linker"
+ (unwords
([ ln, verb, "-o", output_fn ]
+ ++ md_c_flags
++ o_files
+#ifdef mingw32_TARGET_OS
+ ++ extra_os
+#endif
++ extra_ld_inputs
++ lib_path_opts
++ lib_opts
++ pkg_lib_opts
++ pkg_extra_ld_opts
++ extra_ld_opts
+#ifdef mingw32_TARGET_OS
+ ++ if static then [ "-u _PrelMain_mainIO_closure" , "-u ___init_PrelMain"] else []
+#else
+ ++ [ "-u PrelMain_mainIO_closure" , "-u __init_PrelMain"]
+#endif
+ )
+ )
+
+-----------------------------------------------------------------------------
+-- Making a DLL
+
+-- only for Win32, but bits that are #ifdefed in doLn are still #ifdefed here
+-- in a vain attempt to aid future portability
+doMkDLL :: [String] -> IO ()
+doMkDLL o_files = do
+ ln <- readIORef v_Pgm_dll
+ verb <- getVerbFlag
+ static <- readIORef v_Static
+ let imp = if static then "" else "_imp"
+ no_hs_main <- readIORef v_NoHsMain
+
+ o_file <- readIORef v_Output_file
+ let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
+
+ pkg_lib_paths <- getPackageLibraryPath
+ let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
+
+ lib_paths <- readIORef v_Library_paths
+ let lib_path_opts = map ("-L"++) lib_paths
+
+ pkg_libs <- getPackageLibraries
+ let pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
+
+ libs <- readIORef v_Cmdline_libraries
+ let lib_opts = map ("-l"++) (reverse libs)
+ -- reverse because they're added in reverse order from the cmd line
+
+ pkg_extra_ld_opts <- getPackageExtraLdOpts
+
+ -- probably _stub.o files
+ extra_ld_inputs <- readIORef v_Ld_inputs
+
+ -- opts from -optdll-<blah>
+ extra_ld_opts <- getStaticOpts v_Opt_dll
+
+ rts_pkg <- getPackageDetails ["rts"]
+ std_pkg <- getPackageDetails ["std"]
+#ifdef mingw32_TARGET_OS
+ let extra_os = if static || no_hs_main
+ then []
+ else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
+ head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+#endif
+ (md_c_flags, _) <- machdepCCOpts
+ runSomething "DLL creator"
+ (unwords
+ ([ ln, verb, "-o", output_fn ]
+ ++ md_c_flags
+ ++ o_files
+#ifdef mingw32_TARGET_OS
+ ++ extra_os
+ ++ [ "--target=i386-mingw32" ]
+#endif
+ ++ extra_ld_inputs
+ ++ lib_path_opts
+ ++ lib_opts
+ ++ pkg_lib_path_opts
+ ++ pkg_lib_opts
+ ++ pkg_extra_ld_opts
+ ++ (case findPS (packString (concat extra_ld_opts)) (packString "--def") of
+ Nothing -> [ "--export-all" ]
+ Just _ -> [ "" ])
+ ++ extra_ld_opts
)
)
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
- do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
+ 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-}
-- the .hs file if necessary, and compiling up the .stub_c files to
-- generate Linkables.
-compile :: ModSummary -- summary, including source
+-- NB. No old interface can also mean that the source has changed.
+
+compile :: GhciMode -- distinguish batch from interactive
+ -> ModSummary -- summary, including source
+ -> Bool -- source unchanged?
-> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> HomeIfaceTable -- for home module Ifaces
-> 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 summary old_iface hst hit pcs = do
- verb <- readIORef v_Verbose
- when verb (hPutStrLn stderr
- (showSDoc (text "compile: compiling"
- <+> ppr (name_of_summary summary))))
-
+compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
-
- let input_fn = case ms_ppsource summary of
- Just (ppsource, fingerprint) -> ppsource
- Nothing -> hs_file (ms_location summary)
+ 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)))
- when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
+ 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)
- opts <- getOptionsFromSource input_fn
+ when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
+
+ opts <- getOptionsFromSource input_fnpp
processArgs dynamic_flags opts []
dyn_flags <- readIORef v_DynFlags
- hsc_lang <- readIORef v_Hsc_Lang
+ let hsc_lang = hscLang dyn_flags
output_fn <- case hsc_lang of
HscAsm -> newTempName (phaseInputExt As)
HscC -> newTempName (phaseInputExt HCc)
HscInterpreted -> return (error "no output file")
-- run the compiler
- hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
- summary old_iface hst hit pcs
+ hsc_result <- hscMain ghci_mode dyn_flags{ hscOutName = output_fn }
+ 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)
- let (basename, _) = splitFilename (hs_file (ms_location summary))
+ 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 (bcos,itbl_env) -> do tm <- getClockTime
+ return ([BCOs bcos itbl_env], tm)
+ Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
- _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
- o_file <- runPipeline pipe output_fn False False
- return [ DotO o_file ]
+ _other -> do pipe <- genPipeline (StopBefore Ln) "" True
+ hsc_lang output_fn
+ -- runPipeline takes input_fn so it can split off
+ -- 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
+ 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
])
-- compile the _stub.c file w/ gcc
- pipeline <- genPipeline (StopBefore Ln) "" stub_c
+ pipeline <- genPipeline (StopBefore Ln) "" True
+ defaultHscLang stub_c
stub_o <- runPipeline pipeline stub_c False{-no linking-}
False{-no -o option-}