Commit 19519dc3 authored by simonmar's avatar simonmar

[project @ 2005-03-24 16:14:00 by simonmar]

Cleanup the upsweep strategy in GHC.load.

Now it's hopefully clearer how we decide what modules to recompile,
and which are "stable" (not even looked at) during a reload.  See the
comments for details.

Also, I've taken some trouble to explicitly prune out things that
aren't required before a reload, which should reduce the memory
requirements for :reload in GHCi.  Currently I believe it keeps most
of the old program until the reload is complete, now it shouldn't
require any extra memory.
parent acc0fe48
%
% (c) The University of Glasgow 2000
% (c) The University of Glasgow 2005
%
-- --------------------------------------
......@@ -30,7 +30,7 @@ import ByteCodeAsm ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
import Packages
import DriverPhases ( isObjectFilename, isDynLibFilename )
import Util ( getFileSuffix )
import Finder ( findModule, findLinkable, FindResult(..) )
import Finder ( findModule, findObjectLinkableMaybe, FindResult(..) )
import HscTypes
import Name ( Name, nameModule, isExternalName, isWiredInName )
import NameEnv
......@@ -54,6 +54,7 @@ import System.IO ( putStr, putStrLn, hPutStrLn, stderr, fixIO )
import System.Directory ( doesFileExist )
import Control.Exception ( block, throwDyn )
import Maybe ( isJust, fromJust )
#if __GLASGOW_HASKELL__ >= 503
import GHC.IOBase ( IO(..) )
......@@ -400,7 +401,8 @@ getLinkDeps hsc_env hpt pit mods
get_linkable mod_name -- A home-package module
| Just mod_info <- lookupModuleEnv hpt mod_name
= return (hm_linkable mod_info)
= ASSERT(isJust (hm_linkable mod_info))
return (fromJust (hm_linkable mod_info))
| otherwise
= -- It's not in the HPT because we are in one shot mode,
-- so use the Finder to get a ModLocation...
......@@ -412,7 +414,7 @@ getLinkDeps hsc_env hpt pit mods
found loc mod_name = do {
-- ...and then find the linkable for it
mb_lnk <- findLinkable mod_name loc ;
mb_lnk <- findObjectLinkableMaybe mod_name loc ;
case mb_lnk of {
Nothing -> no_obj mod_name ;
Just lnk -> return lnk
......
......@@ -87,27 +87,28 @@ preprocess dflags filename =
compile :: HscEnv
-> ModSummary
-> Bool -- True <=> source unchanged
-> Bool -- True <=> have object
-> Maybe Linkable -- Just linkable <=> source unchanged
-> Maybe ModIface -- Old interface, if available
-> IO CompResult
data CompResult
= CompOK ModDetails -- New details
ModIface -- New iface
(Maybe Linkable) -- New code; Nothing => compilation was not reqd
-- (old code is still valid)
= CompOK ModDetails -- New details
ModIface -- New iface
(Maybe Linkable) -- a Maybe, for the same reasons as hm_linkable
| CompErrs
compile hsc_env mod_summary
source_unchanged have_object old_iface = do
compile hsc_env mod_summary maybe_old_linkable old_iface = do
let dflags0 = hsc_dflags hsc_env
this_mod = ms_mod mod_summary
src_flavour = ms_hsc_src mod_summary
have_object
| Just l <- maybe_old_linkable, isObjectLinkable l = True
| otherwise = False
showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary)
let verb = verbosity dflags0
......@@ -149,17 +150,19 @@ compile hsc_env mod_summary
-- -no-recomp should also work with --make
let do_recomp = dopt Opt_RecompChecking dflags
source_unchanged' = source_unchanged && do_recomp
source_unchanged = isJust maybe_old_linkable && do_recomp
hsc_env' = hsc_env { hsc_dflags = dflags' }
-- run the compiler
hsc_result <- hscMain hsc_env' printErrorsAndWarnings mod_summary
source_unchanged' have_object old_iface
source_unchanged have_object old_iface
case hsc_result of
HscFail -> return CompErrs
HscNoRecomp details iface -> return (CompOK details iface Nothing)
HscNoRecomp details iface ->
ASSERT(isJust maybe_old_linkable)
return (CompOK details iface maybe_old_linkable)
HscRecomp details iface
stub_h_exists stub_c_exists maybe_interpreted_code
......@@ -254,7 +257,7 @@ link BatchCompile dflags batch_attempt_linking hpt
pkg_deps = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
-- the linkables to link
linkables = map hm_linkable home_mod_infos
linkables = map (fromJust.hm_linkable) home_mod_infos
when (verb >= 3) $ do
hPutStrLn stderr "link: linkables are ..."
......
......@@ -13,7 +13,8 @@ module Finder (
mkHomeModLocation2, -- :: ModuleName -> FilePath -> String -> IO ModLocation
addHomeModuleToFinder, -- :: HscEnv -> Module -> ModLocation -> IO ()
findLinkable, -- :: ModuleName -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe,
findObjectLinkable,
cantFindError, -- :: DynFlags -> Module -> FindResult -> SDoc
) where
......@@ -37,6 +38,7 @@ import System.IO
import Control.Monad
import Maybes ( MaybeErr(..) )
import Data.Maybe ( isNothing )
import Time ( ClockTime )
type FileExt = String -- Filename extension
......@@ -391,20 +393,24 @@ mkHiPath dflags basename mod_basename
-- findLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it
findLinkable :: Module -> ModLocation -> IO (Maybe Linkable)
findLinkable mod locn
findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
findObjectLinkableMaybe mod locn
= do let obj_fn = ml_obj_file locn
obj_exist <- doesFileExist obj_fn
if not obj_exist
then return Nothing
else
do let stub_fn = case splitFilename3 obj_fn of
(dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
stub_exist <- doesFileExist stub_fn
obj_time <- getModificationTime obj_fn
if stub_exist
then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
else return (Just (LM obj_time mod [DotO obj_fn]))
maybe_obj_time <- modificationTimeIfExists obj_fn
case maybe_obj_time of
Nothing -> return Nothing
Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
-- Make an object linkable when we know the object file exists, and we know
-- its modification time.
findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
findObjectLinkable mod obj_fn obj_time = do
let stub_fn = case splitFilename3 obj_fn of
(dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
stub_exist <- doesFileExist stub_fn
if stub_exist
then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
else return (LM obj_time mod [DotO obj_fn])
-- -----------------------------------------------------------------------------
-- Utils
......
This diff is collapsed.
......@@ -11,7 +11,7 @@ module HscTypes (
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
ModDetails(..),
ModDetails(..), emptyModDetails,
ModGuts(..), ModImports(..), ForeignStubs(..),
ModSummary(..), showModMsg, isBootSummary,
......@@ -214,9 +214,15 @@ emptyHomePackageTable = emptyModuleEnv
emptyPackageIfaceTable = emptyModuleEnv
data HomeModInfo
= HomeModInfo { hm_iface :: ModIface,
hm_details :: ModDetails,
hm_linkable :: Linkable }
= HomeModInfo { hm_iface :: !ModIface,
hm_details :: !ModDetails,
hm_linkable :: !(Maybe Linkable) }
-- hm_linkable might be Nothing if:
-- a) this is an .hs-boot module
-- b) temporarily during compilation if we pruned away
-- the old linkable because it was out of date.
-- after a complete compilation (GHC.load), all hm_linkable
-- fields in the HPT will be Just.
\end{code}
Simple lookups in the symbol table.
......@@ -358,6 +364,10 @@ data ModDetails
md_rules :: ![IdCoreRule] -- Domain may include Ids from other modules
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_insts = [],
md_rules = [] }
-- A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
-- being compiled right now. Once it is compiled, a ModIface and
......@@ -940,7 +950,8 @@ data ModSummary
ms_mod :: Module, -- Name of the module
ms_hsc_src :: HscSource, -- Source is Haskell, hs-boot, external core
ms_location :: ModLocation, -- Location
ms_hs_date :: ClockTime, -- Timestamp of summarised file
ms_hs_date :: ClockTime, -- Timestamp of source file
ms_obj_date :: Maybe ClockTime, -- Timestamp of object, maybe
ms_srcimps :: [Module], -- Source imports
ms_imps :: [Module], -- Non-source imports
ms_hspp_file :: Maybe FilePath, -- Filename of preprocessed source,
......
......@@ -47,6 +47,7 @@ import Module ( Module, mkModule )
import UniqFM
import UniqSet
import Util
import Maybes ( expectJust )
import Panic
import Outputable
......@@ -60,7 +61,7 @@ import Distribution.InstalledPackageInfo
import Distribution.Package
import Distribution.Version
import System.IO ( hPutStrLn, stderr )
import Data.Maybe ( fromJust, isNothing )
import Data.Maybe ( isNothing )
import System.Directory ( doesFileExist )
import Control.Monad ( when, foldM )
import Data.List ( nub, partition )
......@@ -177,7 +178,7 @@ extendPackageConfigMap pkg_map new_pkgs
where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
getPackageDetails :: PackageState -> PackageId -> PackageConfig
getPackageDetails dflags ps = fromJust (lookupPackage (pkgIdMap dflags) ps)
getPackageDetails dflags ps = expectJust "getPackageDetails" (lookupPackage (pkgIdMap dflags) ps)
-- ----------------------------------------------------------------------------
-- Loading the package config files and building up the package state
......@@ -354,7 +355,7 @@ mkPackageState dflags pkg_db = do
let
extend_modmap modmap pkgname = do
let
pkg = fromJust (lookupPackage pkg_db pkgname)
pkg = expectJust "mkPackageState" (lookupPackage pkg_db pkgname)
exposed_mods = map mkModule (exposedModules pkg)
hidden_mods = map mkModule (hiddenModules pkg)
all_mods = exposed_mods ++ hidden_mods
......
......@@ -56,6 +56,7 @@ module Util (
-- IO-ish utilities
createDirectoryHierarchy,
doesDirNameExist,
modificationTimeIfExists,
later, handleDyn, handle,
......@@ -89,10 +90,12 @@ import List ( zipWith4 )
#endif
import Monad ( when )
import IO ( catch )
import IO ( catch, isDoesNotExistError )
import Directory ( doesDirectoryExist, createDirectory )
import Char ( isUpper, isAlphaNum, isSpace, ord, isDigit )
import Ratio ( (%) )
import Time ( ClockTime )
import Directory ( getModificationTime )
infixr 9 `thenCmp`
\end{code}
......@@ -839,6 +842,16 @@ handle h f = f `Exception.catch` \e -> case e of
_ -> h e
#endif
-- --------------------------------------------------------------
-- check existence & modification time at the same time
modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
modificationTimeIfExists f = do
(do t <- getModificationTime f; return (Just t))
`IO.catch` \e -> if isDoesNotExistError e
then return Nothing
else ioError e
-- --------------------------------------------------------------
-- Filename manipulation
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment