* Move along the source-changed checkery.
* Make the driver put object files in the right place when using CM.
* Don't do hscNoRecomp in one-shot mode.
#ifndef GHCI
linkObjs = panic "CmLink.linkObjs: no interpreter"
+unload = panic "CmLink.unload: no interpreter"
#else
linkObjs [] pls = linkFinish pls [] []
linkObjs (l@(LM _ uls) : ls) pls
\end{code}
\begin{code}
-data GhciMode = Batch | Interactive
+data GhciMode = Batch | Interactive | OneShot
+ deriving Eq
type PackageConfigInfo = [Package]
module CmTypes (
Unlinked(..), isObject, nameOfObject, isInterpretable,
Linkable(..),
- ModSummary(..), name_of_summary
+ ModSummary(..), name_of_summary, pprSummaryTimes
) where
import Interpreter
import CmStaticInfo
import Outputable
+import Time ( ClockTime )
+
+
data Unlinked
= DotO FilePath
| DotA FilePath
data ModSummary
= ModSummary {
ms_mod :: Module, -- name, package
- ms_location :: ModuleLocation, -- location
+ ms_location :: ModuleLocation, -- location
ms_srcimps :: [ModuleName], -- source imports
- ms_imps :: [ModuleName] -- non-source imports
- --ms_date :: Maybe ClockTime -- timestamp of summarised
- -- file, if home && source
+ ms_imps :: [ModuleName], -- non-source imports
+ ms_hs_date :: Maybe ClockTime, -- timestamp of summarised
+ -- file, if home && source
+ ms_hi_date :: Maybe ClockTime -- timestamp of old iface,
+ -- if home && source
}
instance Outputable ModSummary where
ppr ms
- = sep [--text "ModSummary { ms_date = " <> text (show ms_date),
- text "ModSummary {",
- nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
+ = sep [text "ModSummary {",
+ nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
+ text "ms_hi_date = " <> text (show (ms_hi_date ms)),
+ text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
text "ms_imps =" <+> ppr (ms_imps ms),
text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
char '}'
]
+pprSummaryTimes ms
+ = sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
+ text "ms_hi_date = " <> text (show (ms_hi_date ms))]
+
name_of_summary :: ModSummary -> ModuleName
name_of_summary = moduleName . ms_mod
\end{code}
import Exception ( throwDyn )
import IO
+import Time ( ClockTime )
+import Directory ( getModificationTime )
+
\end{code}
let pcii = pci pcms1 -- this never changes
let ghci_mode = gmode pcms1 -- ToDo: fix!
+ -- During upsweep, look at new summaries to see if source has
+ -- changed. Here's a function to pass down; it takes a new
+ -- summary.
+ let source_changed :: ModSummary -> Bool
+ source_changed = summary_indicates_source_changed mg1
+
-- Do the downsweep to reestablish the module graph
-- then generate version 2's by removing from HIT,HST,UI any
-- modules in the old MG which are not in the new one.
let threaded2 = CmThreaded pcs1 hst2 hit2
(upsweep_complete_success, threaded3, modsDone, newLis)
- <- upsweep_mods ui2 threaded2 mg2
+ <- upsweep_mods ghci_mode ui2 source_changed threaded2 mg2
let ui3 = add_to_ui ui2 newLis
let (CmThreaded pcs3 hst3 hit3) = threaded3
else Just (last mods_to_keep_names))
+-- Given a bunch of old summaries and a new summary, try and
+-- find the corresponding old summary, and, if found, compare
+-- its source timestamp with that of the new summary. If in
+-- doubt say True.
+summary_indicates_source_changed :: [ModSummary] -> ModSummary -> Bool
+summary_indicates_source_changed old_summaries new_summary
+ = case [old | old <- old_summaries,
+ name_of_summary old == name_of_summary new_summary] of
+
+ (_:_:_) -> panic "summary_indicates_newer_source"
+
+ [] -> -- can't find a corresponding old summary, so
+ -- compare source and iface dates in the new summary.
+ trace (showSDoc (text "SISC: no old summary, new ="
+ <+> pprSummaryTimes new_summary)) (
+ case (ms_hs_date new_summary, ms_hi_date new_summary) of
+ (Just hs_t, Just hi_t) -> hs_t > hi_t
+ other -> True
+ )
+
+ [old] -> -- found old summary; compare source timestamps
+ trace (showSDoc (text "SISC: old ="
+ <+> pprSummaryTimes old
+ <+> pprSummaryTimes new_summary)) (
+ case (ms_hs_date old, ms_hs_date new_summary) of
+ (Just old_t, Just new_t) -> new_t > old_t
+ other -> True
+ )
+
-- Return (names of) all those in modsDone who are part of a cycle
-- as defined by theGraph.
findPartiallyCompletedCycles :: [ModuleName] -> [SCC ModSummary] -> [ModuleName]
else chewed_rest
+-- Does this ModDetails export Main.main?
exports_main :: ModDetails -> Bool
exports_main md
= maybeToBool (lookupNameEnv (md_types md) mainName)
-- Compile multiple modules, stopping as soon as an error appears.
-- There better had not be any cyclic groups here -- we check for them.
-upsweep_mods :: UnlinkedImage -- old linkables
+upsweep_mods :: GhciMode
+ -> UnlinkedImage -- old linkables
+ -> (ModSummary -> Bool) -- has source changed?
-> CmThreaded -- PCS & HST & HIT
-> [SCC ModSummary] -- mods to do (the worklist)
-- ...... RETURNING ......
[ModSummary], -- mods which succeeded
[Linkable]) -- new linkables
-upsweep_mods oldUI threaded []
+upsweep_mods ghci_mode oldUI source_changed threaded []
= return (True, threaded, [], [])
-upsweep_mods oldUI threaded ((CyclicSCC ms):_)
+upsweep_mods ghci_mode oldUI source_changed threaded ((CyclicSCC ms):_)
= do hPutStrLn stderr ("ghc: module imports form a cycle for modules:\n\t" ++
unwords (map (moduleNameUserString.name_of_summary) ms))
return (False, threaded, [], [])
-upsweep_mods oldUI threaded ((AcyclicSCC mod):mods)
- = do (threaded1, maybe_linkable) <- upsweep_mod oldUI threaded mod
+upsweep_mods ghci_mode oldUI source_changed threaded ((AcyclicSCC mod):mods)
+ = do (threaded1, maybe_linkable)
+ <- upsweep_mod ghci_mode oldUI threaded mod (source_changed mod)
case maybe_linkable of
Just linkable
-> -- No errors; do the rest
do (restOK, threaded2, modOKs, linkables)
- <- upsweep_mods oldUI threaded1 mods
+ <- upsweep_mods ghci_mode oldUI source_changed threaded1 mods
return (restOK, threaded2, mod:modOKs, linkable:linkables)
Nothing -- we got a compilation error; give up now
-> return (False, threaded1, [], [])
-- Compile a single module. Always produce a Linkable for it if
-- successful. If no compilation happened, return the old Linkable.
-upsweep_mod :: UnlinkedImage
+upsweep_mod :: GhciMode
+ -> UnlinkedImage
-> CmThreaded
-> ModSummary
+ -> Bool
-> IO (CmThreaded, Maybe Linkable)
-upsweep_mod oldUI threaded1 summary1
+upsweep_mod ghci_mode oldUI threaded1 summary1 source_might_have_changed
= do let mod_name = name_of_summary summary1
let (CmThreaded pcs1 hst1 hit1) = threaded1
let old_iface = lookupUFM hit1 (name_of_summary summary1)
- compresult <- compile summary1 old_iface hst1 hit1 pcs1
+ compresult <- compile ghci_mode summary1 (not source_might_have_changed)
+ old_iface hst1 hit1 pcs1
case compresult of
in return (threaded2, Nothing)
+-- Remove unwanted modules from the top level envs (HST, HIT, UI).
removeFromTopLevelEnvs :: [ModuleName]
-> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
-> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
else loop (newHomeSummaries ++ homeSummaries)
+-- Summarise a module, and pick and source and interface timestamps.
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
| isModuleInThisPackage mod
modsrc <- readFile hspp_fn
let (srcimps,imps) = getImports modsrc
--- maybe_timestamp
--- <- case ml_hs_file location of
--- Nothing -> return Nothing
--- Just src_fn -> getModificationTime src_fn >>= Just
+ maybe_src_timestamp
+ <- case ml_hs_file location of
+ Nothing -> return Nothing
+ Just src_fn -> maybe_getModificationTime src_fn
+ maybe_iface_timestamp
+ <- case ml_hi_file location of
+ Nothing -> return Nothing
+ Just if_fn -> maybe_getModificationTime if_fn
return (ModSummary mod location{ml_hspp_file=Just hspp_fn}
srcimps imps
- {-maybe_timestamp-} )
+ maybe_src_timestamp maybe_iface_timestamp)
| otherwise
- = return (ModSummary mod location [] [])
+ = return (ModSummary mod location [] [] Nothing Nothing)
+
+ where
+ maybe_getModificationTime :: FilePath -> IO (Maybe ClockTime)
+ maybe_getModificationTime fn
+ = (do time <- getModificationTime fn
+ return (Just time))
+ `catch`
+ (\err -> return Nothing)
\end{code}
-----------------------------------------------------------------------------
--- $Id: DriverPhases.hs,v 1.2 2000/11/13 14:34:37 sewardj Exp $
+-- $Id: DriverPhases.hs,v 1.3 2000/11/16 16:23:04 sewardj Exp $
--
-- GHC Driver
--
| SplitAs
| As
| Ln
- deriving (Eq)
+ deriving (Eq, Show)
-- the first compilation phase for a given file is determined
-- by its suffix.
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.27 2000/11/16 15:57:05 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.28 2000/11/16 16:23:04 sewardj Exp $
--
-- GHC Driver
--
#include "HsVersions.h"
+import CmStaticInfo ( GhciMode(..) )
import CmTypes
import GetImports
import DriverState
data IntermediateFileType
= Temporary
| Persistent
- deriving (Eq)
+ deriving (Eq, Show)
genPipeline
:: GhcMode -- when to stop
-- run the compiler!
pcs <- initPersistentCompilerState
- result <- hscMain dyn_flags{ hscOutName = output_fn }
+ result <- hscMain OneShot
+ dyn_flags{ hscOutName = output_fn }
source_unchanged
location
Nothing -- no iface
-- As phase
run_phase As _basename _suff input_fn output_fn
- = do as <- readIORef v_Pgm_a
+ = do as <- readIORef v_Pgm_a
as_opts <- getOpts opt_a
cmdline_include_paths <- readIORef v_Include_paths
-- the .hs file if necessary, and compiling up the .stub_c files to
-- generate Linkables.
-compile :: ModSummary -- summary, including source
+-- NB. No old interface can also mean that the source has changed.
+
+compile :: GhciMode -- distinguish batch from interactive
+ -> ModSummary -- summary, including source
+ -> Bool -- source unchanged?
-> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> HomeIfaceTable -- for home module Ifaces
| CompErrs PersistentCompilerState -- updated PCS
-compile summary old_iface hst hit pcs = do
+compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
verb <- readIORef v_Verbose
when verb (hPutStrLn stderr
(showSDoc (text "compile: compiling"
HscInterpreted -> return (error "no output file")
-- run the compiler
- hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
- False -- (panic "compile:source_unchanged")
+ hsc_result <- hscMain ghci_mode dyn_flags{ hscOutName = output_fn }
+ source_unchanged
location old_iface hst hit pcs
case hsc_result of {
-- we're in batch mode: finish the compilation pipeline.
_other -> do pipe <- genPipeline (StopBefore Ln) "" True
hsc_lang output_fn
- o_file <- runPipeline pipe output_fn False False
+ -- runPipeline takes input_fn so it can split off
+ -- the base name and use it as the base of
+ -- the output object file.
+ let (basename, suffix) = splitFilename input_fn
+ o_file <- pipeLoop pipe output_fn False False basename suffix
return [ DotO o_file ]
let linkable = LM (moduleName (ms_mod summary))
import Bag ( emptyBag )
import Outputable
import Interpreter ( UnlinkedIBind, ItblEnv, stgToInterpSyn )
+import CmStaticInfo ( GhciMode(..) )
import HscStats ( ppSourceStats )
import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..),
PersistentRenamerState(..), ModuleLocation(..),
-- (parse/rename/typecheck) print messages themselves
hscMain
- :: DynFlags
+ :: GhciMode
+ -> DynFlags
-> Bool -- source unchanged?
-> ModuleLocation -- location info
-> Maybe ModIface -- old interface, if available
-> PersistentCompilerState -- IN: persistent compiler state
-> IO HscResult
-hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
+hscMain ghci_mode dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
putStrLn ("CHECKING OLD IFACE for hs = " ++ show (ml_hs_file location)
++ ", hspp = " ++ show (ml_hspp_file location));
what_next | recomp_reqd || no_old_iface = hscRecomp
| otherwise = hscNoRecomp
;
- what_next dflags location maybe_checked_iface
+ what_next ghci_mode dflags location maybe_checked_iface
hst hit pcs_ch
}}
-hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
+-- we definitely expect to have the old interface available
+hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
+ | ghci_mode == OneShot
+ = return (HscOK
+ (panic "hscNoRecomp:OneShot") -- no details
+ Nothing -- makes run_phase Hsc stop
+ Nothing Nothing -- foreign export stuff
+ Nothing -- ibinds
+ pcs_ch)
+ | otherwise
= do {
hPutStrLn stderr "COMPILATION NOT REQUIRED";
- -- we definitely expect to have the old interface available
- let old_iface = case maybe_checked_iface of
- Just old_if -> old_if
- Nothing -> panic "hscNoRecomp:old_iface"
+ let this_mod = mi_module old_iface
;
-- CLOSURE
(pcs_cl, closure_errs, cl_hs_decls)
}}}}
-hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
+hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
= do {
; hPutStrLn stderr "COMPILATION IS REQUIRED";
<- renameModule dflags hit hst pcs_ch this_mod rdr_module
; case maybe_rn_result of {
Nothing -> return (HscFail pcs_rn);
- Just (print_unqualified, is_exported, new_iface, rn_hs_decls) -> do {
+ Just (print_unqualified, (is_exported, new_iface, rn_hs_decls)) -> do {
-------------------
-- TYPECHECK
projects / ghc-hetmet.git / commitdiff