-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.14 2000/10/31 13:01:46 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.25 2000/11/14 17:41:04 sewardj Exp $
--
-- GHC Driver
--
genPipeline, runPipeline,
-- interfaces for the compilation manager (interpreted/batch-mode)
- preprocess, compile,
+ preprocess, compile, CompResult(..),
-- batch-mode linking interface
- doLink,
+ doLink
) where
#include "HsVersions.h"
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
----------- ----- ---- --- -- -- - - -
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
----------- ----- ---- --- -- -- - - -
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
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
-------------------------------------------------------------------------------
deps <- mapM (findDependency basename) imports
- 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
ohi <- readIORef v_Output_hi
hisuf <- readIORef v_Hi_suf
let hifile = case ohi of
- Nothing -> current_dir ++ "/" ++ basename
- ++ "." ++ hisuf
+ Nothing -> basename ++ '.':hisuf
Just fn -> fn
-- figure out if the source has changed, for recompilation avoidance.
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"
++ [ verb, "-S", "-Wimplicit", opt_flag ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
+ ++ split_opt
#ifdef mingw32_TARGET_OS
++ [" -mno-cygwin"]
#endif
doLink o_files = do
ln <- readIORef v_Pgm_l
verb <- is_verbose
+ 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
+ rts_pkg <- getPackageDetails ["rts"]
+ std_pkg <- getPackageDetails ["std"]
+#ifdef mingw32_TARGET_OS
+ let extra_os = if static || no_hs_main
+ then []
+-- else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
+-- head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
+ else []
+#endif
+ (md_c_flags, _) <- machdepCCOpts
run_something "Linker"
- (unwords
+ (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
)
)
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
- do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
+ do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False
+ defaultHscLang filename
runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
- let location = ms_location summary
- let input_fn = unJust (ml_hs_file location) "compile:hs"
+ 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"
- when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
+ when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
- opts <- getOptionsFromSource input_fn
+ 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)
-- run the compiler
hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
- (panic "compile:source_unchanged")
+ False -- (panic "compile:source_unchanged")
location old_iface hst hit pcs
case hsc_result of {
Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
- _other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
+ _other -> do pipe <- genPipeline (StopBefore Ln) "" True
+ hsc_lang output_fn
o_file <- runPipeline pipe output_fn False False
return [ DotO o_file ]
])
-- 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-}
projects / ghc-hetmet.git / blobdiff