Commit dd9e1672 authored by simonmar's avatar simonmar
Browse files

[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
parent 1b853dc9
......@@ -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;
......
......@@ -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))
......
......@@ -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 {
......
......@@ -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}
......
{-# 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
......
......@@ -28,9 +28,6 @@ module Util (
-- for-loop
nTimes,
-- maybe-ish
unJust,
-- sorting
IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
sortLt,
......@@ -133,18 +130,6 @@ nTimes 1 f = f
nTimes n f = f . nTimes (n-1) f
\end{code}
%************************************************************************
%* *
\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}
......
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