Ticket #4900: 0001-Have-the-GHCi-recompilation-checker-consider-usage-f.patch

File 0001-Have-the-GHCi-recompilation-checker-consider-usage-f.patch, 8.7 KB (added by parcs, 3 years ago)
  • compiler/main/DriverPipeline.hs

    From c61b9fc480a32059430e362be21c93d1c29e4aa0 Mon Sep 17 00:00:00 2001
    From: Patrick Palka <[email protected]>
    Date: Mon, 9 Apr 2012 13:51:13 -0400
    Subject: [PATCH] Have the GHCi recompilation checker consider usage files
    
    GHCi now looks at the modification times of a module's usage files
    (i.e. #included files and dependencies added with qAddDependency) to
    determine whether a module requires recompilation.
    ---
     compiler/main/DriverPipeline.hs |    1 +
     compiler/main/GHC.hs            |    1 +
     compiler/main/GhcMake.hs        |   55 +++++++++++++++++++++++++++++++--------
     compiler/main/HscTypes.lhs      |    2 ++
     4 files changed, 48 insertions(+), 11 deletions(-)
    
    diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
    index 488df37..cb1b43a 100644
    a b runPhase (Hsc src_flavour) input_fn dflags0 
    947947                                        ms_hspp_buf  = hspp_buf,
    948948                                        ms_location  = location4,
    949949                                        ms_hs_date   = src_timestamp,
     950                                        ms_uf_date   = Nothing,
    950951                                        ms_obj_date  = Nothing,
    951952                                        ms_textual_imps = imps,
    952953                                        ms_srcimps      = src_imps }
  • compiler/main/GHC.hs

    diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
    index 15e488b..e63da89 100644
    a b compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do 
    882882         -- want. (Thus it doesn't matter what the timestamp
    883883         -- for the (nonexistent) source file is.)
    884884         ms_hs_date = currentTime,
     885         ms_uf_date = Nothing,
    885886         ms_obj_date = Nothing,
    886887         -- Only handling the single-module case for now, so no imports.
    887888         ms_srcimps = [],
  • compiler/main/GhcMake.hs

    diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
    index f0662ab..5a53ac8 100644
    a b checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    566566          where
    567567             same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
    568568                                Just hmi  | Just l <- hm_linkable hmi
    569                                  -> isObjectLinkable l && t == linkableTime l
     569                                 -> isObjectLinkable l && t == linkableTime l &&
     570                                    uf_date_ok ms l
    570571                                _other  -> True
    571572                -- why '>=' rather than '>' above?  If the filesystem stores
    572573                -- times to the nearset second, we may occasionally find that
    checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    582583          = case lookupUFM hpt (ms_mod_name ms) of
    583584                Just hmi  | Just l <- hm_linkable hmi ->
    584585                        not (isObjectLinkable l) &&
    585                         linkableTime l >= ms_hs_date ms
     586                        linkableTime l >= ms_hs_date ms &&
     587                        uf_date_ok ms l
    586588                _other  -> False
    587589
     590        uf_date_ok ms linkable
     591            | Just uf_date <- ms_uf_date ms = uf_date <= linkableTime linkable
     592            | otherwise = True
     593
    588594-- -----------------------------------------------------------------------------
    589595--
    590596-- | The upsweep
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    11991205                -- getModificationUTCTime may fail, but that's the right
    12001206                -- behaviour.
    12011207
    1202         if ms_hs_date old_summary == src_timestamp
     1208        uf_date <- getUsageFileDate hsc_env old_summary
     1209
     1210        if ms_hs_date old_summary == src_timestamp &&
     1211           ms_uf_date old_summary == uf_date
    12031212           then do -- update the object-file timestamp
    12041213                  obj_timestamp <-
    12051214                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12081217                        else return Nothing
    12091218                  return old_summary{ ms_obj_date = obj_timestamp }
    12101219           else
    1211                 new_summary
     1220                new_summary uf_date
    12121221
    12131222   | otherwise
    1214    = new_summary
     1223   = new_summary Nothing
    12151224  where
    1216     new_summary = do
     1225    new_summary uf_date = do
    12171226        let dflags = hsc_dflags hsc_env
    12181227
    12191228        (dflags', hspp_fn, buf)
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12481257                             ms_hspp_buf  = Just buf,
    12491258                             ms_srcimps = srcimps, ms_textual_imps = the_imps,
    12501259                             ms_hs_date = src_timestamp,
     1260                             ms_uf_date = uf_date,
    12511261                             ms_obj_date = obj_timestamp })
    12521262
    12531263findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    12791289        let location = ms_location old_summary
    12801290            src_fn = expectJust "summariseModule" (ml_hs_file location)
    12811291
     1292        uf_date <- getUsageFileDate hsc_env old_summary
     1293
    12821294                -- check the modification time on the source file, and
    12831295                -- return the cached summary if it hasn't changed.  If the
    12841296                -- file has disappeared, we need to call the Finder again.
    1285         case maybe_buf of
    1286            Just (_,t) -> check_timestamp old_summary location src_fn t
     1297        maybe_ms <- case maybe_buf of
     1298           Just (_,t) -> check_timestamp old_summary location src_fn t uf_date
    12871299           Nothing    -> do
    12881300                m <- tryIO (getModificationUTCTime src_fn)
    12891301                case m of
    1290                    Right t -> check_timestamp old_summary location src_fn t
     1302                   Right t -> check_timestamp old_summary location src_fn t uf_date
    12911303                   Left e | isDoesNotExistError e -> find_it
    12921304                          | otherwise             -> ioError e
    12931305
     1306        case maybe_ms of
     1307            Nothing -> return Nothing
     1308            Just ms -> return $ Just ms { ms_uf_date = uf_date }
     1309
    12941310  | otherwise  = find_it
    12951311  where
    12961312    dflags = hsc_dflags hsc_env
    12971313
    12981314    hsc_src = if is_boot then HsBootFile else HsSrcFile
    12991315
    1300     check_timestamp old_summary location src_fn src_timestamp
    1301         | ms_hs_date old_summary == src_timestamp = do
     1316    check_timestamp old_summary location src_fn src_timestamp uf_date
     1317        | ms_hs_date old_summary == src_timestamp
     1318        , ms_uf_date old_summary == uf_date = do
    13021319                -- update the object-file timestamp
    13031320                obj_timestamp <-
    13041321                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    13741391                              ms_srcimps      = srcimps,
    13751392                              ms_textual_imps = the_imps,
    13761393                              ms_hs_date   = src_timestamp,
     1394                              ms_uf_date   = Nothing,
    13771395                              ms_obj_date  = obj_timestamp }))
    13781396
     1397-- Get the latest timestamp of a module's usage files, if there is one.
     1398getUsageFileDate :: HscEnv -> ModSummary -> IO (Maybe UTCTime)
     1399getUsageFileDate hsc_env summary = do
     1400    mtimes <- mapM modificationTimeIfExists usage_files
     1401
     1402    let uf_date = case catMaybes mtimes of
     1403            [] -> Nothing
     1404            ts -> Just (maximum ts)
     1405
     1406    return uf_date
     1407
     1408  where
     1409    maybe_hmi   = lookupUFM (hsc_HPT hsc_env) (ms_mod_name summary)
     1410    usages      = maybe [] (mi_usages . hm_iface) maybe_hmi
     1411    usage_files = [ file | UsageFile file _ <- usages ]
    13791412
    13801413getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime)
    13811414getObjTimestamp location is_boot
  • compiler/main/HscTypes.lhs

    diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
    index e55d78e..d5a1a98 100644
    a b data ModSummary 
    18021802        ms_hsc_src      :: HscSource,           -- ^ The module source either plain Haskell, hs-boot or external core
    18031803        ms_location     :: ModLocation,         -- ^ Location of the various files belonging to the module
    18041804        ms_hs_date      :: UTCTime,             -- ^ Timestamp of source file
     1805        ms_uf_date      :: Maybe UTCTime,       -- ^ Latest timestamp of all its usage files,
     1806                                                --   if there is one
    18051807        ms_obj_date     :: Maybe UTCTime,       -- ^ Timestamp of object, if we have one
    18061808        ms_srcimps      :: [Located (ImportDecl RdrName)],      -- ^ Source imports of the module
    18071809        ms_textual_imps :: [Located (ImportDecl RdrName)],      -- ^ Non-source imports of the module from the module *text*