Ticket #4900: 0001-Consider-usage-files-in-the-GHCi-recompilation-check.patch

File 0001-Consider-usage-files-in-the-GHCi-recompilation-check.patch, 13.5 KB (added by parcs, 3 years ago)
  • compiler/main/DriverPipeline.hs

    From 7dbe83d7170ce56ca1afd3b13df98d3746d4615a Mon Sep 17 00:00:00 2001
    From: Patrick Palka <[email protected]>
    Date: Mon, 16 Jul 2012 16:58:40 -0400
    Subject: [PATCH] Consider usage files in the GHCi recompilation checker
    
    Modules now get recompiled if their usage files have changed.
    ---
     compiler/main/DriverPipeline.hs |   20 +++++++++-----
     compiler/main/GHC.hs            |    1 +
     compiler/main/GhcMake.hs        |   57 +++++++++++++++++++++++++++++++--------
     compiler/main/HscTypes.lhs      |    2 ++
     4 files changed, 62 insertions(+), 18 deletions(-)
    
    diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
    index 4770679..eb5744e 100644
    a b compile' (nothingCompiler, interactiveCompiler, batchCompiler) 
    162162         | otherwise = source_modified0
    163163       object_filename = ml_obj_file location
    164164
    165    let handleBatch HscNoRecomp
     165   let handleBatch _iface HscNoRecomp
    166166           = ASSERT (isJust maybe_old_linkable)
    167167             return maybe_old_linkable
    168168
    169        handleBatch (HscRecomp hasStub _)
     169       handleBatch _iface (HscRecomp hasStub _)
    170170           | isHsBoot src_flavour
    171171               = do when (isObjectTarget hsc_lang) $ -- interpreted reaches here too
    172172                       liftIO $ touchObjectFile dflags' object_filename
    compile' (nothingCompiler, interactiveCompiler, batchCompiler) 
    196196                    let linkable = LM unlinked_time this_mod hs_unlinked
    197197                    return (Just linkable)
    198198
    199        handleInterpreted HscNoRecomp
     199       handleInterpreted _iface HscNoRecomp
    200200           = ASSERT (isJust maybe_old_linkable)
    201201             return maybe_old_linkable
    202        handleInterpreted (HscRecomp _hasStub Nothing)
     202       handleInterpreted _iface (HscRecomp _hasStub Nothing)
    203203           = ASSERT (isHsBoot src_flavour)
    204204             return maybe_old_linkable
    205        handleInterpreted (HscRecomp hasStub (Just (comp_bc, modBreaks)))
     205       handleInterpreted iface (HscRecomp hasStub (Just (comp_bc, modBreaks)))
    206206           = do stub_o <- case hasStub of
    207207                            Nothing -> return []
    208208                            Just stub_c -> do
    compile' (nothingCompiler, interactiveCompiler, batchCompiler) 
    210210                              return [DotO stub_o]
    211211
    212212                let hs_unlinked = [BCOs comp_bc modBreaks]
    213                     unlinked_time = ms_hs_date summary
     213
     214                let usage_mtimes  = [mtime | UsageFile _ mtime <- mi_usages iface]
     215                    unlinked_time = maximum (ms_hs_date summary : usage_mtimes)
    214216                  -- Why do we use the timestamp of the source file here,
    215217                  -- rather than the current time?  This works better in
    216218                  -- the case where the local clock is out of sync
    217219                  -- with the filesystem's clock.  It's just as accurate:
    218220                  -- if the source is modified, then the linkable will
    219221                  -- be out of date.
     222                  -- However, make sure to take into account the mtimes of the
     223                  -- module's usage files, too.
     224
    220225                let linkable = LM unlinked_time this_mod
    221226                               (hs_unlinked ++ stub_o)
    222227                return (Just linkable)
    compile' (nothingCompiler, interactiveCompiler, batchCompiler) 
    227232           = do (result, iface, details)
    228233                    <- compiler hsc_env' summary source_modified mb_old_iface
    229234                                (Just (mod_index, nmods))
    230                 linkable <- handle result
     235                linkable <- handle iface result
    231236                return (HomeModInfo{ hm_details  = details,
    232237                                     hm_iface    = iface,
    233238                                     hm_linkable = linkable })
    runPhase (Hsc src_flavour) input_fn dflags0 
    946951                                        ms_hspp_buf  = hspp_buf,
    947952                                        ms_location  = location4,
    948953                                        ms_hs_date   = src_timestamp,
     954                                        ms_uf_date   = Nothing,
    949955                                        ms_obj_date  = Nothing,
    950956                                        ms_textual_imps = imps,
    951957                                        ms_srcimps      = src_imps }
  • compiler/main/GHC.hs

    diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
    index bedb300..80efcc5 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 322c631..44bb54d 100644
    a b unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' 
    502502        all stableObject (imports m)
    503503        && old linkable does not exist, or is == on-disk .o
    504504        && date(on-disk .o) > date(.hs)
     505        && date(linkableTime) > usage file dates
    505506
    506507  stableBCO m =
    507508        all stable (imports m)
    508509        && date(BCO) > date(.hs)
     510        && date(linkableTime) > usage file dates
    509511@
    510512
    511513  These properties embody the following ideas:
    checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    567569          where
    568570             same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of
    569571                                Just hmi  | Just l <- hm_linkable hmi
    570                                  -> isObjectLinkable l && t == linkableTime l
     572                                 -> isObjectLinkable l && t == linkableTime l &&
     573                                    uf_date_ok ms l
    571574                                _other  -> True
    572575                -- why '>=' rather than '>' above?  If the filesystem stores
    573576                -- times to the nearset second, we may occasionally find that
    checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    584587          | otherwise = case lookupUFM hpt (ms_mod_name ms) of
    585588                Just hmi  | Just l <- hm_linkable hmi ->
    586589                        not (isObjectLinkable l) &&
    587                         linkableTime l >= ms_hs_date ms
     590                        linkableTime l >= ms_hs_date ms &&
     591                        uf_date_ok ms l
    588592                _other  -> False
    589593
     594        uf_date_ok ms linkable = ms_uf_date ms <= Just (linkableTime linkable)
     595
    590596-- -----------------------------------------------------------------------------
    591597--
    592598-- | The upsweep
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    11941200   = do
    11951201        let location = ms_location old_summary
    11961202
     1203        (uf_date_ok,uf_date) <- isOkUsageFileDate hsc_env old_summary
    11971204        src_timestamp <- get_src_timestamp
    11981205                -- The file exists; we checked in getRootSummary above.
    11991206                -- If it gets removed subsequently, then this
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12011208                -- behaviour.
    12021209
    12031210                -- return the cached summary if the source didn't change
    1204         if ms_hs_date old_summary == src_timestamp
     1211        if ms_hs_date old_summary == src_timestamp && uf_date_ok
    12051212           then do -- update the object-file timestamp
    12061213                  obj_timestamp <-
    12071214                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12101217                        else return Nothing
    12111218                  return old_summary{ ms_obj_date = obj_timestamp }
    12121219           else
    1213                 new_summary src_timestamp
     1220                new_summary src_timestamp uf_date
    12141221
    12151222   | otherwise
    12161223   = do src_timestamp <- get_src_timestamp
    1217         new_summary src_timestamp
     1224        new_summary src_timestamp Nothing
    12181225  where
    12191226    get_src_timestamp = case maybe_buf of
    12201227                           Just (_,t) -> return t
    12211228                           Nothing    -> liftIO $ getModificationUTCTime file
    12221229                        -- getMofificationUTCTime may fail
    12231230
    1224     new_summary src_timestamp = do
     1231    new_summary src_timestamp uf_date = do
    12251232        let dflags = hsc_dflags hsc_env
    12261233
    12271234        (dflags', hspp_fn, buf)
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12511258                             ms_hspp_buf  = Just buf,
    12521259                             ms_srcimps = srcimps, ms_textual_imps = the_imps,
    12531260                             ms_hs_date = src_timestamp,
     1261                             ms_uf_date = uf_date,
    12541262                             ms_obj_date = obj_timestamp })
    12551263
    12561264findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    12821290        let location = ms_location old_summary
    12831291            src_fn = expectJust "summariseModule" (ml_hs_file location)
    12841292
     1293        (uf_date_ok,uf_date) <- isOkUsageFileDate hsc_env old_summary
     1294
    12851295                -- check the modification time on the source file, and
    12861296                -- return the cached summary if it hasn't changed.  If the
    12871297                -- file has disappeared, we need to call the Finder again.
    1288         case maybe_buf of
    1289            Just (_,t) -> check_timestamp old_summary location src_fn t
     1298        maybe_ms <- case maybe_buf of
     1299           Just (_,t) -> check_timestamp old_summary location src_fn t uf_date_ok
    12901300           Nothing    -> do
    12911301                m <- tryIO (getModificationUTCTime src_fn)
    12921302                case m of
    1293                    Right t -> check_timestamp old_summary location src_fn t
     1303                   Right t ->
     1304                        check_timestamp old_summary location src_fn t uf_date_ok
    12941305                   Left e | isDoesNotExistError e -> find_it
    12951306                          | otherwise             -> ioError e
    12961307
     1308        return $ case maybe_ms of
     1309            Nothing -> Nothing
     1310            Just ms -> Just ms { ms_uf_date = uf_date }
     1311
    12971312  | otherwise  = find_it
    12981313  where
    12991314    dflags = hsc_dflags hsc_env
    13001315
    13011316    hsc_src = if is_boot then HsBootFile else HsSrcFile
    13021317
    1303     check_timestamp old_summary location src_fn src_timestamp
    1304         | ms_hs_date old_summary == src_timestamp = do
     1318    check_timestamp old_summary location src_fn src_timestamp uf_date_ok
     1319        | ms_hs_date old_summary == src_timestamp, uf_date_ok = do
    13051320                -- update the object-file timestamp
    13061321                obj_timestamp <-
    13071322                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    13771392                              ms_srcimps      = srcimps,
    13781393                              ms_textual_imps = the_imps,
    13791394                              ms_hs_date   = src_timestamp,
     1395                              ms_uf_date   = Nothing,
    13801396                              ms_obj_date  = obj_timestamp }))
    13811397
    13821398
     1399-- Iterate over the module's usage files, and check whether they have been
     1400-- modified.
     1401isOkUsageFileDate :: HscEnv -> ModSummary
     1402                  -> IO (Bool, Maybe UTCTime)
     1403                  -- ^ Returns whether the usage files haven't changed, and
     1404                  -- the latest mtime of all the usage files.
     1405isOkUsageFileDate hsc_env summary
     1406    | Just hmi <- lookupUFM (hsc_HPT hsc_env) (ms_mod_name summary) = do
     1407        let usages      = mi_usages (hm_iface hmi)
     1408            usage_files = [file  | UsageFile file _  <- usages]
     1409            old_mtimes  = [mtime | UsageFile _ mtime <- usages]
     1410
     1411        mtimes <- mapM modificationTimeIfExists usage_files
     1412        let max_mtime = if null mtimes then Nothing else maximum mtimes
     1413
     1414        return (mtimes == map Just old_mtimes, max_mtime)
     1415
     1416    | otherwise = return (False, Nothing)
     1417
    13831418getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime)
    13841419getObjTimestamp location is_boot
    13851420  = if is_boot then return Nothing
  • compiler/main/HscTypes.lhs

    diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
    index 343df00..e2a3079 100644
    a b data ModSummary 
    18131813        ms_hsc_src      :: HscSource,           -- ^ The module source either plain Haskell, hs-boot or external core
    18141814        ms_location     :: ModLocation,         -- ^ Location of the various files belonging to the module
    18151815        ms_hs_date      :: UTCTime,             -- ^ Timestamp of source file
     1816        ms_uf_date      :: Maybe UTCTime,       -- ^ Latest timestamp of usage files
    18161817        ms_obj_date     :: Maybe UTCTime,       -- ^ Timestamp of object, if we have one
    18171818        ms_srcimps      :: [Located (ImportDecl RdrName)],      -- ^ Source imports of the module
    18181819        ms_textual_imps :: [Located (ImportDecl RdrName)],      -- ^ Non-source imports of the module from the module *text*
    instance Outputable ModSummary where 
    18651866   ppr ms
    18661867      = sep [text "ModSummary {",
    18671868             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
     1869                          text "ms_uf_date = " <> text (show (ms_uf_date ms)),
    18681870                          text "ms_mod =" <+> ppr (ms_mod ms)
    18691871                                <> text (hscSourceString (ms_hsc_src ms)) <> comma,
    18701872                          text "ms_textual_imps =" <+> ppr (ms_textual_imps ms),