From dd9e16729a737dd6dcc44b0ae3c10ba4b2b69b0c Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 1 May 2002 09:30:06 +0000 Subject: [PATCH] [project @ 2002-05-01 09:30:04 by simonmar] - When converting ModuleNames to Modules for use in the the module initialisation code, look them up in the IfaceTable(s) instead of calling findModule again. They are guaranteed to be in either the HomeIfaceTable or the PackageIfaceTable after the renamer, so this saves some trips to the filesystem. Also, move this code earlier in the compilation cycle to avoid holding on to the renamed syntax for too long (not sure if this makes a difference or not, but it definitely looked space-leakish before). - remove Util.unJust, it is a duplicate of Maybes.expectJust --- ghc/compiler/compMan/CompManager.lhs | 7 ++++--- ghc/compiler/main/DriverPipeline.hs | 7 ++++--- ghc/compiler/main/HscMain.lhs | 33 +++++++++++++++++++-------------- ghc/compiler/main/HscTypes.lhs | 19 ++++++++++++++----- ghc/compiler/main/Main.hs | 6 +++--- ghc/compiler/utils/Util.lhs | 15 --------------- 6 files changed, 44 insertions(+), 43 deletions(-) diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index b3f6baf..16b3fe6 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -73,7 +73,7 @@ import HscMain ( initPersistentCompilerState, hscThing, #else import HscMain ( initPersistentCompilerState ) #endif -import HscTypes +import HscTypes hiding ( moduleNameToModule ) import Name ( Name, NamedThing(..), nameRdrName, nameModule, isHomePackageName, isExternalName ) import NameEnv @@ -90,6 +90,7 @@ import Util import Outputable import Panic import CmdLineOpts ( DynFlags(..), getDynFlags ) +import Maybes ( expectJust ) import IOExts @@ -1037,7 +1038,7 @@ upsweep_mod ghci_mode dflags oldUI threaded1 summary1 reachable_inc_me retainInTopLevelEnvs reachable_only (hst1,hit1,[]) old_linkable - = unJust "upsweep_mod:old_linkable" maybe_old_linkable + = expectJust "upsweep_mod:old_linkable" maybe_old_linkable have_object | Just l <- maybe_old_linkable, isObjectLinkable l = True @@ -1244,7 +1245,7 @@ summarise :: Module -> ModuleLocation -> Maybe ModSummary summarise mod location old_summary | not (isHomeModule mod) = return Nothing | otherwise - = do let hs_fn = unJust "summarise" (ml_hs_file location) + = do let hs_fn = expectJust "summarise" (ml_hs_file location) case ml_hs_file location of { Nothing -> noHsFileErr mod; diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 8ceebd5..b567817 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -44,6 +44,7 @@ import CmdLineOpts import Config import Panic import Util +import Maybes ( expectJust ) import ParserCoreUtils ( getCoreModuleName ) @@ -551,7 +552,7 @@ run_phase Hsc basename suff input_fn output_fn -- THIS COMPILATION, then use that to determine if the -- source is unchanged. | Just x <- expl_o_file, todo == StopBefore Ln = x - | otherwise = unJust "source_unchanged" (ml_obj_file location) + | otherwise = expectJust "source_unchanged" (ml_obj_file location) source_unchanged <- if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln )) @@ -1071,8 +1072,8 @@ compile ghci_mode summary source_unchanged have_object let verb = verbosity dyn_flags let location = ms_location summary - let input_fn = unJust "compile:hs" (ml_hs_file location) - let input_fnpp = unJust "compile:hspp" (ml_hspp_file location) + let input_fn = expectJust "compile:hs" (ml_hs_file location) + let input_fnpp = expectJust "compile:hspp" (ml_hspp_file location) when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp)) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 1f7a1e9..5d6f457 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -73,7 +73,6 @@ import CmdLineOpts import DriverState ( v_HCHeader ) import DriverPhases ( isExtCore_file ) import ErrUtils ( dumpIfSet_dyn, showPass, printError ) -import Util ( unJust ) import UniqSupply ( mkSplitUniqSupply ) import Bag ( consBag, emptyBag ) @@ -86,6 +85,8 @@ import Name ( Name, nameModule, nameOccName, getName ) import NameEnv ( emptyNameEnv, mkNameEnv ) import Module ( Module ) import FastString +import Maybes ( expectJust ) +import Util ( seqList ) import IOExts ( newIORef, readIORef, writeIORef, unsafePerformIO ) @@ -224,6 +225,20 @@ hscRecomp ghci_mode dflags have_object Right (this_mod, rdr_module, dont_discard, new_iface, pcs_tc, ds_details, foreign_stuff) -> do { + + let { + imported_module_names = + filter (/= gHC_PRIM_Name) $ + map ideclName (hsModuleImports rdr_module); + + imported_modules = + map (moduleNameToModule hit (pcs_PIT pcs_tc)) + imported_module_names; + } + + -- force this out now, so we don't keep a hold of rdr_module or pcs_tc + ; seqList imported_modules `seq` return () + ------------------- -- FLATTENING ------------------- @@ -251,6 +266,7 @@ hscRecomp ghci_mode dflags have_object -- foreign_stuff -- ds_details -- new_iface + -- imported_modules ------------------- -- SIMPLIFY @@ -305,15 +321,6 @@ hscRecomp ghci_mode dflags have_object local_tycons = typeEnvTyCons env_tc local_classes = typeEnvClasses env_tc - imported_module_names = - filter (/= gHC_PRIM_Name) $ - map ideclName (hsModuleImports rdr_module) - -- eek! doesn't this keep rdr_module live until code generation? - -- SDM 3/2002 - - mod_name_to_Module nm - = do m <- findModule nm ; return (fst (fromJust m)) - (h_code, c_code, headers, fe_binders) = foreign_stuff -- turn the list of headers requested in foreign import @@ -332,8 +339,6 @@ hscRecomp ghci_mode dflags have_object ; fhdrs <- readIORef v_HCHeader ; writeIORef v_HCHeader (fhdrs ++ foreign_headers) - ; imported_modules <- mapM mod_name_to_Module imported_module_names - ; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface ) <- if toInterp #ifdef GHCI @@ -403,7 +408,7 @@ hscCoreFrontEnd ghci_mode dflags location hst hit pcs_ch = do { ------------------- -- PARSE ------------------- - ; inp <- readFile (unJust "hscCoreFrontEnd:hspp" (ml_hspp_file location)) + ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location)) ; case parseCore inp 1 of FailP s -> hPutStrLn stderr s >> return (Left (HscFail pcs_ch)); OkP rdr_module -> do { @@ -442,7 +447,7 @@ hscFrontEnd ghci_mode dflags location hst hit pcs_ch = do { -- PARSE ------------------- ; maybe_parsed <- myParseModule dflags - (unJust "hscRecomp:hspp" (ml_hspp_file location)) + (expectJust "hscRecomp:hspp" (ml_hspp_file location)) ; case maybe_parsed of { Nothing -> return (Left (HscFail pcs_ch)); Just rdr_module -> do { diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index 1800e84..046f44a 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -13,7 +13,7 @@ module HscTypes ( HomeSymbolTable, emptySymbolTable, PackageTypeEnv, HomeIfaceTable, PackageIfaceTable, emptyIfaceTable, - lookupIface, lookupIfaceByModName, + lookupIface, lookupIfaceByModName, moduleNameToModule, emptyModIface, InteractiveContext(..), @@ -80,11 +80,12 @@ import CoreSyn ( IdCoreRule ) import FiniteMap import Bag ( Bag ) -import Maybes ( seqMaybe, orElse ) +import Maybes ( seqMaybe, orElse, expectJust ) import Outputable import SrcLoc ( SrcLoc, isGoodSrcLoc ) -import Util ( thenCmp, sortLt, unJust ) +import Util ( thenCmp, sortLt ) import UniqSupply ( UniqSupply ) +import Maybe ( fromJust ) \end{code} %************************************************************************ @@ -123,9 +124,9 @@ instance Outputable ModuleLocation where showModMsg :: Bool -> Module -> ModuleLocation -> String showModMsg use_object mod location = mod_str ++ replicate (max 0 (16 - length mod_str)) ' ' - ++" ( " ++ unJust "showModMsg" (ml_hs_file location) ++ ", " + ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", " ++ (if use_object - then unJust "showModMsg" (ml_obj_file location) + then expectJust "showModMsg" (ml_obj_file location) else "interpreted") ++ " )" where mod_str = moduleUserString mod @@ -295,6 +296,14 @@ lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> May -- We often have two IfaceTables, and want to do a lookup lookupIfaceByModName hit pit mod = lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod + +-- Use instead of Finder.findModule if possible: this way doesn't +-- require filesystem operations, and it is guaranteed not to fail +-- when the IfaceTables are properly populated (i.e. after the renamer). +moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName + -> Module +moduleNameToModule hit pit mod + = mi_module (fromJust (lookupIfaceByModName hit pit mod)) \end{code} diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index 03ab8a5..e53ec3f 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,7 +1,7 @@ {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.104 2002/04/05 23:24:29 sof Exp $ +-- $Id: Main.hs,v 1.105 2002/05/01 09:30:05 simonmar Exp $ -- -- GHC Driver program -- @@ -18,7 +18,7 @@ module Main (main) where #ifdef GHCI -import InteractiveUI(ghciWelcomeMsg, interactiveUI) +import InteractiveUI #endif @@ -328,7 +328,7 @@ beginInteractive fileish_args = do minus_ls <- readIORef v_Cmdline_libraries let (objs, mods) = partition objish_file fileish_args - libs = map Left objs ++ map Right minus_ls + libs = map Object objs ++ map DLL minus_ls state <- cmInit Interactive interactiveUI state mods libs diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs index c3833df..a8d289d 100644 --- a/ghc/compiler/utils/Util.lhs +++ b/ghc/compiler/utils/Util.lhs @@ -28,9 +28,6 @@ module Util ( -- for-loop nTimes, - -- maybe-ish - unJust, - -- sorting IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA) sortLt, @@ -135,18 +132,6 @@ nTimes n f = f . nTimes (n-1) f %************************************************************************ %* * -\subsection{Maybe-ery} -%* * -%************************************************************************ - -\begin{code} -unJust :: String -> Maybe a -> a -unJust who (Just x) = x -unJust who Nothing = panic ("unJust of Nothing, called by " ++ who) -\end{code} - -%************************************************************************ -%* * \subsection[Utils-lists]{General list processing} %* * %************************************************************************ -- 1.7.10.4