- else case ml_obj_file (ms_location summary) of
- Just obj_fn -> maybe_getFileLinkable mod_name obj_fn
- Nothing -> return Nothing
-
- let old_linkable = findModuleLinkable_maybe old_linkables mod_name
- maybe_old_linkable =
- case old_linkable of
- Just l | not (isObjectLinkable l) || stillThere l
- -> old_linkable
- -- ToDo: emit a warning if not (stillThere l)
- other -> Nothing
-
- -- make sure that if we had an old disk linkable around, that it's
- -- still there on the disk (in case we need to re-link it).
- stillThere l =
- case maybe_disk_linkable of
- Nothing -> False
- Just l_disk -> linkableTime l == linkableTime l_disk
-
- -- we only look for objects on disk the first time around;
- -- if the user compiles a module on the side during a GHCi session,
- -- it won't be picked up until the next ":load". This is what the
- -- "null old_linkables" test below is.
- linkable | null old_linkables = maybeToList maybe_disk_linkable
- | otherwise = maybeToList maybe_old_linkable
-
- -- only linkables newer than the source code are valid
- src_date = ms_hs_date summary
-
- valid_linkable
- = filter (\l -> linkableTime l > src_date) linkable
-
- return (valid_linkable ++ new_linkables)
-
-
-
-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]))
+
+ else findLinkable mod_name (ms_location summary)
+
+ let old_linkable = findModuleLinkable_maybe old_linkables mod_name
+
+ new_linkables' =
+ case (old_linkable, maybe_disk_linkable) of
+ (Nothing, Nothing) -> []
+
+ -- new object linkable just appeared
+ (Nothing, Just l) -> up_to_date l True
+
+ (Just l, Nothing)
+ | isObjectLinkable l -> []
+ -- object linkable disappeared! In case we need to
+ -- relink the module, disregard the old linkable and
+ -- just interpret the module from now on.
+ | otherwise -> up_to_date l False
+ -- old byte code linkable
+
+ (Just l, Just l')
+ | not (isObjectLinkable l) -> up_to_date l False
+ -- if the previous linkable was interpreted, then we
+ -- ignore a newly compiled version, because the version
+ -- numbers in the interface file will be out-of-sync with
+ -- our internal ones.
+ | linkableTime l' > linkableTime l -> up_to_date l' True
+ | linkableTime l' == linkableTime l -> up_to_date l False
+ | otherwise -> []
+ -- on-disk linkable has been replaced by an older one!
+ -- again, disregard the previous one.
+
+ up_to_date l b
+ | linkableTime l < ms_hs_date summary = []
+ | otherwise = [(l,b)]
+ -- why '<' rather than '<=' above? If the filesystem stores
+ -- times to the nearset second, we may occasionally find that
+ -- the object & source have the same modification time,
+ -- especially if the source was automatically generated
+ -- and compiled. Using >= is slightly unsafe, but it matches
+ -- make's behaviour.
+
+ return (new_linkables' ++ new_linkables)
+
+
+hptLinkables :: HomePackageTable -> [Linkable]
+-- Get all the linkables from the home package table, one for each module
+-- Once the HPT is up to date, these are the ones we should link
+hptLinkables hpt = map hm_linkable (moduleEnvElts hpt)