Commit c7955cf7 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-11-20 11:39:57 by sewardj]

* (CompManager) recompile if in interactive mode and no old linkable exists
* (HscMain) don't write interface files in interactive mode
* (everywhere) switch arg order to unJust for PAP purposes
parent 7897eb8d
......@@ -6,7 +6,7 @@
\begin{code}
module CmLink ( Linkable(..), Unlinked(..),
filterModuleLinkables,
findModuleLinkable,
findModuleLinkable_maybe,
modname_of_linkable, is_package_linkable,
LinkResult(..),
link,
......@@ -62,11 +62,12 @@ data LinkResult
= LinkOK PersistentLinkerState
| LinkErrs PersistentLinkerState [SDoc]
findModuleLinkable :: [Linkable] -> ModuleName -> Linkable
findModuleLinkable lis mod
findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
findModuleLinkable_maybe lis mod
= case [LM nm us | LM nm us <- lis, nm == mod] of
[li] -> li
other -> pprPanic "findModuleLinkable" (ppr mod)
[] -> Nothing
[li] -> Just li
many -> pprPanic "findModuleLinkable" (ppr mod)
emptyPLS :: IO PersistentLinkerState
......
......@@ -50,7 +50,6 @@ import Directory ( getModificationTime, doesFileExist )
import IO
import List ( nub )
import Maybe ( catMaybes, fromMaybe, isJust )
import PrelGHC ( unsafeCoerce# )
\end{code}
......@@ -256,7 +255,8 @@ cmLoadModule cmstate1 rootname
-- we could get the relevant linkables by filtering newLis, but
-- it seems easier to drag them out of the updated, cleaned-up UI
let linkables_to_link
= map (findModuleLinkable ui4) mods_to_keep_names
= map (unJust "linkables_to_link" . findModuleLinkable_maybe ui4)
mods_to_keep_names
linkresult <- link ghci_mode False linkables_to_link pls1
case linkresult of
......@@ -365,15 +365,18 @@ upsweep_mods :: GhciMode
[ModSummary], -- mods which succeeded
[Linkable]) -- new linkables
upsweep_mods ghci_mode oldUI reachable_from source_changed threaded []
upsweep_mods ghci_mode oldUI reachable_from source_changed threaded
[]
= return (True, threaded, [], [])
upsweep_mods ghci_mode oldUI reachable_from source_changed threaded ((CyclicSCC ms):_)
upsweep_mods ghci_mode oldUI reachable_from 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 ghci_mode oldUI reachable_from source_changed threaded ((AcyclicSCC mod):mods)
upsweep_mods ghci_mode oldUI reachable_from source_changed threaded
((AcyclicSCC mod):mods)
= do (threaded1, maybe_linkable)
<- upsweep_mod ghci_mode oldUI threaded mod
(reachable_from (name_of_summary mod))
......@@ -382,7 +385,8 @@ upsweep_mods ghci_mode oldUI reachable_from source_changed threaded ((AcyclicSCC
Just linkable
-> -- No errors; do the rest
do (restOK, threaded2, modOKs, linkables)
<- upsweep_mods ghci_mode oldUI reachable_from source_changed threaded1 mods
<- upsweep_mods ghci_mode oldUI reachable_from
source_changed threaded1 mods
return (restOK, threaded2, mod:modOKs, linkable:linkables)
Nothing -- we got a compilation error; give up now
-> return (False, threaded1, [], [])
......@@ -405,15 +409,18 @@ upsweep_mod ghci_mode oldUI threaded1 summary1
let old_iface = lookupUFM hit1 (name_of_summary summary1)
-- We *have* to compile it if we're in batch mode and we can't see
-- a previous linkable for it on disk.
-- a previous linkable for it on disk. Or if we're in interpretive
-- and there's no old linkable in oldUI.
compilation_mandatory
<- if ghci_mode /= Batch then return False
else case ml_obj_file (ms_location summary1) of
Nothing -> do --putStrLn "cmcm: object?!"
return True
Just obj_fn -> do --putStrLn ("cmcm: old obj " ++ obj_fn)
b <- doesFileExist obj_fn
return (not b)
<- case ghci_mode of
Batch -> case ml_obj_file (ms_location summary1) of
Nothing -> return True
Just obj_fn -> do b <- doesFileExist obj_fn
return (not b)
Interactive -> case findModuleLinkable_maybe oldUI mod_name of
Nothing -> return True
Just li -> return False
OneShot -> panic "upsweep_mod:compilation_mandatory"
let compilation_might_be_needed
= source_might_have_changed || compilation_mandatory
......@@ -439,11 +446,13 @@ upsweep_mod ghci_mode oldUI threaded1 summary1
threaded2 = CmThreaded pcs2 hst2 hit2
old_linkable
| ghci_mode == Interactive
= findModuleLinkable oldUI mod_name
= unJust "upsweep_mod(2)"
(findModuleLinkable_maybe oldUI mod_name)
| otherwise
= LM mod_name
[DotO (unJust (ml_obj_file (ms_location summary1))
"upsweep_mod")]
[DotO (unJust "upsweep_mod(1)"
(ml_obj_file (ms_location summary1))
)]
in return (threaded2, Just old_linkable)
-- Compilation really did happen, and succeeded. A new
......@@ -581,7 +590,7 @@ downsweep rootNm
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
| isModuleInThisPackage mod
= do let hs_fn = unJust (ml_hs_file location) "summarise"
= do let hs_fn = unJust "summarise" (ml_hs_file location)
hspp_fn <- preprocess hs_fn
modsrc <- readFile hspp_fn
let (srcimps,imps,mod_name) = getImports modsrc
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.30 2000/11/19 19:40:08 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.31 2000/11/20 11:39:57 sewardj Exp $
--
-- GHC Driver
--
......@@ -778,8 +778,8 @@ compile ghci_mode summary source_unchanged old_iface hst hit pcs = do
writeIORef v_Driver_state init_driver_state
let location = ms_location summary
let input_fn = unJust (ml_hs_file location) "compile:hs"
let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
let input_fn = unJust "compile:hs" (ml_hs_file location)
let input_fnpp = unJust "compile:hspp" (ml_hspp_file location)
when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
......
-----------------------------------------------------------------------------
-- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 sewardj Exp $
-- $Id: GetImports.hs,v 1.3 2000/11/20 11:39:57 sewardj Exp $
--
-- GHC Driver program
--
......@@ -18,7 +18,7 @@ getImports s
= f [{-accum source imports-}] [{-accum normal imports-}]
(mkModuleName "Main") (words (clean s))
where
f si ni _ ("module" : me : ws) = f si ni (mkModuleName me) ws
f si ni _ ("module" : me : ws) = f si ni (mkMN me) ws
f si ni me ("foreign" : "import" : ws) = f si ni me ws
f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
......
......@@ -103,7 +103,7 @@ hscMain ghci_mode dflags source_unchanged location maybe_old_iface hst hit pcs
(pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs
(unJust (ml_hi_file location) "hscMain")
(unJust "hscMain" (ml_hi_file location))
source_unchanged maybe_old_iface;
if errs_found then
......@@ -172,8 +172,8 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
-------------------
-- PARSE
-------------------
; maybe_parsed <- myParseModule dflags (unJust (ml_hspp_file location)
"hscRecomp:hspp")
; maybe_parsed <- myParseModule dflags
(unJust "hscRecomp:hspp" (ml_hspp_file location))
; case maybe_parsed of {
Nothing -> return (HscFail pcs_ch);
Just rdr_module -> do {
......@@ -223,8 +223,8 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
-------------------
; let new_details = mkModDetails env_tc local_insts tidy_binds
top_level_ids orphan_rules
; final_iface <- mkFinalIface dflags location maybe_checked_iface
new_iface new_details
; final_iface <- mkFinalIface ghci_mode dflags location
maybe_checked_iface new_iface new_details
-------------------
-- COMPLETE CODE GENERATION
......@@ -243,7 +243,7 @@ hscRecomp ghci_mode dflags location maybe_checked_iface hst hit pcs_ch
mkFinalIface dflags location maybe_old_iface new_iface new_details
mkFinalIface ghci_mode dflags location maybe_old_iface new_iface new_details
= case completeIface maybe_old_iface new_iface new_details of
(new_iface, Nothing) -- no change in the interfacfe
-> do when (dopt Opt_D_dump_hi_diffs dflags)
......@@ -252,10 +252,14 @@ mkFinalIface dflags location maybe_old_iface new_iface new_details
"UNCHANGED FINAL INTERFACE" (pprIface new_iface)
return new_iface
(new_iface, Just sdoc_diffs)
-> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED" sdoc_diffs
dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE" (pprIface new_iface)
-> do dumpIfSet_dyn dflags Opt_D_dump_hi_diffs "INTERFACE HAS CHANGED"
sdoc_diffs
dumpIfSet_dyn dflags Opt_D_dump_hi "NEW FINAL INTERFACE"
(pprIface new_iface)
-- Write the interface file
writeIface (unJust (ml_hi_file location) "hscRecomp:hi") new_iface
when (ghci_mode /= Interactive)
(writeIface (unJust "hscRecomp:hi" (ml_hi_file location))
new_iface)
return new_iface
......
......@@ -138,9 +138,9 @@ nTimes n f = f . nTimes (n-1) f
%************************************************************************
\begin{code}
unJust :: Maybe a -> String -> a
unJust (Just x) who = x
unJust Nothing who = panic ("unJust of Nothing, called by " ++ who)
unJust :: String -> Maybe a -> a
unJust who (Just x) = x
unJust who Nothing = panic ("unJust of Nothing, called by " ++ who)
\end{code}
%************************************************************************
......
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