Redo the source-up-to-date logic (in CompManager.upsweep_mod).
findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
findModuleLinkable_maybe lis mod
- = case [LM nm us | LM nm us <- lis, nm == mod] of
+ = case [LM time nm us | LM time nm us <- lis, nm == mod] of
[] -> Nothing
[li] -> Just li
many -> pprPanic "findModuleLinkable" (ppr mod)
return (LinkOK pls1)
where
getOfiles (LP _) = panic "CmLink.link(getOfiles): shouldn't get package linkables"
- getOfiles (LM _ us) = map nameOfObject (filter isObject us)
+ getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
link' Interactive batch_attempt_linking linkables pls1
= linkObjs linkables pls1
ppLinkableSCC = ppr . flattenSCC
-modname_of_linkable (LM nm _) = nm
-modname_of_linkable (LP _) = panic "modname_of_linkable: package"
+modname_of_linkable (LM _ nm _) = nm
+modname_of_linkable (LP _) = panic "modname_of_linkable: package"
-is_package_linkable (LP _) = True
-is_package_linkable (LM _ _) = False
+is_package_linkable (LP _) = True
+is_package_linkable (LM _ _ _) = False
filterModuleLinkables :: (ModuleName -> Bool)
-> [Linkable]
filterModuleLinkables p [] = []
filterModuleLinkables p (li:lis)
= case li of
- LP _ -> retain
- LM modnm _ -> if p modnm then retain else dump
+ LP _ -> retain
+ LM _ modnm _ -> if p modnm then retain else dump
where
dump = filterModuleLinkables p lis
retain = li : dump
lookupClosure = panic "CmLink.lookupClosure: no interpreter"
#else
linkObjs [] pls = linkFinish pls [] []
-linkObjs (l@(LM _ uls) : ls) pls
+linkObjs (l@(LM _ _ uls) : ls) pls
| all isObject uls = do
mapM_ loadObj [ file | DotO file <- uls ]
linkObjs ls pls
linkInterpretedCode [] mods ul_trees pls = linkFinish pls mods ul_trees
-linkInterpretedCode (LM m uls : ls) mods ul_trees pls
+linkInterpretedCode (LM _ m uls : ls) mods ul_trees pls
| all isInterpretable uls =
linkInterpretedCode ls (m:mods) (uls++ul_trees) pls
\begin{code}
module CmTypes (
Unlinked(..), isObject, nameOfObject, isInterpretable,
- Linkable(..),
- ModSummary(..), name_of_summary, pprSummaryTimes
+ Linkable(..), linkableTime,
+ ModSummary(..), name_of_summary, pprSummaryTime
) where
import Interpreter
isInterpretable _ = False
data Linkable
- = LM ModuleName [Unlinked]
+ = LM ClockTime ModuleName [Unlinked]
| LP PackageName
instance Outputable Linkable where
- ppr (LM mod_nm unlinkeds) = text "LinkableM" <+> ppr mod_nm <+> ppr unlinkeds
- ppr (LP package_nm) = text "LinkableP" <+> ptext package_nm
+ ppr (LM when_made mod_nm unlinkeds)
+ = text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod_nm
+ <+> ppr unlinkeds
+ ppr (LP package_nm)
+ = text "LinkableP" <+> ptext package_nm
+
+linkableTime (LM when_made mod_nm unlinkeds) = when_made
+linkableTime (LP package_nm) = panic "linkableTime"
+
-- The ModuleLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
ms_location :: ModuleLocation, -- location
ms_srcimps :: [ModuleName], -- source imports
ms_imps :: [ModuleName], -- non-source imports
- ms_hs_date :: Maybe ClockTime, -- timestamp of summarised
+ ms_hs_date :: Maybe ClockTime -- timestamp of summarised
-- file, if home && source
- ms_hi_date :: Maybe ClockTime -- timestamp of old iface,
- -- if home && source
}
instance Outputable ModSummary where
ppr ms
= sep [text "ModSummary {",
nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
- text "ms_hi_date = " <> text (show (ms_hi_date ms)),
text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
text "ms_imps =" <+> ppr (ms_imps ms),
text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
char '}'
]
-pprSummaryTimes ms
- = sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
- text "ms_hi_date = " <> text (show (ms_hi_date ms))]
+pprSummaryTime ms
+ = text "ms_hs_date = " <> parens (text (show (ms_hs_date ms)))
name_of_summary :: ModSummary -> ModuleName
name_of_summary = moduleName . ms_mod
-- doubt say True.
summary_indicates_source_changed :: [ModSummary] -> ModSummary -> Bool
summary_indicates_source_changed old_summaries new_summary
+ = panic "SISC"
+#if 0
= case [old | old <- old_summaries,
name_of_summary old == name_of_summary new_summary] of
(Just old_t, Just new_t) -> new_t > old_t
other -> True
)
+#endif
+
-- Return (names of) all those in modsDone who are part of a cycle
-- as defined by theGraph.
-- Compile a single module. Always produce a Linkable for it if
-- successful. If no compilation happened, return the old Linkable.
+maybe_getFileLinkable :: ModuleName -> FilePath -> IO (Maybe Linkable)
+maybe_getFileLinkable mod_name obj_fn
+ = do obj_exist <- doesFileExist obj_fn
+ if not obj_exist
+ then return Nothing
+ else
+ do let stub_fn = case splitFilename3 obj_fn of
+ (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
+ stub_exist <- doesFileExist stub_fn
+ obj_time <- getModificationTime obj_fn
+ if stub_exist
+ then return (Just (LM obj_time mod_name [DotO obj_fn, DotO stub_fn]))
+ else return (Just (LM obj_time mod_name [DotO obj_fn]))
+
+
upsweep_mod :: GhciMode
-> UnlinkedImage
-> CmThreaded
let (CmThreaded pcs1 hst1 hit1) = threaded1
let old_iface = lookupUFM hit1 (name_of_summary summary1)
- -- We *have* to compile it if we're in batch mode and we can't see
- -- a previous linkable for it on disk. Or if we're in interpretive
- -- and there's no old linkable in oldUI.
- compilation_mandatory
- <- case ghci_mode of
- Batch -> case ml_obj_file (ms_location summary1) of
- Nothing -> return True
- Just obj_fn -> do b <- doesFileExist obj_fn
- return (not b)
- Interactive -> case findModuleLinkable_maybe oldUI mod_name of
- Nothing -> return True
- Just li -> return False
- OneShot -> panic "upsweep_mod:compilation_mandatory"
-
- let compilation_might_be_needed
- = source_might_have_changed || compilation_mandatory
+ let maybe_oldUI_linkable = findModuleLinkable_maybe oldUI mod_name
+ maybe_oldDisk_linkable
+ <- case ml_obj_file (ms_location summary1) of
+ Nothing -> return Nothing
+ Just obj_fn -> maybe_getFileLinkable mod_name obj_fn
+
+ -- The most recent of the old UI linkable or whatever we could
+ -- find on disk. Is returned as the linkable if compile
+ -- doesn't think we need to recompile.
+ let maybe_old_linkable
+ = case (maybe_oldUI_linkable, maybe_oldDisk_linkable) of
+ (Nothing, Nothing) -> Nothing
+ (Nothing, Just di) -> Just di
+ (Just ui, Nothing) -> Just ui
+ (Just ui, Just di)
+ | linkableTime ui >= linkableTime di -> Just ui
+ | otherwise -> Just di
+
+ let compilation_mandatory
+ = case maybe_old_linkable of
+ Nothing -> True
+ Just li -> case ms_hs_date summary1 of
+ Nothing -> panic "compilation_mandatory:no src date"
+ Just src_date -> src_date >= linkableTime li
source_unchanged
- = not compilation_might_be_needed
+ = not compilation_mandatory
+
(hst1_strictDC, hit1_strictDC)
= retainInTopLevelEnvs reachable_from_here (hst1,hit1)
+ old_linkable
+ = unJust "upsweep_mod:old_linkable" maybe_old_linkable
+
compresult <- compile ghci_mode summary1 source_unchanged
old_iface hst1_strictDC hit1_strictDC pcs1
- --putStrLn ( "UPSWEEP_MOD: smhc = " ++ show source_might_have_changed
- -- ++ ", cman = " ++ show compilation_mandatory)
-
case compresult of
-- Compilation "succeeded", but didn't return a new iface or
-> let hst2 = addToUFM hst1 mod_name details
hit2 = hit1
threaded2 = CmThreaded pcs2 hst2 hit2
- old_linkable
- | ghci_mode == Interactive
- = unJust "upsweep_mod(2)"
- (findModuleLinkable_maybe oldUI mod_name)
- | otherwise
- = LM mod_name
- [DotO (unJust "upsweep_mod(1)"
- (ml_obj_file (ms_location summary1))
- )]
in return (threaded2, Just old_linkable)
-- Compilation really did happen, and succeeded. A new
<- case ml_hs_file location of
Nothing -> return Nothing
Just src_fn -> maybe_getModificationTime src_fn
- maybe_iface_timestamp
- <- case ml_hi_file location of
- Nothing -> return Nothing
- Just if_fn -> maybe_getModificationTime if_fn
-- If the module name is Main, allow it to be in a file
-- different from Main.hs, and mash the mod and loc
return (ModSummary mashed_mod
mashed_loc{ml_hspp_file=Just hspp_fn}
srcimps imps
- maybe_src_timestamp maybe_iface_timestamp)
+ maybe_src_timestamp)
| otherwise
- = return (ModSummary mod location [] [] Nothing Nothing)
+ = return (ModSummary mod location [] [] Nothing)
where
maybe_getModificationTime :: FilePath -> IO (Maybe ClockTime)
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.31 2000/11/20 11:39:57 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.32 2000/11/20 13:39:26 sewardj Exp $
--
-- GHC Driver
--
import Config
import Util
+import Time ( getClockTime )
import Directory
import System
import IOExts
Nothing -> []
Just stub_o -> [ DotO stub_o ]
- hs_unlinked <-
+ (hs_unlinked, unlinked_time) <-
case hsc_lang of
-- in interpreted mode, just return the compiled code
-- as our "unlinked" object.
HscInterpreted ->
case maybe_interpreted_code of
- Just (code,itbl_env) -> return [Trees code itbl_env]
- Nothing -> panic "compile: no interpreted code"
+ Just (code,itbl_env) -> do tm <- getClockTime
+ return ([Trees code itbl_env], tm)
+ Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
_other -> do pipe <- genPipeline (StopBefore Ln) "" True
-- the base name and use it as the base of
-- the output object file.
let (basename, suffix) = splitFilename input_fn
- o_file <- pipeLoop pipe output_fn False False basename suffix
- return [ DotO o_file ]
+ o_file <- pipeLoop pipe output_fn False False
+ basename suffix
+ o_time <- getModificationTime o_file
+ return ([DotO o_file], o_time)
- let linkable = LM (moduleName (ms_mod summary))
- (hs_unlinked ++ stub_unlinked)
+ let linkable = LM unlinked_time (moduleName (ms_mod summary))
+ (hs_unlinked ++ stub_unlinked)
return (CompOK details (Just (iface, linkable)) pcs)
}
projects / ghc-hetmet.git / commitdiff