X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=4b59757c6a286c560a621611a80518859d2ffed7;hb=b749b2c7fd7fb9cdd464c213672ded760f498dc9;hp=4a74f9c671b51dc1ac81258e6ed4edc75d90c58f;hpb=9fdd90b00f159463165f739c44943e53fb553c19;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 4a74f9c..4b59757 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,11 +56,11 @@ module Module , moduleString -- :: Module -> EncodedString , moduleUserString -- :: Module -> UserString - , mkVanillaModule -- :: ModuleName -> Module - , mkPrelModule -- :: UserString -> Module - , mkModule -- :: ModuleName -> PackageName -> Module + , mkBasePkgModule -- :: UserString -> Module + , mkThPkgModule -- :: UserString -> Module , mkHomeModule -- :: ModuleName -> Module , isHomeModule -- :: Module -> Bool + , mkPackageModule -- :: ModuleName -> Module , mkModuleName -- :: UserString -> ModuleName , mkModuleNameFS -- :: UserFS -> ModuleName @@ -51,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 @@ -68,11 +83,15 @@ module Module #include "HsVersions.h" import OccName import Outputable +import Packages ( PackageName, basePackage, thPackage ) import CmdLineOpts ( opt_InPackage ) import FastString ( FastString ) import Unique ( Uniquable(..) ) +import Maybes ( expectJust ) import UniqFM import UniqSet +import Binary +import FastString \end{code} @@ -96,28 +115,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 = SLIT("") -packageInfoPackage DunnoYet = SLIT("") -packageInfoPackage (AnotherPackage p) = p +packageInfoPackage ThisPackage = opt_InPackage +packageInfoPackage AnotherPackage = FSLIT("") instance Outputable PackageInfo where -- Just used in debug prints of lex tokens and in debug modde @@ -127,25 +134,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 - -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. + %************************************************************************ %* * @@ -158,6 +192,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 @@ -181,14 +219,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 @@ -223,21 +261,30 @@ 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 +mkBasePkgModule :: ModuleName -> Module +mkBasePkgModule mod_nm + = Module mod_nm pack_info + where + pack_info + | opt_InPackage == basePackage = ThisPackage + | otherwise = AnotherPackage + +mkThPkgModule :: ModuleName -> Module +mkThPkgModule mod_nm = Module mod_nm pack_info where - pack_info | pack_name == opt_InPackage = ThisPackage - | otherwise = AnotherPackage pack_name + pack_info + | opt_InPackage == thPackage = ThisPackage + | otherwise = AnotherPackage mkHomeModule :: ModuleName -> Module mkHomeModule mod_nm = Module mod_nm ThisPackage @@ -246,24 +293,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 - -mkPrelModule :: ModuleName -> Module -mkPrelModule name = mkModule name preludePackage +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 @@ -282,6 +320,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 @@ -299,13 +340,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 @@ -320,6 +366,7 @@ mkModuleEnv = listToUFM emptyModuleEnv = emptyUFM moduleEnvElts = eltsUFM unitModuleEnv = unitUFM +unitModuleEnvByName = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM \end{code}