%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CLabel.lhs,v 1.42 2000/11/13 14:40:38 simonmar Exp $
+% $Id: CLabel.lhs,v 1.43 2000/11/20 17:42:00 sewardj Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
import CStrings ( pp_cSEP )
import DataCon ( ConTag )
import Module ( moduleName, moduleNameFS,
- Module, isModuleInThisPackage )
+ Module, isHomeModule )
import Name ( Name, getName, isDllName, isExternallyVisibleName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
DataConLabel n k -> isDllName n
TyConLabel tc -> isDllName (getName tc)
ForeignLabel _ d -> d
- ModuleInitLabel m -> (not opt_Static) && (not (isModuleInThisPackage m))
+ ModuleInitLabel m -> (not opt_Static) && (not (isHomeModule m))
_ -> False
\end{code}
Module, moduleName, packageOfModule,
-- abstract, instance of Eq, Ord, Outputable
, ModuleName
- , isModuleInThisPackage, mkModuleInThisPackage,
, printModulePrefix
, moduleNameString -- :: ModuleName -> EncodedString
, mkPrelModule -- :: UserString -> Module
, mkModule -- :: ModuleName -> PackageName -> Module
, mkHomeModule -- :: ModuleName -> Module
-
--- , mkSrcModule
+ , isHomeModule -- :: Module -> Bool
, mkModuleName -- :: UserString -> ModuleName
, mkModuleNameFS -- :: UserFS -> ModuleName
-- used to be called mkSysModuleFS
mkSysModuleNameFS :: EncodedFS -> ModuleName
mkSysModuleNameFS s = ModuleName s
-
--- Make a module in this package
-mkModuleInThisPackage :: ModuleName -> Module
-mkModuleInThisPackage nm = Module nm ThisPackage
\end{code}
\begin{code}
mkHomeModule :: ModuleName -> Module
mkHomeModule mod_nm = Module mod_nm ThisPackage
+isHomeModule :: Module -> Bool
+isHomeModule (Module nm ThisPackage) = True
+isHomeModule _ = False
+
-- Used temporarily when we first come across Foo.x in an interface
-- file, but before we've opened Foo.hi.
-- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
moduleUserString :: Module -> UserString
moduleUserString (Module mod _) = moduleNameUserString mod
-isModuleInThisPackage :: Module -> Bool
-isModuleInThisPackage (Module nm ThisPackage) = True
-isModuleInThisPackage _ = False
-
packageOfModule :: Module -> Maybe PackageName
packageOfModule (Module nm (AnotherPackage pn)) = Just pn
packageOfModule _ = Nothing
#include "HsVersions.h"
import OccName -- All of it
-import Module ( Module, moduleName, mkVanillaModule, isModuleInThisPackage )
+import Module ( Module, moduleName, mkVanillaModule, isHomeModule )
import RdrName ( RdrName, mkRdrOrig, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( builtinSrcLoc, noSrcLoc, SrcLoc )
-- Does this name refer to something in a different DLL?
isDllName nm = not opt_Static &&
not (isLocalName nm) && -- isLocalName test needed 'cos
- not (isModuleInThisPackage (nameModule nm)) -- nameModule won't work on local names
+ not (isHomeModule (nameModule nm)) -- nameModule won't work on local names
import CmTypes
import HscTypes
import Module ( ModuleName, moduleName,
- isModuleInThisPackage, moduleEnvElts,
+ isHomeModule, moduleEnvElts,
moduleNameUserString )
import CmStaticInfo ( PackageConfigInfo, GhciMode(..) )
import DriverPipeline
-> IO (CmState, Maybe HValue)
cmGetExpr cmstate dflags modname expr
= do (new_pcs, maybe_unlinked_iexpr) <-
- hscExpr dflags hst hit pcs (mkModuleInThisPackage modname) expr
+ hscExpr dflags hst hit pcs (mkHomeModule modname) expr
case maybe_unlinked_iexpr of
Nothing -> return (cmstate{ pcs=new_pcs }, Nothing)
Just uiexpr -> do
case compresult of
- -- Compilation "succeeded", but didn't return a new iface or
+ -- Compilation "succeeded", but didn't return a new
-- linkable, meaning that compilation wasn't needed, and the
-- new details were manufactured from the old iface.
- CompOK details Nothing pcs2
- -> let hst2 = addToUFM hst1 mod_name details
- hit2 = hit1
+ CompOK pcs2 new_details new_iface Nothing
+ -> let hst2 = addToUFM hst1 mod_name new_details
+ hit2 = addToUFM hit1 mod_name new_iface
threaded2 = CmThreaded pcs2 hst2 hit2
in return (threaded2, Just old_linkable)
-- Compilation really did happen, and succeeded. A new
-- details, iface and linkable are returned.
- CompOK details (Just (new_iface, new_linkable)) pcs2
- -> let hst2 = addToUFM hst1 mod_name details
+ CompOK pcs2 new_details new_iface (Just new_linkable)
+ -> let hst2 = addToUFM hst1 mod_name new_details
hit2 = addToUFM hit1 mod_name new_iface
threaded2 = CmThreaded pcs2 hst2 hit2
in return (threaded2, Just new_linkable)
downsweep :: [FilePath] -> IO [ModSummary]
downsweep rootNm
= do rootSummaries <- mapM getRootSummary rootNm
- loop (filter (isModuleInThisPackage.ms_mod) rootSummaries)
+ loop (filter (isHomeModule.ms_mod) rootSummaries)
where
getRootSummary :: FilePath -> IO ModSummary
getRootSummary file
neededSummaries
<- mapM getSummary neededImps
let newHomeSummaries
- = filter (isModuleInThisPackage.ms_mod) neededSummaries
+ = filter (isHomeModule.ms_mod) neededSummaries
if null newHomeSummaries
then return homeSummaries
else loop (newHomeSummaries ++ homeSummaries)
-- Summarise a module, and pick up source and interface timestamps.
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
- | isModuleInThisPackage mod
+ | isHomeModule mod
= do let hs_fn = unJust "summarise" (ml_hs_file location)
hspp_fn <- preprocess hs_fn
modsrc <- readFile hspp_fn
-----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.32 2000/11/20 13:39:26 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.33 2000/11/20 17:42:00 sewardj Exp $
--
-- GHC Driver
--
HscFail pcs -> throwDyn (PhaseFailed "hsc" (ExitFailure 1));
- HscOK details maybe_iface maybe_stub_h maybe_stub_c
- _maybe_interpreted_code pcs -> do
+ HscNoRecomp pcs details iface -> return False;
+
+ HscRecomp pcs details iface maybe_stub_h maybe_stub_c
+ _maybe_interpreted_code -> do
-- deal with stubs
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
Nothing -> return ()
Just stub_o -> add v_Ld_inputs stub_o
- let keep_going = case maybe_iface of Just _ -> True; Nothing -> False
- return keep_going
+ return True
}
-----------------------------------------------------------------------------
-> IO CompResult
data CompResult
- = CompOK ModDetails -- new details (HST additions)
- (Maybe (ModIface, Linkable))
- -- summary and code; Nothing => compilation not reqd
- -- (old summary and code are still valid)
- PersistentCompilerState -- updated PCS
+ = CompOK PersistentCompilerState -- updated PCS
+ ModDetails -- new details (HST additions)
+ ModIface -- new iface (HIT additions)
+ (Maybe Linkable)
+ -- new code; Nothing => compilation was not reqd
+ -- (old code is still valid)
| CompErrs PersistentCompilerState -- updated PCS
source_unchanged
location old_iface hst hit pcs
- case hsc_result of {
- HscFail pcs -> return (CompErrs pcs);
+ case hsc_result of
+ HscFail pcs -> return (CompErrs pcs)
- HscOK details maybe_iface
- maybe_stub_h maybe_stub_c maybe_interpreted_code pcs -> do
-
- -- if no compilation happened, bail out early
- case maybe_iface of {
- Nothing -> return (CompOK details Nothing pcs);
- Just iface -> do
+ HscNoRecomp pcs details iface -> return (CompOK pcs details iface Nothing)
+ HscRecomp pcs details iface
+ maybe_stub_h maybe_stub_c maybe_interpreted_code -> do
+
let (basename, _) = splitFilename input_fn
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
let stub_unlinked = case maybe_stub_o of
let linkable = LM unlinked_time (moduleName (ms_mod summary))
(hs_unlinked ++ stub_unlinked)
- return (CompOK details (Just (iface, linkable)) pcs)
- }
- }
+ return (CompOK pcs details iface (Just linkable))
+
-----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support)
import CodeGen ( codeGen )
import CodeOutput ( codeOutput )
-import Module ( ModuleName, moduleName, mkModuleInThisPackage )
+import Module ( ModuleName, moduleName, mkHomeModule )
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn, showPass )
import Util ( unJust )
\begin{code}
data HscResult
- = HscOK ModDetails -- new details (HomeSymbolTable additions)
- (Maybe ModIface) -- new iface (if any compilation was done)
- (Maybe String) -- generated stub_h filename (in /tmp)
- (Maybe String) -- generated stub_c filename (in /tmp)
- (Maybe ([UnlinkedIBind],ItblEnv)) -- interpreted code, if any
- PersistentCompilerState -- updated PCS
-
- | HscFail PersistentCompilerState -- updated PCS
+ -- compilation failed
+ = HscFail PersistentCompilerState -- updated PCS
+ -- concluded that it wasn't necessary
+ | HscNoRecomp PersistentCompilerState -- updated PCS
+ ModDetails -- new details (HomeSymbolTable additions)
+ ModIface -- new iface (if any compilation was done)
+ -- did recompilation
+ | HscRecomp PersistentCompilerState -- updated PCS
+ ModDetails -- new details (HomeSymbolTable additions)
+ ModIface -- new iface (if any compilation was done)
+ (Maybe String) -- generated stub_h filename (in /tmp)
+ (Maybe String) -- generated stub_c filename (in /tmp)
+ (Maybe ([UnlinkedIBind],ItblEnv)) -- interpreted code, if any
+
+
-- no errors or warnings; the individual passes
-- (parse/rename/typecheck) print messages themselves
-- we definitely expect to have the old interface available
hscNoRecomp ghci_mode dflags location (Just old_iface) hst hit pcs_ch
| ghci_mode == OneShot
- = return (HscOK
- (panic "hscNoRecomp:OneShot") -- no details
- Nothing -- makes run_phase Hsc stop
- Nothing Nothing -- foreign export stuff
- Nothing -- ibinds
- pcs_ch)
+ = let bomb = panic "hscNoRecomp:OneShot"
+ in return (HscNoRecomp pcs_ch bomb bomb)
| otherwise
= do {
hPutStrLn stderr "COMPILATION NOT REQUIRED";
-- create a new details from the closed, typechecked, old iface
let new_details = mkModDetailsFromIface env_tc local_insts local_rules
;
- return (HscOK new_details
- Nothing -- tells CM to use old iface and linkables
- Nothing Nothing -- foreign export stuff
- Nothing -- ibinds
- pcs_tc)
+ return (HscNoRecomp pcs_tc new_details old_iface)
}}}}
; case maybe_parsed of {
Nothing -> return (HscFail pcs_ch);
Just rdr_module -> do {
- ; let this_mod = mkModuleInThisPackage (hsModuleName rdr_module)
+ ; let this_mod = mkHomeModule (hsModuleName rdr_module)
-------------------
-- RENAME
hit (pcs_PIT pcs_tc)
-- and the answer is ...
- ; return (HscOK new_details (Just final_iface)
- maybe_stub_h_filename maybe_stub_c_filename
- maybe_ibinds pcs_tc)
+ ; return (HscRecomp pcs_tc new_details final_iface
+ maybe_stub_h_filename maybe_stub_c_filename
+ maybe_ibinds)
}}}}}}}
)
import Name ( mkNameEnv, extendNameEnv )
import Module ( Module,
- moduleName, isModuleInThisPackage,
+ moduleName, isHomeModule,
ModuleName, WhereFrom(..),
extendModuleEnv, mkVanillaModule
)
-- about, it should be from a different package to this one
WARN( not (maybeToBool mod_info) &&
case from of { ImportBySystem -> True; other -> False } &&
- isModuleInThisPackage mod,
+ isHomeModule mod,
ppr mod )
loadDecls mod (iDecls ifaces) (pi_decls iface) `thenRn` \ (decls_vers, new_decls) ->
-- and in that case, forget about the boot indicator
filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
filtered_new_deps
- | isModuleInThisPackage mod
+ | isHomeModule mod
= [ (imp_mod, (has_orphans, is_boot))
| (imp_mod, has_orphans, is_boot, _) <- new_deps,
not (is_loaded imp_mod)
)
import Name ( elemNameEnv, delFromNameEnv )
import Module ( Module, ModuleEnv,
- moduleName, isModuleInThisPackage,
+ moduleName, isHomeModule,
ModuleName, WhereFrom(..),
emptyModuleEnv,
extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
mod = mi_module iface
mod_name = moduleName mod
- is_home_pkg_mod = isModuleInThisPackage mod
+ is_home_pkg_mod = isHomeModule mod
version_info = mi_version iface
version_env = vers_decls version_info
mod_vers = vers_module version_info
main_name = availName avail
mod = nameModule main_name
new_slurped_names = addAvailToNameSet slurped_names avail
- new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
- | otherwise = (extendModuleSet imp_mods mod, imp_names)
+ new_vslurp | isHomeModule mod = (imp_mods, addOneToNameSet imp_names main_name)
+ | otherwise = (extendModuleSet imp_mods mod, imp_names)
recordLocalSlurps new_names
= getIfacesRn `thenRn` \ ifaces ->
projects / ghc-hetmet.git / commitdiff