import ErrUtils
import CmdLineOpts
import Config
+import RdrName ( GlobalRdrEnv )
import Panic
import Util
import BasicTypes ( SuccessFlag(..) )
preprocess :: FilePath -> IO FilePath
preprocess filename =
- ASSERT(haskellish_src_file filename)
+ ASSERT(isHaskellSrcFilename filename)
do restoreDynFlags -- Restore to state of last save
runPipeline (StopBefore Hsc) ("preprocess")
False{-temporary output file-}
Nothing{-no specific output file-}
filename
+ Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Compile
-- NB. No old interface can also mean that the source has changed.
-compile :: GhciMode -- distinguish batch from interactive
+compile :: HscEnv
-> Module
-> ModLocation
-> Bool -- True <=> source unchanged
-> Bool -- True <=> have object
-> Maybe ModIface -- old interface, if available
- -> HomePackageTable -- For home-module stuff
- -> PersistentCompilerState -- persistent compiler state
-> IO CompResult
data CompResult
- = CompOK PersistentCompilerState -- Updated PCS
- ModDetails -- New details
+ = CompOK ModDetails -- New details
+ (Maybe GlobalRdrEnv) -- Lexical environment for the module
+ -- (Maybe because we may have loaded it from
+ -- its precompiled interface)
ModIface -- New iface
(Maybe Linkable) -- New code; Nothing => compilation was not reqd
-- (old code is still valid)
- | CompErrs PersistentCompilerState -- Updated PCS
+ | CompErrs
-compile ghci_mode this_mod location
+compile hsc_env this_mod location
source_unchanged have_object
- old_iface hpt pcs = do
+ old_iface = do
dyn_flags <- restoreDynFlags -- Restore to the state of the last save
next_phase <- hscNextPhase hsc_lang
-- figure out what file to generate the output into
get_output_fn <- genOutputFilenameFunc False Nothing next_phase basename
- output_fn <- get_output_fn next_phase
+ output_fn <- get_output_fn next_phase (Just location)
let dyn_flags' = dyn_flags { hscLang = hsc_lang,
hscOutName = output_fn,
-- -no-recomp should also work with --make
do_recomp <- readIORef v_Recomp
let source_unchanged' = source_unchanged && do_recomp
- hsc_env = HscEnv { hsc_mode = ghci_mode,
- hsc_dflags = dyn_flags',
- hsc_HPT = hpt }
+ hsc_env' = hsc_env { hsc_dflags = dyn_flags' }
-- run the compiler
- hsc_result <- hscMain hsc_env pcs this_mod location
+ hsc_result <- hscMain hsc_env' printErrorsAndWarnings this_mod location
source_unchanged' have_object old_iface
case hsc_result of
- HscFail pcs -> return (CompErrs pcs)
+ HscFail -> return CompErrs
- HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
+ HscNoRecomp details iface -> return (CompOK details Nothing iface Nothing)
- HscRecomp pcs details iface
+ HscRecomp details rdr_env iface
stub_h_exists stub_c_exists maybe_interpreted_code -> do
let
maybe_stub_o <- compileStub dyn_flags' stub_c_exists
-- we're in batch mode: finish the compilation pipeline.
_other -> do
let object_filename = ml_obj_file location
- object_dir = directoryOf object_filename
-
- -- create the object dir if it doesn't exist
- createDirectoryHierarchy object_dir
runPipeline (StopBefore Ln) ""
- True (Just object_filename) output_fn
+ True Nothing output_fn (Just location)
+ -- the object filename comes from the ModLocation
o_time <- getModificationTime object_filename
return ([DotO object_filename], o_time)
let linkable = LM unlinked_time mod_name
(hs_unlinked ++ stub_unlinked)
- return (CompOK pcs details iface (Just linkable))
+ return (CompOK details rdr_env iface (Just linkable))
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
True{-persistent output-}
Nothing{-no specific output file-}
stub_c
+ Nothing{-no ModLocation-}
return (Just stub_o)
-> Bool -- final output is persistent?
-> Maybe FilePath -- where to put the output, optionally
-> FilePath -- input filename
+ -> Maybe ModLocation -- a ModLocation for this module, if we have one
-> IO FilePath -- output filename
-runPipeline todo stop_flag keep_output maybe_output_filename input_fn
+runPipeline todo stop_flag keep_output maybe_output_filename input_fn maybe_loc
= do
split <- readIORef v_Split_object_files
let (basename, suffix) = splitFilename input_fn
stop_phase basename
-- and execute the pipeline...
- output_fn <- pipeLoop start_phase stop_phase input_fn basename suffix
- get_output_fn
+ (output_fn, maybe_loc) <-
+ pipeLoop start_phase stop_phase input_fn basename suffix
+ get_output_fn maybe_loc
-- sometimes, a compilation phase doesn't actually generate any output
-- (eg. the CPP phase when -fcpp is not turned on). If we end on this
-- stage, but we wanted to keep the output, then we have to explicitly
-- copy the file.
if keep_output
- then do final_fn <- get_output_fn stop_phase
+ then do final_fn <- get_output_fn stop_phase maybe_loc
when (final_fn /= output_fn) $
copy ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
++ "'") output_fn final_fn
pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix
- -> (Phase -> IO FilePath) -> IO FilePath
+ -> (Phase -> Maybe ModLocation -> IO FilePath)
+ -> Maybe ModLocation -> IO (FilePath, Maybe ModLocation)
+
+pipeLoop phase stop_phase input_fn orig_basename orig_suff
+ get_output_fn maybe_loc
-pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn
- | phase == stop_phase = return input_fn -- all done
+ | phase == stop_phase = return (input_fn, maybe_loc) -- all done
| not (phase `happensBefore` stop_phase) =
-- Something has gone wrong. We'll try to cover all the cases when
| otherwise = do
maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn
- get_output_fn
+ get_output_fn maybe_loc
case maybe_next_phase of
- (Nothing, output_fn) ->
+ (Nothing, maybe_loc, output_fn) -> do
-- we stopped early, but return the *final* filename
-- (it presumably already exists)
- get_output_fn stop_phase
- (Just next_phase, output_fn) ->
+ final_fn <- get_output_fn stop_phase maybe_loc
+ return (final_fn, maybe_loc)
+ (Just next_phase, maybe_loc, output_fn) ->
pipeLoop next_phase stop_phase output_fn
- orig_basename orig_suff get_output_fn
+ orig_basename orig_suff get_output_fn maybe_loc
genOutputFilenameFunc :: Bool -> Maybe FilePath -> Phase -> String
- -> IO (Phase{-next phase-} -> IO FilePath)
-genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename
+ -> IO (Phase{-next phase-} -> Maybe ModLocation -> IO FilePath)
+genOutputFilenameFunc keep_final_output maybe_output_filename
+ stop_phase basename
= do
hcsuf <- readIORef v_HC_suf
+ odir <- readIORef v_Output_dir
osuf <- readIORef v_Object_suf
keep_hc <- readIORef v_Keep_hc_files
#ifdef ILX
myPhaseInputExt Ln = osuf
myPhaseInputExt other = phaseInputExt other
- func next_phase
- | next_phase == stop_phase
- = case maybe_output_filename of
- Just file -> return file
- Nothing | keep_output -> return persistent
- | otherwise -> newTempName suffix
- -- sometimes, we keep output from intermediate stages
- | otherwise
- = case next_phase of
- Ln -> return persistent
- Mangle | keep_raw_s -> return persistent
- As | keep_s -> return persistent
- HCc | keep_hc -> return persistent
- _other -> newTempName suffix
+ func next_phase maybe_location
+ | is_last_phase, Just f <- maybe_output_filename = return f
+ | is_last_phase && keep_final_output = persistent_fn
+ | keep_this_output = persistent_fn
+ | otherwise = newTempName suffix
+
where
+ is_last_phase = next_phase == stop_phase
+
+ -- sometimes, we keep output from intermediate stages
+ keep_this_output =
+ case next_phase of
+ Ln -> True
+ Mangle | keep_raw_s -> True
+ As | keep_s -> True
+ HCc | keep_hc -> True
+ _other -> False
+
suffix = myPhaseInputExt next_phase
+
+ -- persistent object files get put in odir
+ persistent_fn
+ | Ln <- next_phase = return odir_persistent
+ | otherwise = return persistent
+
persistent = basename ++ '.':suffix
+ odir_persistent
+ | Just loc <- maybe_location = ml_obj_file loc
+ | Just d <- odir = replaceFilenameDirectory persistent d
+ | otherwise = persistent
+
return func
-> String -- basename of original input source
-> String -- its extension
-> FilePath -- name of file which contains the input to this phase.
- -> (Phase -> IO FilePath) -- how to calculate the output filename
- -> IO (Maybe Phase, -- next phase
- FilePath) -- output filename
+ -> (Phase -> Maybe ModLocation -> IO FilePath)
+ -- how to calculate the output filename
+ -> Maybe ModLocation -- the ModLocation, if we have one
+ -> IO (Maybe Phase, -- next phase
+ Maybe ModLocation, -- the ModLocation, if we have one
+ FilePath) -- output filename
-------------------------------------------------------------------------------
-- Unlit phase
-runPhase Unlit _basename _suff input_fn get_output_fn
+runPhase Unlit _basename _suff input_fn get_output_fn maybe_loc
= do unlit_flags <- getOpts opt_L
-- The -h option passes the file name for unlit to put in a #line directive
- output_fn <- get_output_fn Cpp
+ output_fn <- get_output_fn Cpp maybe_loc
SysTools.runUnlit (map SysTools.Option unlit_flags ++
[ SysTools.Option "-h"
, SysTools.FileOption "" output_fn
])
- return (Just Cpp, output_fn)
+ return (Just Cpp, maybe_loc, output_fn)
-------------------------------------------------------------------------------
-- Cpp phase
-runPhase Cpp basename suff input_fn get_output_fn
+runPhase Cpp basename suff input_fn get_output_fn maybe_loc
= do src_opts <- getOptionsFromSource input_fn
unhandled_flags <- processArgs dynamic_flags src_opts []
checkProcessArgsResult unhandled_flags basename suff
if not do_cpp then
-- no need to preprocess CPP, just pass input file along
-- to the next phase of the pipeline.
- return (Just HsPp, input_fn)
+ return (Just HsPp, maybe_loc, input_fn)
else do
hscpp_opts <- getOpts opt_P
hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
verb <- getVerbFlag
(md_c_flags, _) <- machdepCCOpts
- output_fn <- get_output_fn HsPp
+ output_fn <- get_output_fn HsPp maybe_loc
SysTools.runCpp ([SysTools.Option verb]
++ map SysTools.Option include_paths
, SysTools.FileOption "" output_fn
])
- return (Just HsPp, output_fn)
+ return (Just HsPp, maybe_loc, output_fn)
-------------------------------------------------------------------------------
-- HsPp phase
-runPhase HsPp basename suff input_fn get_output_fn
+runPhase HsPp basename suff input_fn get_output_fn maybe_loc
= do do_pp <- dynFlag ppFlag
if not do_pp then
-- no need to preprocess, just pass input file along
-- to the next phase of the pipeline.
- return (Just Hsc, input_fn)
+ return (Just Hsc, maybe_loc, input_fn)
else do
hspp_opts <- getOpts opt_F
hs_src_pp_opts <- readIORef v_Hs_source_pp_opts
let orig_fn = basename ++ '.':suff
- output_fn <- get_output_fn Hsc
+ output_fn <- get_output_fn Hsc maybe_loc
SysTools.runPp ( [ SysTools.Option orig_fn
, SysTools.Option input_fn
, SysTools.FileOption "" output_fn
map SysTools.Option hs_src_pp_opts ++
map SysTools.Option hspp_opts
)
- return (Just Hsc, output_fn)
+ return (Just Hsc, maybe_loc, output_fn)
-----------------------------------------------------------------------------
-- Hsc phase
-- Compilation of a single module, in "legacy" mode (_not_ under
-- the direction of the compilation manager).
-runPhase Hsc basename suff input_fn get_output_fn = do
+runPhase Hsc basename suff input_fn get_output_fn _maybe_loc = do
todo <- readIORef v_GhcMode
if todo == DoMkDependHS then do
- doMkDependHSPhase basename suff input_fn
- return (Nothing, input_fn) -- Ln is a dummy stop phase
+ locn <- doMkDependHSPhase basename suff input_fn
+ return (Nothing, Just locn, input_fn) -- Ln is a dummy stop phase
else do
-- normal Hsc mode, not mkdependHS
-- gather the imports and module name
(_,_,mod_name) <-
- if extcoreish_suffix suff
+ if isExtCoreFilename ('.':suff)
then do
-- no explicit imports in ExtCore input.
m <- getCoreModuleName input_fn
getImportsFromFile input_fn
-- build a ModLocation to pass to hscMain.
- let (path,file) = splitFilenameDir basename
- (mod, location') <- mkHomeModLocation mod_name True path file suff
+ (mod, location') <- mkHomeModLocation mod_name (basename ++ '.':suff)
-- take -ohi into account if present
ohi <- readIORef v_Output_hi
dyn_flags <- getDynFlags
hsc_lang <- hscMaybeAdjustLang (hscLang dyn_flags)
next_phase <- hscNextPhase hsc_lang
- output_fn <- get_output_fn next_phase
+ output_fn <- get_output_fn next_phase (Just location)
let dyn_flags' = dyn_flags { hscLang = hsc_lang,
hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
hscStubHOutName = basename ++ "_stub.h",
extCoreName = basename ++ ".hcr" }
- hsc_env = HscEnv { hsc_mode = OneShot,
- hsc_dflags = dyn_flags',
- hsc_HPT = emptyHomePackageTable }
-
+ hsc_env <- newHscEnv OneShot dyn_flags'
-- run the compiler!
- pcs <- initPersistentCompilerState
- result <- hscMain hsc_env pcs mod
+ result <- hscMain hsc_env printErrorsAndWarnings mod
location{ ml_hspp_file=Just input_fn }
source_unchanged
False
case result of
- HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
+ HscFail -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
- HscNoRecomp pcs details iface -> do
+ HscNoRecomp details iface -> do
SysTools.touch "Touching object file" o_file
- return (Nothing, output_fn)
+ return (Nothing, Just location, output_fn)
- HscRecomp _pcs _details _iface stub_h_exists stub_c_exists
+ HscRecomp _details _rdr_env _iface
+ stub_h_exists stub_c_exists
_maybe_interpreted_code -> do
-- deal with stubs
Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o
case hscLang dyn_flags of
- HscNothing -> return (Nothing, output_fn)
- _ -> return (Just next_phase, output_fn)
+ HscNothing -> return (Nothing, Just location, output_fn)
+ _ -> return (Just next_phase, Just location, output_fn)
-----------------------------------------------------------------------------
-- Cc phase
-- we don't support preprocessing .c files (with -E) now. Doing so introduces
-- way too many hacks, and I can't say I've ever used it anyway.
-runPhase cc_phase basename suff input_fn get_output_fn
+runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
| cc_phase == Cc || cc_phase == HCc
= do cc_opts <- getOpts opt_c
cmdline_include_paths <- readIORef v_Include_paths
| hcc && mangle = Mangle
| otherwise = As
- output_fn <- get_output_fn next_phase
+ output_fn <- get_output_fn next_phase maybe_loc
-- HC files have the dependent packages stamped into them
pkgs <- if hcc then getHCFilePackages input_fn else return []
verb <- getVerbFlag
- o2 <- readIORef v_minus_o2_for_C
- let opt_flag | o2 = "-O2"
- | otherwise = "-O"
-
pkg_extra_cc_opts <- getPackageExtraCcOpts pkgs
split_objs <- readIORef v_Split_object_files
++ (if cc_phase == HCc && mangle
then md_regd_c_flags
else [])
- ++ [ verb, "-S", "-Wimplicit", opt_flag ]
+ ++ [ verb, "-S", "-Wimplicit", "-O" ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
++ split_opt
++ pkg_extra_cc_opts
))
- return (Just next_phase, output_fn)
+ return (Just next_phase, maybe_loc, output_fn)
-- ToDo: postprocess the output from gcc
-----------------------------------------------------------------------------
-- Mangle phase
-runPhase Mangle _basename _suff input_fn get_output_fn
+runPhase Mangle _basename _suff input_fn get_output_fn maybe_loc
= do mangler_opts <- getOpts opt_m
machdep_opts <- if (prefixMatch "i386" cTARGETPLATFORM)
then do n_regs <- dynFlag stolen_x86_regs
let next_phase
| split = SplitMangle
| otherwise = As
- output_fn <- get_output_fn next_phase
+ output_fn <- get_output_fn next_phase maybe_loc
SysTools.runMangle (map SysTools.Option mangler_opts
++ [ SysTools.FileOption "" input_fn
]
++ map SysTools.Option machdep_opts)
- return (Just next_phase, output_fn)
+ return (Just next_phase, maybe_loc, output_fn)
-----------------------------------------------------------------------------
-- Splitting phase
-runPhase SplitMangle _basename _suff input_fn get_output_fn
+runPhase SplitMangle _basename _suff input_fn get_output_fn maybe_loc
= do -- tmp_pfx is the prefix used for the split .s files
-- We also use it as the file to contain the no. of split .s files (sigh)
split_s_prefix <- SysTools.newTempName "split"
addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
| n <- [1..n_files]]
- return (Just SplitAs, "**splitmangle**") -- we don't use the filename
+ return (Just SplitAs, maybe_loc, "**splitmangle**")
+ -- we don't use the filename
-----------------------------------------------------------------------------
-- As phase
-runPhase As _basename _suff input_fn get_output_fn
+runPhase As _basename _suff input_fn get_output_fn maybe_loc
= do as_opts <- getOpts opt_a
cmdline_include_paths <- readIORef v_Include_paths
- output_fn <- get_output_fn Ln
+ output_fn <- get_output_fn Ln maybe_loc
+
+ -- we create directories for the object file, because it
+ -- might be a hierarchical module.
+ createDirectoryHierarchy (directoryOf output_fn)
SysTools.runAs (map SysTools.Option as_opts
++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
, SysTools.FileOption "" output_fn
])
- return (Just Ln, output_fn)
+ return (Just Ln, maybe_loc, output_fn)
-runPhase SplitAs basename _suff _input_fn get_output_fn
+runPhase SplitAs basename _suff _input_fn get_output_fn maybe_loc
= do as_opts <- getOpts opt_a
(split_s_prefix, n) <- readIORef v_Split_info
mapM_ assemble_file [1..n]
- output_fn <- get_output_fn Ln
- return (Just Ln, output_fn)
+ output_fn <- get_output_fn Ln maybe_loc
+ return (Just Ln, maybe_loc, output_fn)
#ifdef ILX
-----------------------------------------------------------------------------
-- Ilx2Il phase
-- Run ilx2il over the ILX output, getting an IL file
-runPhase Ilx2Il _basename _suff input_fn get_output_fn
+runPhase Ilx2Il _basename _suff input_fn get_output_fn maybe_loc
= do ilx2il_opts <- getOpts opt_I
SysTools.runIlx2il (map SysTools.Option ilx2il_opts
++ [ SysTools.Option "--no-add-suffix-to-assembly",
-- Ilasm phase
-- Run ilasm over the IL, getting a DLL
-runPhase Ilasm _basename _suff input_fn get_output_fn
+runPhase Ilasm _basename _suff input_fn get_output_fn maybe_loc
= do ilasm_opts <- getOpts opt_i
SysTools.runIlasm (map SysTools.Option ilasm_opts
++ [ SysTools.Option "/QUIET",
++ pkg_framework_path_opts
++ pkg_framework_opts
#endif
- ++ if static && not no_hs_main then
- [ "-u", prefixUnderscore "Main_zdmain_closure"]
- else []))
+ ))
-- parallel only: move binary to another dir -- HWL
ways_ <- readIORef v_Ways
-----------------------------------------------------------------------------
-- Making a DLL (only for Win32)
-doMkDLL :: [String] -> IO ()
-doMkDLL o_files = do
+doMkDLL :: [String] -> [PackageName] -> IO ()
+doMkDLL o_files dep_packages = do
verb <- getVerbFlag
static <- readIORef v_Static
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 []
+ pkg_lib_paths <- getPackageLibraryPath dep_packages
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_link_opts <- getPackageLinkOpts []
+ pkg_link_opts <- getPackageLinkOpts dep_packages
-- probably _stub.o files
extra_ld_inputs <- readIORef v_Ld_inputs
projects / ghc-hetmet.git / blobdiff