From 6677029a5084f59b4cd35d76ce3f19b154f2ac87 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 17 Jul 2003 12:04:54 +0000 Subject: [PATCH] [project @ 2003-07-17 12:04:50 by simonmar] 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 /A/B/C.o The interface file is placed in /A/B/C.hi Where 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 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). --- ghc/compiler/compMan/CompManager.lhs | 12 ++-- ghc/compiler/main/DriverMkDepend.hs | 16 +++-- ghc/compiler/main/DriverPipeline.hs | 123 +++++++++++++++++++--------------- ghc/compiler/main/Finder.lhs | 112 ++++++++++++++----------------- ghc/compiler/main/Main.hs | 4 +- ghc/compiler/main/MkIface.lhs | 7 +- 6 files changed, 146 insertions(+), 128 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index b0e13b9..9f79a16 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -720,7 +720,12 @@ ppFilesFromSummaries summaries -- 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 @@ -1230,12 +1235,11 @@ summariseFile file = 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 - (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 diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs index 769d9a2..3faa06c 100644 --- a/ghc/compiler/main/DriverMkDepend.hs +++ b/ghc/compiler/main/DriverMkDepend.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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 $ -- -- GHC Driver -- @@ -19,7 +19,8 @@ import SysTools ( newTempName ) 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 @@ -131,7 +132,14 @@ beginMkDependHS = do 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 @@ -164,7 +172,7 @@ doMkDependHSPhase basename suff input_fn sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps) sequence_ (map genDep [ d | Just d <- deps ]) - return True + return location -- add the lines to dep_makefile: -- always: diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index a5fe7c7..24c804e 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -75,6 +75,7 @@ preprocess filename = False{-temporary output file-} Nothing{-no specific output file-} filename + Nothing{-no ModLocation-} -- --------------------------------------------------------------------------- -- Compile @@ -142,7 +143,7 @@ compile ghci_mode this_mod location 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, @@ -196,7 +197,8 @@ compile ghci_mode this_mod location 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) @@ -218,6 +220,7 @@ compileStub dflags stub_c_exists True{-persistent output-} Nothing{-no specific output file-} stub_c + Nothing{-no ModLocation-} return (Just stub_o) @@ -298,9 +301,10 @@ runPipeline -> 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 @@ -332,15 +336,16 @@ runPipeline todo stop_flag keep_output maybe_output_filename 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 @@ -350,10 +355,13 @@ runPipeline todo stop_flag keep_output maybe_output_filename input_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 @@ -365,19 +373,20 @@ pipeLoop phase stop_phase input_fn orig_basename orig_suff get_output_fn | 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 @@ -395,7 +404,7 @@ genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename 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 @@ -416,6 +425,7 @@ genOutputFilenameFunc keep_output maybe_output_filename stop_phase basename persistent = basename ++ '.':suffix odir_persistent + | Just loc <- maybe_location = ml_obj_file loc | Just d <- odir = replaceFilenameDirectory persistent d | otherwise = persistent @@ -436,17 +446,20 @@ runPhase :: 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 -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" @@ -455,12 +468,12 @@ runPhase Unlit _basename _suff input_fn get_output_fn , 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 @@ -469,7 +482,7 @@ runPhase Cpp basename suff input_fn get_output_fn 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 @@ -483,7 +496,7 @@ runPhase Cpp basename suff input_fn get_output_fn 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 @@ -505,22 +518,22 @@ runPhase Cpp basename suff input_fn get_output_fn , 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 @@ -528,18 +541,18 @@ runPhase HsPp basename suff input_fn get_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 @@ -563,8 +576,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do 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 @@ -605,7 +617,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do 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, @@ -631,7 +643,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do 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 @@ -642,8 +654,8 @@ runPhase Hsc basename suff input_fn get_output_fn = 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 @@ -651,7 +663,7 @@ runPhase Hsc basename suff input_fn get_output_fn = do -- 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 @@ -665,7 +677,7 @@ runPhase cc_phase basename suff input_fn get_output_fn | 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 [] @@ -719,14 +731,14 @@ runPhase cc_phase basename suff input_fn get_output_fn ++ 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 @@ -737,7 +749,7 @@ runPhase Mangle _basename _suff input_fn get_output_fn 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 @@ -745,12 +757,12 @@ runPhase Mangle _basename _suff input_fn get_output_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" @@ -770,16 +782,17 @@ runPhase SplitMangle _basename _suff input_fn get_output_fn 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 ] @@ -789,10 +802,10 @@ runPhase As _basename _suff input_fn get_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 @@ -817,15 +830,15 @@ runPhase SplitAs basename _suff _input_fn get_output_fn 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", @@ -839,7 +852,7 @@ runPhase Ilx2Il _basename _suff input_fn get_output_fn -- 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", diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index dc7e190..8564ef0 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -121,8 +121,8 @@ maybeHomeModule mod_name = do 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) ] @@ -131,7 +131,7 @@ maybeHomeModule mod_name = do [ (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. @@ -195,8 +195,7 @@ searchPathExts 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) @@ -217,13 +216,15 @@ searchPathExts path mod_name exts = search to_search -- ----------------------------------------------------------------------------- -- 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 @@ -244,65 +245,52 @@ hiOnlyModLocation path basename hisuf -- ----------------------------------------------------------------------------- -- 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, @@ -314,23 +302,21 @@ mkHomeModLocation mod_name is_root path basename extension = do 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 @@ -346,4 +332,10 @@ 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} diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 29039de..f9f64cb 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,7 +1,7 @@ {-# 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 -- @@ -318,7 +318,7 @@ compileFile mode stop_flag src = do | 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-} -- ---------------------------------------------------------------------------- diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs index f06c7c3..49d428f 100644 --- a/ghc/compiler/main/MkIface.lhs +++ b/ghc/compiler/main/MkIface.lhs @@ -64,6 +64,7 @@ import Module ( Module, ModuleName, moduleNameFS, moduleName, isHomeModule, extendModuleEnv_C, moduleEnvElts ) import Outputable +import DriverUtil ( createDirectoryHierarchy, directoryOf ) import Util ( sortLt, dropList, seqList ) import Binary ( getBinFileWithDict ) import BinIface ( writeBinIface, v_IgnoreHiVersion ) @@ -168,9 +169,9 @@ mkIface hsc_env location maybe_old_iface ; 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 -- 1.7.10.4