From: simonpj Date: Mon, 6 Jan 2003 15:16:39 +0000 (+0000) Subject: [project @ 2003-01-06 15:16:33 by simonpj] X-Git-Tag: Approx_11550_changesets_converted~1304 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=392095c950c3e242e88bf56bb401869a2f291abf;p=ghc-hetmet.git [project @ 2003-01-06 15:16:33 by simonpj] -------------------------------- Make ModLocation have a FilePath instead of (Maybe FilePath) for the object-file location -------------------------------- This generally tides things up, and makes ml_obj_file more like ml_hi_file. Furthermore the ml_obj_file field gets filled in even when we initially expect just an .hi file. This is important for Template Haskell. --- diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index c00b8ee..4b59757 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -142,9 +142,17 @@ instance Outputable PackageInfo where data ModLocation = ModLocation { ml_hs_file :: Maybe FilePath, - ml_hspp_file :: Maybe FilePath, -- path of preprocessed source - ml_hi_file :: FilePath, - ml_obj_file :: Maybe FilePath + + ml_hspp_file :: Maybe FilePath, -- Path of preprocessed source + + ml_hi_file :: FilePath, -- Where the .hi file is, whether or not it exists + -- Always of form foo.hi, even if there is an hi-boot + -- file (we add the -boot suffix later) + + ml_obj_file :: FilePath -- Where the .o file is, whether or not it exists + -- (might not exist either because the module + -- hasn't been compiled yet, or because + -- it is part of a package with a .a file) } deriving Show @@ -158,7 +166,7 @@ showModMsg use_object mod location = mod_str ++ replicate (max 0 (16 - length mod_str)) ' ' ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", " ++ (if use_object - then expectJust "showModMsg" (ml_obj_file location) + then ml_obj_file location else "interpreted") ++ " )" where mod_str = moduleUserString mod diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 8b705a1..cec8928 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -771,7 +771,7 @@ run_phase Hsc basename suff input_fn output_fn -- THIS COMPILATION, then use that to determine if the -- source is unchanged. | Just x <- expl_o_file, todo == StopBefore Ln = x - | otherwise = expectJust "source_unchanged" (ml_obj_file location) + | otherwise = ml_obj_file location source_unchanged <- if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln )) diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 96720c6..a16aab1 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -209,26 +209,27 @@ searchPathExts path mod_name exts = search path -- Building ModLocations mkHiOnlyModLocation hisuf mod_name path basename extension = do + loc <- hiOnlyModLocation path basename hisuf + let result = (mkHomeModule mod_name, loc) addToFinderCache mod_name result return result - where - result = ( mkHomeModule mod_name, hiOnlyModLocation path basename hisuf ) mkPackageModLocation hisuf mod_name path basename _extension = do + loc <- hiOnlyModLocation path basename hisuf + let result = (mkPackageModule mod_name, loc) addToFinderCache mod_name result return result - where - result = ( mkPackageModule mod_name, hiOnlyModLocation path basename hisuf ) - -hiOnlyModLocation path basename hisuf = - ModLocation{ ml_hspp_file = Nothing, - ml_hs_file = Nothing, - -- remove the .hi-boot suffix from hi_file, if it - -- had one. We always want the name of the real - -- .hi file in the ml_hi_file field. - ml_hi_file = path ++ '/':basename ++ '.':hisuf, - ml_obj_file = Nothing - } + +hiOnlyModLocation path basename hisuf + = do { obj_fn <- mkObjPath path basename ; + return (ModLocation{ ml_hspp_file = Nothing, + ml_hs_file = Nothing, + ml_hi_file = path ++ '/':basename ++ '.':hisuf, + -- Remove the .hi-boot suffix from hi_file, if it + -- had one. We always want the name of the real + -- .hi file in the ml_hi_file field. + ml_obj_file = obj_fn + })} -- ----------------------------------------------------------------------------- -- Constructing a home module location @@ -273,8 +274,8 @@ mkHomeModLocation mod_name is_root path basename extension = do hisuf <- readIORef v_Hi_suf hidir <- readIORef v_Hi_dir - odir <- readIORef v_Output_dir - osuf <- readIORef v_Object_suf + + obj_fn <- mkObjPath path basename let -- hi filename mod_str = moduleNameUserString mod_name @@ -293,30 +294,38 @@ mkHomeModLocation mod_name is_root path basename extension = do | path == "." = basename ++ '.':extension | otherwise = path ++ '/':basename ++ '.':extension - -- the object filename - obj_path | Just d <- odir = d - | otherwise = path - obj_fn = obj_path ++ '/':basename ++ '.':osuf - - result = ( mkHomeModule mod_name, ModLocation{ ml_hspp_file = Nothing, ml_hs_file = Just source_fn, ml_hi_file = hi_fn, - ml_obj_file = Just obj_fn, + ml_obj_file = obj_fn, }) 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. +-- +-- 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) + + + -- ----------------------------------------------------------------------------- -- findLinkable isn't related to the other stuff in here, -- but there' no other obvious place for it findLinkable :: ModuleName -> ModLocation -> IO (Maybe Linkable) findLinkable mod locn - | Just obj_fn <- ml_obj_file locn - = do obj_exist <- doesFileExist obj_fn + = do let obj_fn = ml_obj_file locn + obj_exist <- doesFileExist obj_fn if not obj_exist then return Nothing else @@ -327,6 +336,4 @@ 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])) - | otherwise - = return Nothing \end{code}