summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
1b853dc)
- 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
#else
import HscMain ( initPersistentCompilerState )
#endif
#else
import HscMain ( initPersistentCompilerState )
#endif
+import HscTypes hiding ( moduleNameToModule )
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName, isExternalName )
import NameEnv
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName, isExternalName )
import NameEnv
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..), getDynFlags )
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..), getDynFlags )
+import Maybes ( expectJust )
retainInTopLevelEnvs reachable_only (hst1,hit1,[])
old_linkable
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
have_object
| Just l <- maybe_old_linkable, isObjectLinkable l = True
summarise mod location old_summary
| not (isHomeModule mod) = return Nothing
| otherwise
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;
case ml_hs_file location of {
Nothing -> noHsFileErr mod;
import Config
import Panic
import Util
import Config
import Panic
import Util
+import Maybes ( expectJust )
import ParserCoreUtils ( getCoreModuleName )
import ParserCoreUtils ( getCoreModuleName )
-- THIS COMPILATION, then use that to determine if the
-- source is unchanged.
| Just x <- expl_o_file, todo == StopBefore Ln = x
-- 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 ))
source_unchanged <-
if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
let verb = verbosity dyn_flags
let location = ms_location summary
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))
when (verb >= 2) (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
import DriverState ( v_HCHeader )
import DriverPhases ( isExtCore_file )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
import DriverState ( v_HCHeader )
import DriverPhases ( isExtCore_file )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( consBag, emptyBag )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( consBag, emptyBag )
import NameEnv ( emptyNameEnv, mkNameEnv )
import Module ( Module )
import FastString
import NameEnv ( emptyNameEnv, mkNameEnv )
import Module ( Module )
import FastString
+import Maybes ( expectJust )
+import Util ( seqList )
import IOExts ( newIORef, readIORef, writeIORef,
unsafePerformIO )
import IOExts ( newIORef, readIORef, writeIORef,
unsafePerformIO )
Right (this_mod, rdr_module,
dont_discard, new_iface,
pcs_tc, ds_details, foreign_stuff) -> do {
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
-------------------
-------------------
-- FLATTENING
-------------------
-- foreign_stuff
-- ds_details
-- new_iface
-- foreign_stuff
-- ds_details
-- new_iface
-------------------
-- SIMPLIFY
-------------------
-- SIMPLIFY
local_tycons = typeEnvTyCons env_tc
local_classes = typeEnvClasses env_tc
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
(h_code, c_code, headers, fe_binders) = foreign_stuff
-- turn the list of headers requested in foreign import
; fhdrs <- readIORef v_HCHeader
; writeIORef v_HCHeader (fhdrs ++ foreign_headers)
; 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
; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
<- if toInterp
#ifdef GHCI
-------------------
-- PARSE
-------------------
-------------------
-- 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 {
; case parseCore inp 1 of
FailP s -> hPutStrLn stderr s >> return (Left (HscFail pcs_ch));
OkP rdr_module -> do {
-- PARSE
-------------------
; maybe_parsed <- myParseModule dflags
-- 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 {
; case maybe_parsed of {
Nothing -> return (Left (HscFail pcs_ch));
Just rdr_module -> do {
HomeSymbolTable, emptySymbolTable,
PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
HomeSymbolTable, emptySymbolTable,
PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
- lookupIface, lookupIfaceByModName,
+ lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
InteractiveContext(..),
emptyModIface,
InteractiveContext(..),
import FiniteMap
import Bag ( Bag )
import FiniteMap
import Bag ( Bag )
-import Maybes ( seqMaybe, orElse )
+import Maybes ( seqMaybe, orElse, expectJust )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
import Outputable
import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import Util ( thenCmp, sortLt, unJust )
+import Util ( thenCmp, sortLt )
import UniqSupply ( UniqSupply )
import UniqSupply ( UniqSupply )
+import Maybe ( fromJust )
\end{code}
%************************************************************************
\end{code}
%************************************************************************
showModMsg :: Bool -> Module -> ModuleLocation -> String
showModMsg use_object mod location =
mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
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) ++ ", "
- then unJust "showModMsg" (ml_obj_file location)
+ then expectJust "showModMsg" (ml_obj_file location)
else "interpreted")
++ " )"
where mod_str = moduleUserString mod
else "interpreted")
++ " )"
where mod_str = moduleUserString mod
-- We often have two IfaceTables, and want to do a lookup
lookupIfaceByModName hit pit mod
= lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
-- 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))
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
{-# 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
--
--
-- GHC Driver program
--
-import InteractiveUI(ghciWelcomeMsg, interactiveUI)
= do minus_ls <- readIORef v_Cmdline_libraries
let (objs, mods) = partition objish_file 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
state <- cmInit Interactive
interactiveUI state mods libs
- -- maybe-ish
- unJust,
-
-- sorting
IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
sortLt,
-- sorting
IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
sortLt,
%************************************************************************
%* *
%************************************************************************
%* *
-\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}
%* *
%************************************************************************
\subsection[Utils-lists]{General list processing}
%* *
%************************************************************************