Filename-related cleanup & fixes
--------------------------------
This commit rationalises some of our filename policies. The new story
is this:
When compiling a Haskell module A.B.C:
The object file is placed in <obj-path>/A/B/C.o
The interface file is placed in <hi-path>/A/B/C.hi
Where <objpath> is
- the argument of the -odir flag, if one was given
- the element of the search path in which the source file was found,
when in --make mode.
- "." otherwise.
Where <hipath> is
- the argument of the -hidir flag, if one was given
- the element of the search path in which the source file was found,
when in --make mode.
- "." otherwise.
NOTE, in particular, that the name of the source file has no bearing
on the name of the object or interface file any more. This is a
nchange from the previous semantics, where the name of the object file
would, under certain circumstances, follow the name of the source file.
eg. before, if you said
ghc -c dir/foo.hs
you would get dir/foo.o. Now, you get something like Main.o,
depending on what module is in foo.hs. This means that the driver
pipeline machinery now needs to pass around a Maybe ModLocation, which
is filled in by the Hsc phase and used later on to figure out the name
of the object file (this was fairly painful, but seems to be the only
way to get the right behaviour).
-- better make extra sure 'a' and 'b' are in canonical form
-- before using this equality test.
-- better make extra sure 'a' and 'b' are in canonical form
-- before using this equality test.
- isSameFilePath a b = a == b
+ isSameFilePath a b = fmap normalise a == fmap normalise b
+
+ -- a hack, because sometimes we strip off the leading "./" from a
+ -- a filename.
+ normalise ('.':'/':f) = f
+ normalise f = f
-----------------------------------------------------------------------------
-- getValidLinkables
-----------------------------------------------------------------------------
-- getValidLinkables
= do hspp_fn <- preprocess file
(srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
= do hspp_fn <- preprocess file
(srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
- let (path, basename, ext) = splitFilename3 file
+ let (basename, ext) = splitFilename file
-- GHC.Prim doesn't exist physically, so don't go looking for it.
the_imps = filter (/= gHC_PRIM_Name) imps
-- GHC.Prim doesn't exist physically, so don't go looking for it.
the_imps = filter (/= gHC_PRIM_Name) imps
- (mod, location) <- mkHomeModLocation mod_name True{-is a root-}
- path basename ext
+ (mod, location) <- mkHomeModLocation mod_name "." basename ext
src_timestamp
<- case ml_hs_file location of
src_timestamp
<- case ml_hs_file location of
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.28 2003/06/04 15:47:58 simonmar Exp $
+-- $Id: DriverMkDepend.hs,v 1.29 2003/07/17 12:04:53 simonmar Exp $
import qualified SysTools
import Module ( ModuleName, ModLocation(..),
moduleNameUserString, isHomeModule )
import qualified SysTools
import Module ( ModuleName, ModLocation(..),
moduleNameUserString, isHomeModule )
-import Finder ( findModule, hiBootExt, hiBootVerExt )
+import Finder ( findModule, hiBootExt, hiBootVerExt,
+ mkHomeModLocation )
import Util ( global )
import Panic
import Util ( global )
import Panic
doMkDependHSPhase basename suff input_fn
= do src <- readFile input_fn
doMkDependHSPhase basename suff input_fn
= do src <- readFile input_fn
- let (import_sources, import_normals, _) = getImports src
+ let (import_sources, import_normals, mod_name) = getImports src
+ (_, location') <- mkHomeModLocation mod_name "." basename suff
+
+ -- take -ohi into account if present
+ ohi <- readIORef v_Output_hi
+ let location | Just fn <- ohi = location'{ ml_hi_file = fn }
+ | otherwise = location'
+
let orig_fn = basename ++ '.':suff
deps_sources <- mapM (findDependency True orig_fn) import_sources
deps_normals <- mapM (findDependency False orig_fn) import_normals
let orig_fn = basename ++ '.':suff
deps_sources <- mapM (findDependency True orig_fn) import_sources
deps_normals <- mapM (findDependency False orig_fn) import_normals
sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
sequence_ (map genDep [ d | Just d <- deps ])
sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
sequence_ (map genDep [ d | Just d <- deps ])
-- add the lines to dep_makefile:
-- always:
-- add the lines to dep_makefile:
-- always:
False{-temporary output file-}
Nothing{-no specific output file-}
filename
False{-temporary output file-}
Nothing{-no specific output file-}
filename
+ Nothing{-no ModLocation-}
-- ---------------------------------------------------------------------------
-- Compile
-- ---------------------------------------------------------------------------
-- Compile
next_phase <- hscNextPhase hsc_lang
-- figure out what file to generate the output into
get_output_fn <- genOutputFilenameFunc False Nothing next_phase basename
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,
let dyn_flags' = dyn_flags { hscLang = hsc_lang,
hscOutName = output_fn,
createDirectoryHierarchy object_dir
runPipeline (StopBefore Ln) ""
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)
o_time <- getModificationTime object_filename
return ([DotO object_filename], o_time)
True{-persistent output-}
Nothing{-no specific output file-}
stub_c
True{-persistent output-}
Nothing{-no specific output file-}
stub_c
+ Nothing{-no ModLocation-}
-> Bool -- final output is persistent?
-> Maybe FilePath -- where to put the output, optionally
-> FilePath -- input filename
-> 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
-> 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
= do
split <- readIORef v_Split_object_files
let (basename, suffix) = splitFilename input_fn
stop_phase basename
-- and execute the pipeline...
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
-- 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
when (final_fn /= output_fn) $
copy ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
++ "'") output_fn final_fn
pipeLoop :: Phase -> Phase -> FilePath -> String -> Suffix
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
| 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
| otherwise = do
maybe_next_phase <- runPhase phase orig_basename orig_suff input_fn
+ get_output_fn maybe_loc
- (Nothing, output_fn) ->
+ (Nothing, maybe_loc, output_fn) -> do
-- we stopped early, but return the *final* filename
-- (it presumably already exists)
-- 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
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
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
genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename
= do
hcsuf <- readIORef v_HC_suf
myPhaseInputExt Ln = osuf
myPhaseInputExt other = phaseInputExt other
myPhaseInputExt Ln = osuf
myPhaseInputExt other = phaseInputExt other
+ func next_phase maybe_location
| next_phase == stop_phase
= case maybe_output_filename of
Just file -> return file
| next_phase == stop_phase
= case maybe_output_filename of
Just file -> return file
persistent = basename ++ '.':suffix
odir_persistent
persistent = basename ++ '.':suffix
odir_persistent
+ | Just loc <- maybe_location = ml_obj_file loc
| Just d <- odir = replaceFilenameDirectory persistent d
| otherwise = persistent
| 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.
-> 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
-------------------------------------------------------------------------------
-- 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
= 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.runUnlit (map SysTools.Option unlit_flags ++
[ SysTools.Option "-h"
, SysTools.FileOption "" output_fn
])
, SysTools.FileOption "" output_fn
])
- return (Just Cpp, output_fn)
+ return (Just Cpp, maybe_loc, output_fn)
-------------------------------------------------------------------------------
-- Cpp phase
-------------------------------------------------------------------------------
-- 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
= 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.
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
else do
hscpp_opts <- getOpts opt_P
hs_src_cpp_opts <- readIORef v_Hs_source_cpp_opts
verb <- getVerbFlag
(md_c_flags, _) <- machdepCCOpts
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.runCpp ([SysTools.Option verb]
++ map SysTools.Option include_paths
, SysTools.FileOption "" output_fn
])
, SysTools.FileOption "" output_fn
])
- return (Just HsPp, output_fn)
+ return (Just HsPp, maybe_loc, output_fn)
-------------------------------------------------------------------------------
-- HsPp phase
-------------------------------------------------------------------------------
-- 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.
= 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
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
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
)
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).
-----------------------------------------------------------------------------
-- 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
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
else do
-- normal Hsc mode, not mkdependHS
getImportsFromFile input_fn
-- build a ModLocation to pass to hscMain.
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
-- 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
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,
let dyn_flags' = dyn_flags { hscLang = hsc_lang,
hscOutName = output_fn,
HscNoRecomp pcs details iface -> do
SysTools.touch "Touching object file" o_file
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
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
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
-----------------------------------------------------------------------------
-- 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.
-- 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
| cc_phase == Cc || cc_phase == HCc
= do cc_opts <- getOpts opt_c
cmdline_include_paths <- readIORef v_Include_paths
| hcc && mangle = Mangle
| otherwise = As
| 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 []
-- HC files have the dependent packages stamped into them
pkgs <- if hcc then getHCFilePackages input_fn else return []
- return (Just next_phase, output_fn)
+ return (Just next_phase, maybe_loc, output_fn)
-- ToDo: postprocess the output from gcc
-----------------------------------------------------------------------------
-- Mangle phase
-- 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
= 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
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
SysTools.runMangle (map SysTools.Option mangler_opts
++ [ SysTools.FileOption "" input_fn
]
++ map SysTools.Option machdep_opts)
]
++ map SysTools.Option machdep_opts)
- return (Just next_phase, output_fn)
+ return (Just next_phase, maybe_loc, output_fn)
-----------------------------------------------------------------------------
-- Splitting phase
-----------------------------------------------------------------------------
-- 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"
= 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]]
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
-----------------------------------------------------------------------------
-- 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
= 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.runAs (map SysTools.Option as_opts
++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
, SysTools.FileOption "" output_fn
])
, 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
= do as_opts <- getOpts opt_a
(split_s_prefix, n) <- readIORef v_Split_info
mapM_ assemble_file [1..n]
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
#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",
= 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
-- 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",
= do ilasm_opts <- getOpts opt_i
SysTools.runIlasm (map SysTools.Option ilasm_opts
++ [ SysTools.Option "/QUIET",
- [ ("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) ]
]
hi_exts = [ (hisuf, mkHiOnlyModLocation hisuf mod_name) ]
[ (hiBootVerExt, mkHiOnlyModLocation hisuf mod_name)
, (hiBootExt, 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.
-- 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
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)
to_search :: [(FilePath, IO (Module,ModLocation))]
to_search = [ (file, fn p basename ext)
-- -----------------------------------------------------------------------------
-- Building ModLocations
-- -----------------------------------------------------------------------------
-- 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
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
loc <- hiOnlyModLocation path basename hisuf
let result = (mkPackageModule mod_name, loc)
addToFinderCache mod_name result
-- -----------------------------------------------------------------------------
-- Constructing a home module location
-- -----------------------------------------------------------------------------
-- 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
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_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,
result = ( mkHomeModule mod_name,
ModLocation{ ml_hspp_file = Nothing,
addToFinderCache mod_name result
return result
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
-- 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
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,
-- -----------------------------------------------------------------------------
-- 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
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]))
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)
+
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.129 2003/07/16 13:33:55 simonmar Exp $
+-- $Id: Main.hs,v 1.130 2003/07/17 12:04:53 simonmar Exp $
--
-- GHC Driver program
--
--
-- GHC Driver program
--
| mode==DoLink || mode==DoMkDLL = Nothing
| otherwise = o_file
| mode==DoLink || mode==DoMkDLL = Nothing
| otherwise = o_file
- runPipeline mode stop_flag True maybe_o_file src
+ runPipeline mode stop_flag True maybe_o_file src Nothing{-no ModLocation-}
-- ----------------------------------------------------------------------------
-- ----------------------------------------------------------------------------
extendModuleEnv_C, moduleEnvElts
)
import Outputable
extendModuleEnv_C, moduleEnvElts
)
import Outputable
+import DriverUtil ( createDirectoryHierarchy, directoryOf )
import Util ( sortLt, dropList, seqList )
import Binary ( getBinFileWithDict )
import BinIface ( writeBinIface, v_IgnoreHiVersion )
import Util ( sortLt, dropList, seqList )
import Binary ( getBinFileWithDict )
import BinIface ( writeBinIface, v_IgnoreHiVersion )
; let (final_iface, maybe_diffs) = _scc_ "versioninfo" addVersionInfo maybe_old_iface iface_w_decls
-- Write the interface file, if necessary
; let (final_iface, maybe_diffs) = _scc_ "versioninfo" addVersionInfo maybe_old_iface iface_w_decls
-- Write the interface file, if necessary
- ; when (must_write_hi_file maybe_diffs)
- (writeBinIface hi_file_path final_iface)
--- (writeIface hi_file_path final_iface)
+ ; when (must_write_hi_file maybe_diffs) $ do
+ createDirectoryHierarchy (directoryOf hi_file_path)
+ writeBinIface hi_file_path final_iface
-- Debug printing
; write_diffs dflags final_iface maybe_diffs
-- Debug printing
; write_diffs dflags final_iface maybe_diffs