Ticket #4900: alternative.patch

File alternative.patch, 14.6 KB (added by parcs, 3 years ago)

Alternative implementation

  • compiler/main/DriverPipeline.hs

    From c2e6eaeddd5357d8be278f56aa00ccb01ff31239 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
    
    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),