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

File 0001-Consider-usage-files-in-the-GHCi-recompilation-check.2.patch, 13.6 KB (added by parcs, 10 months ago)

  • compiler/main/DriverPipeline.hs 

    From bd6b519ef9d5e0d0595793041457a607fcc15b13 Mon Sep 17 00:00:00 2001
From: Patrick Palka <patrick@parcs.ath.cx>
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 |   22 ++++++++++-----
 compiler/main/GHC.hs            |    1 +
 compiler/main/GhcMake.hs        |   59 +++++++++++++++++++++++++++++++--------
 compiler/main/HscTypes.lhs      |    2 ++
 4 files changed, 66 insertions(+), 18 deletions(-)

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 4770679..0bb3e7b 100644
    a b  
    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 
    … …  
    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 
    … …  
    210210                              return [DotO stub_o] 
    211211 
    212212                let hs_unlinked = [BCOs comp_bc modBreaks] 
    213                     unlinked_time = ms_hs_date summary 
     213 
     214                unlinked_time <- do 
     215                    let usage_mtimes = 
     216                            [mtime | UsageFile _ mtime <- mi_usages iface] 
     217                    return $ maximum (ms_hs_date summary : usage_mtimes) 
    214218                  -- Why do we use the timestamp of the source file here, 
    215219                  -- rather than the current time?  This works better in 
    216220                  -- the case where the local clock is out of sync 
    217221                  -- with the filesystem's clock.  It's just as accurate: 
    218222                  -- if the source is modified, then the linkable will 
    219223                  -- be out of date. 
     224                  -- However, make sure to take into account the mtimes of the 
     225                  -- module's usage files, too. 
     226 
    220227                let linkable = LM unlinked_time this_mod 
    221228                               (hs_unlinked ++ stub_o) 
    222229                return (Just linkable) 
    … …  
    227234           = do (result, iface, details) 
    228235                    <- compiler hsc_env' summary source_modified mb_old_iface 
    229236                                (Just (mod_index, nmods)) 
    230                 linkable <- handle result 
     237                linkable <- handle iface result 
    231238                return (HomeModInfo{ hm_details  = details, 
    232239                                     hm_iface    = iface, 
    233240                                     hm_linkable = linkable }) 
    … …  
    946953                                        ms_hspp_buf  = hspp_buf, 
    947954                                        ms_location  = location4, 
    948955                                        ms_hs_date   = src_timestamp, 
     956                                        ms_uf_date   = Nothing, 
    949957                                        ms_obj_date  = Nothing, 
    950958                                        ms_textual_imps = imps, 
    951959                                        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  
    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..fca9638 100644
    a b  
    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: 
    … …  
    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 
    … …  
    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 = Just (linkableTime linkable) >= ms_uf_date ms 
     595 
    590596-- ----------------------------------------------------------------------------- 
    591597-- 
    592598-- | The upsweep 
    … …  
    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  
    … …  
    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))  
    … …  
    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) 
    … …  
    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 
    … …  
    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)) 
    … …  
    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 
     1413                | null mtimes = Nothing 
     1414                | otherwise   = maximum mtimes 
     1415 
     1416        return (mtimes == map Just old_mtimes, max_mtime) 
     1417 
     1418    | otherwise = return (False, Nothing) 
     1419 
    13831420getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime) 
    13841421getObjTimestamp location is_boot 
    13851422  = 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  
    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* 
    … …  
    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),