From c7955cf7e34273b5ec624dae0015cec677624c6c Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 20 Nov 2000 11:39:57 +0000 Subject: [PATCH] [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 --- ghc/compiler/compMan/CmLink.lhs | 11 +++++---- ghc/compiler/compMan/CompManager.lhs | 45 ++++++++++++++++++++-------------- ghc/compiler/main/DriverPipeline.hs | 6 ++--- ghc/compiler/main/GetImports.hs | 4 +-- ghc/compiler/main/HscMain.lhs | 22 ++++++++++------- ghc/compiler/utils/Util.lhs | 6 ++--- 6 files changed, 54 insertions(+), 40 deletions(-) diff --git a/ghc/compiler/compMan/CmLink.lhs b/ghc/compiler/compMan/CmLink.lhs index 44f9a89..f478dcc 100644 --- a/ghc/compiler/compMan/CmLink.lhs +++ b/ghc/compiler/compMan/CmLink.lhs @@ -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 diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index ba72c97..15acd2b 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -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 diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index de77887..facd9ca 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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)) diff --git a/ghc/compiler/main/GetImports.hs b/ghc/compiler/main/GetImports.hs index b3a3416..8d4be5e 100644 --- a/ghc/compiler/main/GetImports.hs +++ b/ghc/compiler/main/GetImports.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 74c7a87..6ebecc8 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -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 diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs index 52966b8..78aec40 100644 --- a/ghc/compiler/utils/Util.lhs +++ b/ghc/compiler/utils/Util.lhs @@ -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} %************************************************************************ -- 1.7.10.4