Commit 2829e3a6 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-11-16 16:23:03 by sewardj]

* 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.
parent f212eb91
......@@ -149,6 +149,7 @@ filterModuleLinkables p (li:lis)
#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
......
......@@ -12,7 +12,8 @@ where
\end{code}
\begin{code}
data GhciMode = Batch | Interactive
data GhciMode = Batch | Interactive | OneShot
deriving Eq
type PackageConfigInfo = [Package]
......
......@@ -7,7 +7,7 @@
module CmTypes (
Unlinked(..), isObject, nameOfObject, isInterpretable,
Linkable(..),
ModSummary(..), name_of_summary
ModSummary(..), name_of_summary, pprSummaryTimes
) where
import Interpreter
......@@ -16,6 +16,9 @@ import Module
import CmStaticInfo
import Outputable
import Time ( ClockTime )
data Unlinked
= DotO FilePath
| DotA FilePath
......@@ -58,23 +61,30 @@ instance Outputable Linkable where
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}
......@@ -45,6 +45,9 @@ import Panic ( panic )
import Exception ( throwDyn )
import IO
import Time ( ClockTime )
import Directory ( getModificationTime )
\end{code}
......@@ -140,6 +143,12 @@ cmLoadModule cmstate1 rootname
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.
......@@ -177,7 +186,7 @@ cmLoadModule cmstate1 rootname
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
......@@ -245,6 +254,35 @@ cmLoadModule cmstate1 rootname
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]
......@@ -266,6 +304,7 @@ findPartiallyCompletedCycles modsDone theGraph
else chewed_rest
-- Does this ModDetails export Main.main?
exports_main :: ModDetails -> Bool
exports_main md
= maybeToBool (lookupNameEnv (md_types md) mainName)
......@@ -294,7 +333,9 @@ data CmThreaded -- stuff threaded through individual module compilations
-- 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 ......
......@@ -303,21 +344,22 @@ upsweep_mods :: UnlinkedImage -- old linkables
[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, [], [])
......@@ -325,16 +367,19 @@ upsweep_mods oldUI threaded ((AcyclicSCC mod):mods)
-- 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
......@@ -363,6 +408,7 @@ upsweep_mod oldUI threaded1 summary1
in return (threaded2, Nothing)
-- Remove unwanted modules from the top level envs (HST, HIT, UI).
removeFromTopLevelEnvs :: [ModuleName]
-> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
-> (HomeSymbolTable, HomeIfaceTable, UnlinkedImage)
......@@ -434,6 +480,7 @@ downsweep rootNm
else loop (newHomeSummaries ++ homeSummaries)
-- Summarise a module, and pick and source and interface timestamps.
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
| isModuleInThisPackage mod
......@@ -442,14 +489,26 @@ summarise mod location
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
--
......@@ -47,7 +47,7 @@ data Phase
| 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
--
......@@ -22,6 +22,7 @@ module DriverPipeline (
#include "HsVersions.h"
import CmStaticInfo ( GhciMode(..) )
import CmTypes
import GetImports
import DriverState
......@@ -114,7 +115,7 @@ getGhcMode flags
data IntermediateFileType
= Temporary
| Persistent
deriving (Eq)
deriving (Eq, Show)
genPipeline
:: GhcMode -- when to stop
......@@ -452,7 +453,8 @@ run_phase Hsc basename suff input_fn output_fn
-- 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
......@@ -609,7 +611,7 @@ run_phase SplitMangle _basename _suff input_fn _output_fn
-- 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
......@@ -740,7 +742,11 @@ preprocess filename =
-- 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
......@@ -757,7 +763,7 @@ data CompResult
| 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"
......@@ -784,8 +790,8 @@ compile summary old_iface hst hit pcs = do
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 {
......@@ -818,7 +824,11 @@ compile summary old_iface hst hit pcs = do
-- 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))
......
......@@ -46,6 +46,7 @@ import UniqSupply ( mkSplitUniqSupply )
import Bag ( emptyBag )
import Outputable
import Interpreter ( UnlinkedIBind, ItblEnv, stgToInterpSyn )
import CmStaticInfo ( GhciMode(..) )
import HscStats ( ppSourceStats )
import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..),
PersistentRenamerState(..), ModuleLocation(..),
......@@ -82,7 +83,8 @@ data HscResult
-- (parse/rename/typecheck) print messages themselves
hscMain
:: DynFlags
:: GhciMode
-> DynFlags
-> Bool -- source unchanged?
-> ModuleLocation -- location info
-> Maybe ModIface -- old interface, if available
......@@ -91,7 +93,7 @@ hscMain
-> 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));
......@@ -108,18 +110,24 @@ hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
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)
......@@ -150,7 +158,7 @@ hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
}}}}
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";
......@@ -173,7 +181,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
<- 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
......
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