X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=ea4de1ed05b17c4aa09062760b058c7f6d55fc14;hb=182b16bccea2eab1a8af93a6246db3d391e436c7;hp=9b43ed70bd996099199f7af3e1517a6c378c3134;hpb=e25c9d5ee995d2a2b8477f1d35bbb660aa603221;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 9b43ed7..ea4de1e 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -1,10 +1,28 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-2002 % -\section[Module]{The @Module@ module.} -Representing modules and their flavours. +ModuleName +~~~~~~~~~~ +Simply the name of a module, represented as a Z-encoded FastString. +These are Uniquable, hence we can build FiniteMaps with ModuleNames as +the keys. +Module +~~~~~~ + +A ModuleName with some additional information, namely whether the +module resides in the Home package or in a different package. We need +to know this for two reasons: + + * generating cross-DLL calls is different from intra-DLL calls + (see below). + * we don't record version information in interface files for entities + in a different package. + +The unique of a Module is identical to the unique of a ModuleName, so +it is safe to look up in a Module map using a ModuleName and vice +versa. Notes on DLLs ~~~~~~~~~~~~~ @@ -23,9 +41,8 @@ module Module ( Module, -- Abstract, instance of Eq, Ord, Outputable - , PackageName -- = FastString; instance of Outputable, Uniquable - , modulePackage -- :: Module -> PackageName - , preludePackage -- :: PackageName name of Standard Prelude package + , ModLocation(..), + , showModMsg , ModuleName , pprModuleName -- :: ModuleName -> SDoc @@ -39,13 +56,11 @@ module Module , moduleString -- :: Module -> EncodedString , moduleUserString -- :: Module -> UserString - , mkVanillaModule -- :: ModuleName -> Module - , isVanillaModule -- :: Module -> Bool - , mkPrelModule -- :: UserString -> Module - , isPrelModule -- :: Module -> Bool - , mkModule -- :: ModuleName -> PackageName -> Module + , mkModule + , mkBasePkgModule -- :: UserString -> Module , mkHomeModule -- :: ModuleName -> Module , isHomeModule -- :: Module -> Bool + , mkPackageModule -- :: ModuleName -> Module , mkModuleName -- :: UserString -> ModuleName , mkModuleNameFS -- :: UserFS -> ModuleName @@ -53,15 +68,13 @@ module Module , pprModule, - -- Where to find a .hi file - , WhereFrom(..) - , ModuleEnv, , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv - , lookupModuleEnvByName, extendModuleEnv_C + , extendModuleEnv_C + , lookupModuleEnvByName, extendModuleEnvByName, unitModuleEnvByName , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet @@ -70,11 +83,14 @@ module Module #include "HsVersions.h" import OccName import Outputable +import Packages ( PackageName, basePackage ) import CmdLineOpts ( opt_InPackage ) -import FastString ( FastString ) import Unique ( Uniquable(..) ) +import Maybes ( expectJust ) import UniqFM import UniqSet +import Binary +import FastString \end{code} @@ -98,28 +114,16 @@ module that's hiding in a DLL is explained elsewhere (ToDo: give renamer href here.) \begin{code} -data Module = Module ModuleName PackageInfo +data Module = Module ModuleName !PackageInfo data PackageInfo = ThisPackage -- A module from the same package -- as the one being compiled - | AnotherPackage PackageName -- A module from a different package - - | DunnoYet -- This is used when we don't yet know - -- Main case: we've come across Foo.x in an interface file - -- but we havn't yet opened Foo.hi. We need a Name for Foo.x - -- Later on (in RnEnv.newTopBinder) we'll update the cache - -- to have the right PackageName - -type PackageName = FastString -- No encoding at all - -preludePackage :: PackageName -preludePackage = SLIT("std") + | AnotherPackage -- A module from a different package packageInfoPackage :: PackageInfo -> PackageName packageInfoPackage ThisPackage = opt_InPackage -packageInfoPackage DunnoYet = SLIT("") -packageInfoPackage (AnotherPackage p) = p +packageInfoPackage AnotherPackage = FSLIT("") instance Outputable PackageInfo where -- Just used in debug prints of lex tokens and in debug modde @@ -129,28 +133,52 @@ instance Outputable PackageInfo where %************************************************************************ %* * -\subsection{Where from} +\subsection{Module locations} %* * %************************************************************************ -The @WhereFrom@ type controls where the renamer looks for an interface file - \begin{code} -data WhereFrom = ImportByUser -- Ordinary user import: look for M.hi - | ImportByUserSource -- User {- SOURCE -}: look for M.hi-boot - | ImportBySystem -- Non user import. Look for M.hi if M is in - -- the module this module depends on, or is a system-ish module; - -- M.hi-boot otherwise - | ImportByCmdLine -- The user typed a qualified name at - -- the GHCi prompt, try to demand-load - -- the interface. - -instance Outputable WhereFrom where - ppr ImportByUser = empty - ppr ImportByUserSource = ptext SLIT("{- SOURCE -}") - ppr ImportBySystem = ptext SLIT("{- SYSTEM IMPORT -}") +data ModLocation + = ModLocation { + ml_hs_file :: Maybe FilePath, + + ml_hspp_file :: Maybe FilePath, -- Path of preprocessed source + + ml_hi_file :: FilePath, -- Where the .hi file is, whether or not it exists + -- Always of form foo.hi, even if there is an hi-boot + -- file (we add the -boot suffix later) + + ml_obj_file :: FilePath -- Where the .o file is, whether or not it exists + -- (might not exist either because the module + -- hasn't been compiled yet, or because + -- it is part of a package with a .a file) + } + deriving Show + +instance Outputable ModLocation where + ppr = text . show + +-- Rather a gruesome function to have in Module + +showModMsg :: Bool -> Module -> ModLocation -> String +showModMsg use_object mod location = + mod_str ++ replicate (max 0 (16 - length mod_str)) ' ' + ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", " + ++ (if use_object + then ml_obj_file location + else "interpreted") + ++ " )" + where mod_str = moduleUserString mod \end{code} +For a module in another package, the hs_file and obj_file +components of ModLocation are undefined. + +The locations specified by a ModLocation may or may not +correspond to actual files yet: for example, even if the object +file doesn't exist, the ModLocation still contains the path to +where the object file will reside if/when it is created. + %************************************************************************ %* * @@ -163,6 +191,10 @@ newtype ModuleName = ModuleName EncodedFS -- Haskell module names can include the quote character ', -- so the module names have the z-encoding applied to them +instance Binary ModuleName where + put_ bh (ModuleName m) = put_ bh m + get bh = do m <- get bh; return (ModuleName m) + instance Uniquable ModuleName where getUnique (ModuleName nm) = getUnique nm @@ -186,14 +218,14 @@ moduleNameFS :: ModuleName -> EncodedFS moduleNameFS (ModuleName mod) = mod moduleNameString :: ModuleName -> EncodedString -moduleNameString (ModuleName mod) = _UNPK_ mod +moduleNameString (ModuleName mod) = unpackFS mod moduleNameUserString :: ModuleName -> UserString -moduleNameUserString (ModuleName mod) = decode (_UNPK_ mod) +moduleNameUserString (ModuleName mod) = decode (unpackFS mod) -- used to be called mkSrcModule mkModuleName :: UserString -> ModuleName -mkModuleName s = ModuleName (_PK_ (encode s)) +mkModuleName s = ModuleName (mkFastString (encode s)) -- used to be called mkSrcModuleFS mkModuleNameFS :: UserFS -> ModuleName @@ -228,21 +260,25 @@ pprModule :: Module -> SDoc pprModule (Module mod p) = getPprStyle $ \ sty -> if debugStyle sty then -- Print the package too - ppr p <> dot <> pprModuleName mod + -- Don't use '.' because it gets confused + -- with module names + brackets (ppr p) <> pprModuleName mod else pprModuleName mod \end{code} \begin{code} -mkModule :: ModuleName -- Name of the module - -> PackageName - -> Module -mkModule mod_nm pack_name - = Module mod_nm pack_info +mkModule :: PackageName -> ModuleName -> Module +mkModule pkg_name mod_name + = Module mod_name pkg_info where - pack_info | pack_name == opt_InPackage = ThisPackage - | otherwise = AnotherPackage pack_name + pkg_info + | opt_InPackage == pkg_name = ThisPackage + | otherwise = AnotherPackage + +mkBasePkgModule :: ModuleName -> Module +mkBasePkgModule mod_nm = mkModule basePackage mod_nm mkHomeModule :: ModuleName -> Module mkHomeModule mod_nm = Module mod_nm ThisPackage @@ -251,32 +287,15 @@ 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 Package is.) -mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = Module name DunnoYet - -isVanillaModule :: Module -> Bool -isVanillaModule (Module nm DunnoYet) = True -isVanillaModule _ = False - -mkPrelModule :: ModuleName -> Module -mkPrelModule name = mkModule name preludePackage - -isPrelModule :: Module -> Bool -isPrelModule (Module nm (AnotherPackage p)) | p == preludePackage = True -isPrelModule _ = False +mkPackageModule :: ModuleName -> Module +mkPackageModule mod_nm = Module mod_nm AnotherPackage moduleString :: Module -> EncodedString -moduleString (Module (ModuleName fs) _) = _UNPK_ fs +moduleString (Module (ModuleName fs) _) = unpackFS fs moduleName :: Module -> ModuleName moduleName (Module mod pkg_info) = mod -modulePackage :: Module -> PackageName -modulePackage (Module mod pkg_info) = packageInfoPackage pkg_info - moduleUserString :: Module -> UserString moduleUserString (Module mod _) = moduleNameUserString mod @@ -295,6 +314,9 @@ printModulePrefix _ = True \begin{code} type ModuleEnv elt = UniqFM elt +-- A ModuleName and Module have the same Unique, +-- so both will work as keys. +-- The 'ByName' variants work on ModuleNames emptyModuleEnv :: ModuleEnv a mkModuleEnv :: [(Module, a)] -> ModuleEnv a @@ -312,13 +334,18 @@ moduleEnvElts :: ModuleEnv a -> [a] isEmptyModuleEnv :: ModuleEnv a -> Bool lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a -lookupModuleEnvByName:: ModuleEnv a -> ModuleName -> Maybe a lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a elemModuleEnv :: Module -> ModuleEnv a -> Bool foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b +-- The ByName variants +lookupModuleEnvByName :: ModuleEnv a -> ModuleName -> Maybe a +unitModuleEnvByName :: ModuleName -> a -> ModuleEnv a +extendModuleEnvByName :: ModuleEnv a -> ModuleName -> a -> ModuleEnv a + elemModuleEnv = elemUFM extendModuleEnv = addToUFM +extendModuleEnvByName = addToUFM extendModuleEnv_C = addToUFM_C extendModuleEnvList = addListToUFM plusModuleEnv_C = plusUFM_C @@ -333,6 +360,7 @@ mkModuleEnv = listToUFM emptyModuleEnv = emptyUFM moduleEnvElts = eltsUFM unitModuleEnv = unitUFM +unitModuleEnvByName = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM \end{code}