cmGetContext, -- :: CmState -> IO String
#ifdef GHCI
- cmRunStmt, -- :: CmState -> DynFlags -> String -> IO (CmState, [Name])
+ cmInfoThing, -- :: CmState -> DynFlags -> String -> IO (Maybe TyThing)
- cmTypeOfExpr, -- :: CmState -> DynFlags -> String
- -- -> IO (CmState, Maybe String)
+ cmRunStmt, -- :: CmState -> DynFlags -> String -> IO (CmState, [Name])
+
+ cmTypeOfExpr, -- :: CmState -> DynFlags -> String
+ -- -> IO (CmState, Maybe String)
cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String)
import CmLink
import CmTypes
-import CmStaticInfo ( GhciMode(..) )
import DriverPipeline
import DriverFlags ( getDynFlags )
import DriverPhases
import DriverUtil
import Finder
+#ifdef GHCI
+import HscMain ( initPersistentCompilerState, hscThing )
+#else
import HscMain ( initPersistentCompilerState )
+#endif
import HscTypes
import RnEnv ( unQualInScope )
import Id ( idType, idName )
import Unique ( Uniquable )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC )
import ErrUtils ( showPass )
+import SysTools ( cleanTempFilesExcept )
import Util
-import TmpFiles
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..) )
-- cmRunStmt: Run a statement/expr.
#ifdef GHCI
+cmInfoThing :: CmState -> DynFlags -> String -> IO (Maybe TyThing)
+cmInfoThing CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } dflags id
+ = do (pcs, thing) <- hscThing dflags hst hit pcs icontext id
+ return thing
+
cmRunStmt :: CmState -> DynFlags -> String
-> IO (CmState, -- new state
[Name]) -- names bound by this evaluation
-- the system state at the same time.
cmLoadModule :: CmState
- -> FilePath
+ -> [FilePath]
-> IO (CmState, -- new state
Bool, -- was successful
[String]) -- list of modules loaded
-cmLoadModule cmstate1 rootname
+cmLoadModule cmstate1 rootnames
= do -- version 1's are the original, before downsweep
let pls1 = pls cmstate1
let pcs1 = pcs cmstate1
showPass dflags "Chasing dependencies"
when (verb >= 1 && ghci_mode == Batch) $
- hPutStrLn stderr (progName ++ ": chasing modules from: " ++ rootname)
+ hPutStrLn stderr (showSDoc (hcat [
+ text progName, text ": chasing modules from: ",
+ hcat (punctuate comma (map text rootnames))]))
- (mg2unsorted, a_root_is_Main) <- downsweep [rootname] mg1
+ (mg2unsorted, a_root_is_Main) <- downsweep rootnames mg1
let mg2unsorted_names = map name_of_summary mg2unsorted
-- reachable_from follows source as well as normal imports
-- See getValidLinkables below for details.
valid_linkables <- getValidLinkables ui1 mg2unsorted_names
mg2_with_srcimps
+ -- when (verb >= 2) $
+ -- putStrLn (showSDoc (text "Valid linkables:"
+ -- <+> ppr valid_linkables))
-- Figure out a stable set of modules which can be retained
-- the top level envs, to avoid upsweeping them. Goes to a
-- unload any modules which aren't going to be re-linked this
-- time around.
- pls2 <- unload ghci_mode dflags stable_linkables pls1
+ pls2 <- CmLink.unload ghci_mode dflags stable_linkables pls1
-- We could at this point detect cycles which aren't broken by
-- a source-import, and complain immediately, but it seems better
let mods_to_zap_names
= findPartiallyCompletedCycles modsDone_names
mg2_with_srcimps
- let (hst4, hit4, ui4)
- = removeFromTopLevelEnvs mods_to_zap_names (hst3,hit3,ui3)
-
let mods_to_keep
= filter ((`notElem` mods_to_zap_names).name_of_summary)
modsDone
+ let (hst4, hit4, ui4)
+ = retainInTopLevelEnvs (map name_of_summary mods_to_keep)
+ (hst3,hit3,ui3)
+
-- clean up after ourselves
cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
return (new_cmstate, ok, mods_loaded)
}
+-- used to fish out the preprocess output files for the purposes
+-- of cleaning up.
ppFilesFromSummaries summaries
- = [ fn | Just fn <- map (ml_hspp_file . ms_location) summaries ]
+ = [ fn | Just fn <- map toPpFile summaries ]
+ where
+ toPpFile sum
+ | hspp /= ml_hs_file loc = hspp
+ | otherwise = Nothing
+ where
+ loc = ms_location sum
+ hspp = ml_hspp_file loc
+
-----------------------------------------------------------------------------
-- getValidLinkables
scc = flattenSCC scc0
scc_names = map name_of_summary scc
home_module m = m `elem` all_home_mods && m `notElem` scc_names
- scc_allhomeimps = nub (filter home_module (concatMap ms_allimps scc))
+ scc_allhomeimps = nub (filter home_module (concatMap ms_imps scc))
+ -- NOTE: ms_imps, not ms_allimps above. We don't want to
+ -- force a module's SOURCE imports to be already compiled for
+ -- its object linkable to be valid.
has_object m = case findModuleLinkable_maybe new_linkables m of
Nothing -> False
src_date = ms_hs_date summary
valid_linkable
- = filter (\l -> linkableTime l > src_date) linkable
+ = filter (\l -> linkableTime l >= src_date) linkable
+ -- why '>=' rather than '>' above? If the filesystem stores
+ -- times to the nearset second, we may occasionally find that
+ -- the object & source have the same modification time,
+ -- especially if the source was automatically generated
+ -- and compiled. Using >= is slightly unsafe, but it matches
+ -- make's behaviour.
return (valid_linkable ++ new_linkables)
-
maybe_getFileLinkable :: ModuleName -> FilePath -> IO (Maybe Linkable)
maybe_getFileLinkable mod_name obj_fn
= do obj_exist <- doesFileExist obj_fn
-- in interactive mode, all home modules below us *must* have an
-- interface in the HIT. We never demand-load home interfaces in
-- interactive mode.
- (hst1_strictDC, hit1_strictDC)
+ (hst1_strictDC, hit1_strictDC, [])
= ASSERT(ghci_mode == Batch ||
all (`elemUFM` hit1) reachable_only)
- retainInTopLevelEnvs reachable_only (hst1,hit1)
+ retainInTopLevelEnvs reachable_only (hst1,hit1,[])
old_linkable
= unJust "upsweep_mod:old_linkable" maybe_old_linkable
-> do let threaded2 = CmThreaded pcs2 hst1 hit1
return (threaded2, Nothing)
--- Remove unwanted modules from the top level envs (HST, HIT, UI).
-removeFromTopLevelEnvs :: [ModuleName]
- -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
- -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
-removeFromTopLevelEnvs zap_these (hst, hit, ui)
- = (delListFromUFM hst zap_these,
- delListFromUFM hit zap_these,
- filterModuleLinkables (`notElem` zap_these) ui
- )
-
+-- Filter modules in the top level envs (HST, HIT, UI).
retainInTopLevelEnvs :: [ModuleName]
- -> (HomeSymbolTable, HomeIfaceTable)
- -> (HomeSymbolTable, HomeIfaceTable)
-retainInTopLevelEnvs keep_these (hst, hit)
+ -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
+ -> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
+retainInTopLevelEnvs keep_these (hst, hit, ui)
= (retainInUFM hst keep_these,
- retainInUFM hit keep_these
+ retainInUFM hit keep_these,
+ filterModuleLinkables (`elem` keep_these) ui
)
where
retainInUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
res = simple_transitive_closure (map toEdge summaries) [root]
in
- --trace (showSDoc (text "DC of mod" <+> ppr root
- -- <+> text "=" <+> ppr res)) (
+-- trace (showSDoc (text "DC of mod" <+> ppr root
+-- <+> text "=" <+> ppr res)) $
res
- --)
-- Calculate transitive closures from a set of roots given an adjacency list
simple_transitive_closure :: Eq a => [(a,[a])] -> [a] -> [a]
let (path, basename, ext) = splitFilename3 file
- Just (mod, location)
- <- mkHomeModuleLocn mod_name (path ++ '/':basename) file
+ (mod, location)
+ <- mkHomeModuleLocn mod_name (path ++ '/':basename) (Just file)
src_timestamp
<- case ml_hs_file location of
summarise :: Module -> ModuleLocation -> Maybe ModSummary
-> IO (Maybe ModSummary)
summarise mod location old_summary
- | isHomeModule mod
+ | not (isHomeModule mod) = return Nothing
+ | otherwise
= do let hs_fn = unJust "summarise" (ml_hs_file location)
- src_timestamp
- <- case ml_hs_file location of
- Nothing -> noHsFileErr mod
- Just src_fn -> getModificationTime src_fn
+ case ml_hs_file location of {
+ Nothing -> do {
+ dflags <- getDynFlags;
+ when (verbosity dflags >= 1) $
+ hPutStrLn stderr ("WARNING: module `" ++
+ moduleUserString mod ++ "' has no source file.");
+ return Nothing;
+ };
+
+ Just src_fn -> do
+
+ src_timestamp <- getModificationTime src_fn
-- return the cached summary if the source didn't change
case old_summary of {
return (Just (ModSummary mod location{ml_hspp_file=Just hspp_fn}
srcimps imps src_timestamp))
}
+ }
- | otherwise = return Nothing
noHsFileErr mod
- = panic (showSDoc (text "no source file for module" <+> quotes (ppr mod)))
+ = throwDyn (CmdLineError (showSDoc (text "no source file for module" <+> quotes (ppr mod))))
packageModErr mod
= throwDyn (CmdLineError (showSDoc (text "module" <+>
projects / ghc-hetmet.git / blobdiff