#else
import HscMain ( initPersistentCompilerState )
#endif
-import HscTypes
+import HscTypes hiding ( moduleNameToModule )
import Name ( Name, NamedThing(..), nameRdrName, nameModule,
isHomePackageName, isExternalName )
import NameEnv
import Outputable
import Panic
import CmdLineOpts ( DynFlags(..), getDynFlags )
+import Maybes ( expectJust )
import IOExts
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
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;
import Config
import Panic
import Util
+import Maybes ( expectJust )
import ParserCoreUtils ( getCoreModuleName )
-- 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 ))
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))
import DriverState ( v_HCHeader )
import DriverPhases ( isExtCore_file )
import ErrUtils ( dumpIfSet_dyn, showPass, printError )
-import Util ( unJust )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( consBag, emptyBag )
import NameEnv ( emptyNameEnv, mkNameEnv )
import Module ( Module )
import FastString
+import Maybes ( expectJust )
+import Util ( seqList )
import IOExts ( newIORef, readIORef, writeIORef,
unsafePerformIO )
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
-------------------
-- foreign_stuff
-- ds_details
-- new_iface
+ -- imported_modules
-------------------
-- SIMPLIFY
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
; 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
-------------------
-- 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 {
-- 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 {
HomeSymbolTable, emptySymbolTable,
PackageTypeEnv,
HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
- lookupIface, lookupIfaceByModName,
+ lookupIface, lookupIfaceByModName, moduleNameToModule,
emptyModIface,
InteractiveContext(..),
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}
%************************************************************************
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
-- 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
--
#ifdef GHCI
-import InteractiveUI(ghciWelcomeMsg, interactiveUI)
+import InteractiveUI
#endif
= 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
-- for-loop
nTimes,
- -- maybe-ish
- unJust,
-
-- 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}
%* *
%************************************************************************
projects / ghc-hetmet.git / commitdiff