Ticket #4900: alternative.patch

File alternative.patch, 14.6 KB (added by parcs, 21 months ago)

Alternative implementation

  • compiler/main/DriverPipeline.hs

    From c2e6eaeddd5357d8be278f56aa00ccb01ff31239 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
    
    A module now gets recompiled if its usage files have changed.
    ---
     compiler/main/DriverPipeline.hs |    9 ++++-
     compiler/main/GHC.hs            |    1 +
     compiler/main/GhcMake.hs        |   85 ++++++++++++++++++++++++++++++---------
     compiler/main/HscTypes.lhs      |    2 +
     4 files changed, 78 insertions(+), 19 deletions(-)
    
    diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
    index 4770679..0cc6097 100644
    a b 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                    usage_file_mtimes = map snd (ms_usage_files summary) 
     215                    unlinked_time = 
     216                        maximum (ms_hs_date summary : catMaybes usage_file_mtimes) 
    214217                  -- Why do we use the timestamp of the source file here, 
    215218                  -- rather than the current time?  This works better in 
    216219                  -- the case where the local clock is out of sync 
    217220                  -- with the filesystem's clock.  It's just as accurate: 
    218221                  -- if the source is modified, then the linkable will 
    219222                  -- be out of date. 
     223                  -- However, make sure to consider the mtimes of the module's 
     224                  -- usage files, too. 
     225 
    220226                let linkable = LM unlinked_time this_mod 
    221227                               (hs_unlinked ++ stub_o) 
    222228                return (Just linkable) 
    runPhase (Hsc src_flavour) input_fn dflags0 
    946952                                        ms_hspp_buf  = hspp_buf, 
    947953                                        ms_location  = location4, 
    948954                                        ms_hs_date   = src_timestamp, 
     955                                        ms_usage_files = [], 
    949956                                        ms_obj_date  = Nothing, 
    950957                                        ms_textual_imps = imps, 
    951958                                        ms_srcimps      = src_imps } 
  • compiler/main/GHC.hs

    diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
    index bedb300..383dff8 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_usage_files = [], 
    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..77146da 100644
    a b load how_much = do 
    253253                               2 (ppr mg)) 
    254254 
    255255    setSession hsc_env{ hsc_HPT = emptyHomePackageTable } 
    256     (upsweep_ok, modsUpswept) 
     256    (upsweep_ok, modsUpswept, modsNotUpswept) 
    257257       <- upsweep pruned_hpt stable_mods cleanup mg 
    258258 
    259259    -- Make modsDone be the summaries for each home module now 
    load how_much = do 
    262262 
    263263    let modsDone = reverse modsUpswept 
    264264 
     265    -- The upswept modules were possibly changed, so update the module graph. 
     266    modifySession $ \hsc_env -> hsc_env 
     267        { hsc_mod_graph = modsUpswept ++ modsNotUpswept } 
     268 
    265269    -- Try and do linking in some form, depending on whether the 
    266270    -- upsweep was completely or only partially successful. 
    267271 
    unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' 
    502506        all stableObject (imports m) 
    503507        && old linkable does not exist, or is == on-disk .o 
    504508        && date(on-disk .o) > date(.hs) 
     509        && date(linkableTime) > usage file dates 
    505510 
    506511  stableBCO m = 
    507512        all stable (imports m) 
    508513        && date(BCO) > date(.hs) 
     514        && date(linkableTime) > usage file dates 
    509515@ 
    510516 
    511517  These properties embody the following ideas: 
    checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    567573          where 
    568574             same_as_prev t = case lookupUFM hpt (ms_mod_name ms) of 
    569575                                Just hmi  | Just l <- hm_linkable hmi 
    570                                  -> isObjectLinkable l && t == linkableTime l 
     576                                 -> isObjectLinkable l && t == linkableTime l && 
     577                                    usage_files_ok ms l 
    571578                                _other  -> True 
    572579                -- why '>=' rather than '>' above?  If the filesystem stores 
    573580                -- times to the nearset second, we may occasionally find that 
    checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs 
    584591          | otherwise = case lookupUFM hpt (ms_mod_name ms) of 
    585592                Just hmi  | Just l <- hm_linkable hmi -> 
    586593                        not (isObjectLinkable l) &&  
    587                         linkableTime l >= ms_hs_date ms 
     594                        linkableTime l >= ms_hs_date ms && 
     595                        usage_files_ok ms l 
    588596                _other  -> False 
    589597 
     598        -- Check whether the usage files' mtimes are <= the linkableTime. 
     599        -- An mtime of Nothing means a usage file has been deleted; in that case 
     600        -- the module is marked unstable. 
     601        usage_files_ok ms linkable = all (maybe False (<= linkableTime linkable)) 
     602                                         (map snd (ms_usage_files ms)) 
     603 
    590604-- ----------------------------------------------------------------------------- 
    591605-- 
    592606-- | The upsweep 
    upsweep 
    602616    -> (HscEnv -> IO ())           -- ^ How to clean up unwanted tmp files 
    603617    -> [SCC ModSummary]            -- ^ Mods to do (the worklist) 
    604618    -> m (SuccessFlag, 
     619          [ModSummary], 
    605620          [ModSummary]) 
    606621       -- ^ Returns: 
    607622       -- 
    608623       --  1. A flag whether the complete upsweep was successful. 
    609624       --  2. The 'HscEnv' in the monad has an updated HPT 
    610625       --  3. A list of modules which succeeded loading. 
     626       --  4. A list of modules which weren't loaded. 
    611627 
    612628upsweep old_hpt stable_mods cleanup sccs = do 
    613    (res, done) <- upsweep' old_hpt [] sccs 1 (length sccs) 
    614    return (res, reverse done) 
     629   (res, done, notDone) <- upsweep' old_hpt [] sccs 1 (length sccs) 
     630   return (res, reverse done, flattenSCCs notDone) 
    615631 where 
    616632 
    617633  upsweep' _old_hpt done 
    618634     [] _ _ 
    619    = return (Succeeded, done) 
     635   = return (Succeeded, done, []) 
    620636 
    621637  upsweep' _old_hpt done 
    622      (CyclicSCC ms:_) _ _ 
     638     mg@(CyclicSCC ms:_) _ _ 
    623639   = do dflags <- getSessionDynFlags 
    624640        liftIO $ fatalErrorMsg dflags (cyclicModuleErr ms) 
    625         return (Failed, done) 
     641        return (Failed, done, mg) 
    626642 
    627643  upsweep' old_hpt done 
    628      (AcyclicSCC mod:mods) mod_index nmods 
     644     mg@(AcyclicSCC mod:mods) mod_index nmods 
    629645   = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++  
    630646        --           show (map (moduleUserString.moduleName.mi_module.hm_iface)  
    631647        --                     (moduleEnvElts (hsc_HPT hsc_env))) 
    upsweep old_hpt stable_mods cleanup sccs = do 
    645661                 return (Just mod_info) 
    646662 
    647663        case mb_mod_info of 
    648           Nothing -> return (Failed, done) 
     664          Nothing -> return (Failed, done, mg) 
    649665          Just mod_info -> do 
    650666                let this_mod = ms_mod_name mod 
    651667 
    upsweep old_hpt stable_mods cleanup sccs = do 
    663679                    old_hpt1 | isBootSummary mod = old_hpt 
    664680                             | otherwise = delFromUFM old_hpt this_mod 
    665681 
    666                     done' = mod:done 
     682                -- Update the usage files of this mod with data from the 
     683                -- newly generated HMI 
     684                let usages      = mi_usages (hm_iface mod_info) 
     685                    usage_files = [(file,Just mtime) | UsageFile file mtime <- usages] 
     686 
     687                    mod'  = mod { ms_usage_files = usage_files } 
     688                    done' = mod':done 
    667689 
    668690                        -- fixup our HomePackageTable after we've finished compiling 
    669691                        -- a mutually-recursive loop.  See reTypecheckLoop, below. 
    670                 hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod done' 
     692                hsc_env2 <- liftIO $ reTypecheckLoop hsc_env1 mod' done' 
    671693                setSession hsc_env2 
    672694 
    673695                upsweep' old_hpt1 done' mods (mod_index+1) nmods 
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    11941216   = do 
    11951217        let location = ms_location old_summary 
    11961218 
     1219        (usage_files_ok,usage_files) <- checkUsageFiles old_summary 
    11971220        src_timestamp <- get_src_timestamp 
    11981221                -- The file exists; we checked in getRootSummary above. 
    11991222                -- If it gets removed subsequently, then this  
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12011224                -- behaviour. 
    12021225 
    12031226                -- return the cached summary if the source didn't change 
    1204         if ms_hs_date old_summary == src_timestamp 
     1227        summary <- if ms_hs_date old_summary == src_timestamp && usage_files_ok 
    12051228           then do -- update the object-file timestamp 
    12061229                  obj_timestamp <- 
    12071230                    if isObjectTarget (hscTarget (hsc_dflags hsc_env))  
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12121235           else 
    12131236                new_summary src_timestamp 
    12141237 
     1238        -- Update the usage file mtimes if a usage file has been altered. 
     1239        return $ if usage_files_ok 
     1240                    then summary 
     1241                    else summary { ms_usage_files = usage_files } 
     1242 
    12151243   | otherwise 
    12161244   = do src_timestamp <- get_src_timestamp 
    12171245        new_summary src_timestamp 
    summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf 
    12511279                             ms_hspp_buf  = Just buf, 
    12521280                             ms_srcimps = srcimps, ms_textual_imps = the_imps, 
    12531281                             ms_hs_date = src_timestamp, 
     1282                             ms_usage_files = [], 
    12541283                             ms_obj_date = obj_timestamp }) 
    12551284 
    12561285findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary 
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    12821311        let location = ms_location old_summary 
    12831312            src_fn = expectJust "summariseModule" (ml_hs_file location) 
    12841313 
     1314        (usage_files_ok,usage_files) <- checkUsageFiles old_summary 
     1315 
    12851316                -- check the modification time on the source file, and 
    12861317                -- return the cached summary if it hasn't changed.  If the 
    12871318                -- 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 
     1319        maybe_ms <- case maybe_buf of 
     1320           Just (_,t) -> check_timestamp old_summary location src_fn t usage_files_ok 
    12901321           Nothing    -> do 
    12911322                m <- tryIO (getModificationUTCTime src_fn) 
    12921323                case m of 
    1293                    Right t -> check_timestamp old_summary location src_fn t 
     1324                   Right t -> 
     1325                        check_timestamp old_summary location src_fn t usage_files_ok 
    12941326                   Left e | isDoesNotExistError e -> find_it 
    12951327                          | otherwise             -> ioError e 
    12961328 
     1329        -- Update the usage file mtimes if a usage file has been altered. 
     1330        return $ case maybe_ms of 
     1331            Nothing -> Nothing 
     1332            Just ms | usage_files_ok -> Just ms 
     1333                    | otherwise      -> Just ms { ms_usage_files = usage_files } 
     1334 
    12971335  | otherwise  = find_it 
    12981336  where 
    12991337    dflags = hsc_dflags hsc_env 
    13001338 
    13011339    hsc_src = if is_boot then HsBootFile else HsSrcFile 
    13021340 
    1303     check_timestamp old_summary location src_fn src_timestamp 
    1304         | ms_hs_date old_summary == src_timestamp = do 
     1341    check_timestamp old_summary location src_fn src_timestamp usage_files_ok 
     1342        | ms_hs_date old_summary == src_timestamp, usage_files_ok = do 
    13051343                -- update the object-file timestamp 
    13061344                obj_timestamp <-  
    13071345                    if isObjectTarget (hscTarget (hsc_dflags hsc_env)) 
    summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) 
    13771415                              ms_srcimps      = srcimps, 
    13781416                              ms_textual_imps = the_imps, 
    13791417                              ms_hs_date   = src_timestamp, 
     1418                              ms_usage_files   = [], 
    13801419                              ms_obj_date  = obj_timestamp })) 
    13811420 
    13821421 
     1422checkUsageFiles :: ModSummary 
     1423                -> IO (Bool, [(FilePath,Maybe UTCTime)]) 
     1424                -- ^ returns whether any usage file has been altered, 
     1425                -- and the entire list of usage files with their mtimes updated 
     1426checkUsageFiles summary = do 
     1427    let (usage_files,old_mtimes) = unzip (ms_usage_files summary) 
     1428    mtimes <- mapM modificationTimeIfExists usage_files 
     1429 
     1430    return (mtimes == old_mtimes, zip usage_files mtimes) 
     1431 
    13831432getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime) 
    13841433getObjTimestamp location is_boot 
    13851434  = if is_boot then return Nothing 
  • compiler/main/HscTypes.lhs

    diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
    index 343df00..813c19b 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_usage_files  :: [(FilePath,Maybe UTCTime)], -- ^ Usage files and their mtimes 
    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_usage_files = " <> text (show (ms_usage_files 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),