False{-temporary output file-}
Nothing{-no specific output file-}
filename
+ Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Compile
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,
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)
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
- | phase == stop_phase = return input_fn -- all done
+pipeLoop phase stop_phase input_fn orig_basename orig_suff
+ get_output_fn maybe_loc
+
+ | 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)
+ -> IO (Phase{-next phase-} -> Maybe ModLocation -> IO FilePath)
genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename
= do
hcsuf <- readIORef v_HC_suf
myPhaseInputExt Ln = osuf
myPhaseInputExt other = phaseInputExt other
- func next_phase
+ func next_phase maybe_location
| next_phase == stop_phase
= case maybe_output_filename of
Just file -> return file
persistent = basename ++ '.':suffix
odir_persistent
+ | Just loc <- maybe_location = ml_obj_file loc
| Just d <- odir = replaceFilenameDirectory persistent d
| otherwise = persistent
-> 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
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,
HscNoRecomp pcs 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
_maybe_interpreted_code -> do
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 []
++ 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
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",
let
source_exts =
- [ ("hs", mkHomeModLocation mod_name False)
- , ("lhs", mkHomeModLocation mod_name False)
+ [ ("hs", mkHomeModLocation mod_name)
+ , ("lhs", mkHomeModLocation mod_name)
]
hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ]
[ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
, (hiBootExt, mkHiOnlyModLocation hisuf mod_name)
]
-
+
-- In compilation manager modes, we look for source files in the home
-- package because we can compile these automatically. In one-shot
-- compilation mode we look for .hi and .hi-boot files only.
searchPathExts path mod_name exts = search to_search
where
- mod_str = moduleNameUserString mod_name
- basename = map (\c -> if c == '.' then '/' else c) mod_str
+ basename = dots_to_slashes (moduleNameUserString mod_name)
to_search :: [(FilePath, IO (Module,ModLocation))]
to_search = [ (file, fn p basename ext)
-- -----------------------------------------------------------------------------
-- Building ModLocations
-mkHiOnlyModLocation hisuf mod_name path basename extension = do
+mkHiOnlyModLocation hisuf mod_name path basename _ext = do
+ -- basename == dots_to_slashes (moduleNameUserString mod_name)
loc <- hiOnlyModLocation path basename hisuf
let result = (mkHomeModule mod_name, loc)
addToFinderCache mod_name result
return result
-mkPackageModLocation hisuf mod_name path basename _extension = do
+mkPackageModLocation hisuf mod_name path basename _ext = do
+ -- basename == dots_to_slashes (moduleNameUserString mod_name)
loc <- hiOnlyModLocation path basename hisuf
let result = (mkPackageModule mod_name, loc)
addToFinderCache mod_name result
-- -----------------------------------------------------------------------------
-- Constructing a home module location
--- The .hi file always follows the module name, whereas the object
--- file may follow the name of the source file in the case where the
--- two differ (see summariseFile in compMan/CompManager.lhs).
-
--- The source filename is specified in three components. For example,
--- if we have a module "A.B.C" which was found along the patch "/P/Q/R"
--- with extension ".hs", then the full filename is "/P/Q/R/A/B/C.hs". The
--- components passed to mkHomeModLocation are
+-- This is where we construct the ModLocation for a module in the home
+-- package, for which we have a source file. It is called from three
+-- places:
--
--- path: "/P/Q/R"
--- basename: "A/B/C"
--- extension: "hs"
+-- (a) Here in the finder, when we are searching for a module to import,
+-- using the search path (-i option).
--
--- the object file and interface file are constructed by possibly
--- replacing the path component with the values of the -odir or the
--- -hidr options respectively, and the extension with the values of
--- the -osuf and -hisuf options respectively. That is, the basename
--- always remains intact.
+-- (b) The compilation manager, when constructing the ModLocation for
+-- a "root" module (a source file named explicitly on the command line
+-- or in a :load command in GHCi).
--
--- mkHomeModLocation is called directly by the compilation manager to
--- construct the information for a root module. For a "root" module,
--- the rules are slightly different. The filename is allowed to
--- diverge from the module name, but we have to name the interface
--- file after the module name. For example, a root module
--- "/P/Q/R/foo.hs" will have components
+-- (c) The driver in one-shot mode, when we need to construct a
+-- ModLocation for a source file named on the command-line.
--
--- path: "/P/Q/R"
--- basename: "foo"
--- extension: "hs"
---
--- and we set the flag is_root to True, to indicate that the basename
--- portion for the .hi file should be replaced by the last component
--- of the module name. eg. if the module name is "A.B.C" then basename
--- will be replaced by "C" for the .hi file only, resulting in an
--- .hi file like "/P/Q/R/C.hi" (subject to -hidir and -hisuf as usual).
-
-mkHomeModLocation mod_name is_root path basename extension = do
+-- Parameters are:
+--
+-- mod_name
+-- The name of the module
+--
+-- path
+-- (a): The search path component where the source file was found.
+-- (b) and (c): Nothing
+--
+-- src_basename
+-- (a): dots_to_slashes (moduleNameUserString mod_name)
+-- (b) and (c): The filename of the source file, minus its extension
+--
+-- ext
+-- The filename extension of the source file (usually "hs" or "lhs").
+mkHomeModLocation mod_name path src_basename ext = do
hisuf <- readIORef v_Hi_suf
hidir <- readIORef v_Hi_dir
- obj_fn <- mkObjPath path basename
-
- let -- hi filename
- mod_str = moduleNameUserString mod_name
- (_,mod_suf) = split_longest_prefix mod_str (=='.')
+ let mod_basename = dots_to_slashes (moduleNameUserString mod_name)
- hi_basename
- | is_root = mod_suf
- | otherwise = basename
+ obj_fn <- mkObjPath path mod_basename
+ let -- hi filename, always follows the module name
hi_path | Just d <- hidir = d
| otherwise = path
- hi_fn = hi_path ++ '/':hi_basename ++ '.':hisuf
- -- source filename (extension is always .hs or .lhs)
- source_fn
- | path == "." = basename ++ '.':extension
- | otherwise = path ++ '/':basename ++ '.':extension
+ hi_fn = hi_path ++ '/':mod_basename ++ '.':hisuf
+
+ -- source filename
+ source_fn = path ++ '/':src_basename ++ '.':ext
result = ( mkHomeModule mod_name,
ModLocation{ ml_hspp_file = Nothing,
addToFinderCache mod_name result
return result
-mkObjPath :: String -> FilePath -> IO FilePath
--- Construct the filename of a .o file from the path/basename
--- derived either from a .hs file or a .hi file.
---
+mkObjPath :: FilePath -> String -> IO FilePath
+-- Construct the filename of a .o file.
-- Does *not* check whether the .o file exists
mkObjPath path basename
= do odir <- readIORef v_Output_dir
osuf <- readIORef v_Object_suf
+
let obj_path | Just d <- odir = d
| otherwise = path
- return (obj_path ++ '/':basename ++ '.':osuf)
-
+ return (obj_path ++ '/':basename ++ '.':osuf)
-- -----------------------------------------------------------------------------
-- findLinkable isn't related to the other stuff in here,
--- but there' no other obvious place for it
+-- but there's no other obvious place for it
findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable)
findLinkable mod locn
if stub_exist
then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
else return (Just (LM obj_time mod [DotO obj_fn]))
+
+-- -----------------------------------------------------------------------------
+-- Utils
+
+dots_to_slashes = map (\c -> if c == '.' then '/' else c)
+
\end{code}
projects / ghc-hetmet.git / commitdiff