X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=4b59757c6a286c560a621611a80518859d2ffed7;hb=57d3c7c8a8523e375d49d2ac036210b6dcf7ec9c;hp=61e625195a73e84c00efe7daf88758c84a3f1b88;hpb=6dd3b5de2be9fd591722101a4ecf2efcc81880fe;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 61e6251..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 ~~~~~~~~~~~~~ @@ -21,27 +39,28 @@ in a different DLL, by setting the DLL flag. \begin{code} module Module ( - Module, mod_name, mod_kind - -- abstract, instance of Eq, Ord, Outputable + Module, -- Abstract, instance of Eq, Ord, Outputable + + , ModLocation(..), + , showModMsg + , ModuleName - , ModuleKind(..) - , isLocalModuleKind + , pprModuleName -- :: ModuleName -> SDoc + , printModulePrefix + , moduleName -- :: Module -> ModuleName , moduleNameString -- :: ModuleName -> EncodedString , moduleNameUserString -- :: ModuleName -> UserString , moduleNameFS -- :: ModuleName -> EncodedFS , moduleString -- :: Module -> EncodedString , moduleUserString -- :: Module -> UserString - , moduleName -- :: Module -> ModuleName - , mkVanillaModule -- :: ModuleName -> Module --- , mkThisModule -- :: ModuleName -> Module - , mkPrelModule -- :: UserString -> Module - , mkModule -- :: ModuleName -> ModuleKind -> Module - , isLocalModule -- :: Module -> Bool - --- , mkSrcModule + , mkBasePkgModule -- :: UserString -> Module + , mkThPkgModule -- :: UserString -> Module + , mkHomeModule -- :: ModuleName -> Module + , isHomeModule -- :: Module -> Bool + , mkPackageModule -- :: ModuleName -> Module , mkModuleName -- :: UserString -> ModuleName , mkModuleNameFS -- :: UserFS -> ModuleName @@ -49,26 +68,30 @@ module Module , pprModule, - , PackageName - - -- Where to find a .hi file - , WhereFrom(..) - , ModuleEnv, , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv - , rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv + , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv + , extendModuleEnv_C + , lookupModuleEnvByName, extendModuleEnvByName, unitModuleEnvByName + + , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet ) where #include "HsVersions.h" import OccName import Outputable +import Packages ( PackageName, basePackage, thPackage ) import CmdLineOpts ( opt_InPackage ) -import FastString ( FastString, uniqueOfFS ) -import Unique ( Uniquable(..), mkUniqueGrimily ) +import FastString ( FastString ) +import Unique ( Uniquable(..) ) +import Maybes ( expectJust ) import UniqFM +import UniqSet +import Binary +import FastString \end{code} @@ -78,66 +101,85 @@ import UniqFM %* * %************************************************************************ -A further twist to the tale is the support for dynamically linked libraries under -Win32. Here, dealing with the use of global variables that's residing in a DLL -requires special handling at the point of use (there's an extra level of indirection, -i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an -interface file we then record whether it's coming from a .hi corresponding to a -module that's packaged up in a DLL or not, so that we later can emit the +A further twist to the tale is the support for dynamically linked +libraries under Win32. Here, dealing with the use of global variables +that's residing in a DLL requires special handling at the point of use +(there's an extra level of indirection, i.e., (**v) to get at v's +value, rather than just (*v) .) When slurping in an interface file we +then record whether it's coming from a .hi corresponding to a module +that's packaged up in a DLL or not, so that we later can emit the appropriate code. -The logic for how an interface file is marked as corresponding to a module that's -hiding in a DLL is explained elsewhere (ToDo: give renamer href here.) - -@SourceOnly@ and @ObjectCode@ indicate a module from the same package -as the one being compiled, i.e. a home module. @InPackage@ means one -from a different package. +The logic for how an interface file is marked as corresponding to a +module that's hiding in a DLL is explained elsewhere (ToDo: give +renamer href here.) \begin{code} -data ModuleKind - = SourceOnly FilePath -- .hs - | ObjectCode FilePath FilePath -- .o, .hi - | InPackage PackageName - -isLocalModuleKind (InPackage _) = False -isLocalModuleKind _ = True - -type PackageName = FastString -- No encoding at all - -preludePackage :: ModuleKind -preludePackage = InPackage SLIT("std") - -instance Outputable ModuleKind where - ppr (SourceOnly path_hs) - = text "SourceOnly" <+> text (show path_hs) - ppr (ObjectCode path_o path_hi) - = text "ObjectCode" <+> text (show path_o) <+> text (show path_hi) - ppr (InPackage pkgname) - = text "InPackage" <+> text (show pkgname) +data Module = Module ModuleName !PackageInfo + +data PackageInfo + = ThisPackage -- A module from the same package + -- as the one being compiled + | AnotherPackage -- A module from a different package + +packageInfoPackage :: PackageInfo -> PackageName +packageInfoPackage ThisPackage = opt_InPackage +packageInfoPackage AnotherPackage = FSLIT("") + +instance Outputable PackageInfo where + -- Just used in debug prints of lex tokens and in debug modde + ppr pkg_info = ppr (packageInfoPackage pkg_info) \end{code} %************************************************************************ %* * -\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. + %************************************************************************ %* * @@ -150,8 +192,12 @@ 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) = mkUniqueGrimily (uniqueOfFS nm) + getUnique (ModuleName nm) = getUnique nm instance Eq ModuleName where nm1 == nm2 = getUnique nm1 == getUnique nm2 @@ -173,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 @@ -192,13 +238,6 @@ mkSysModuleNameFS s = ModuleName s \end{code} \begin{code} -data Module = Module ModuleName ModuleKind - -mod_name (Module nm kind) = nm -mod_kind (Module nm kind) = kind -\end{code} - -\begin{code} instance Outputable Module where ppr = pprModule @@ -222,52 +261,57 @@ 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 -> ModuleKind -> Module -mkModule = Module --- I don't think anybody except the Finder should ever try to create a --- Module now, so this lot commented out pro tem (JRS) ---mkModule :: ModuleName -- Name of the module --- -> PackageName --- -> Module ---mkModule mod_nm pack_name --- = Module mod_nm pack_info --- where --- pack_info | pack_name == opt_InPackage = ThisPackage --- | otherwise = AnotherPackage pack_name - - --- 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.) -mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = Module name (panic "mkVanillaModule:unknown mod_kind field") - ---mkThisModule :: ModuleName -> Module -- The module being compiled ---mkThisModule name = Module name ThisPackage - -mkPrelModule :: ModuleName -> Module -mkPrelModule name = Module name preludePackage +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 + | opt_InPackage == thPackage = ThisPackage + | otherwise = AnotherPackage + +mkHomeModule :: ModuleName -> Module +mkHomeModule mod_nm = Module mod_nm ThisPackage + +isHomeModule :: Module -> Bool +isHomeModule (Module nm ThisPackage) = True +isHomeModule _ = 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 _) = mod +moduleName (Module mod pkg_info) = mod moduleUserString :: Module -> UserString moduleUserString (Module mod _) = moduleNameUserString mod -isLocalModule :: Module -> Bool -isLocalModule (Module nm kind) = isLocalModuleKind kind +printModulePrefix :: Module -> Bool + -- When printing, say M.x +printModulePrefix (Module nm ThisPackage) = False +printModulePrefix _ = True \end{code} + %************************************************************************ %* * \subsection{@ModuleEnv@s} @@ -276,11 +320,15 @@ isLocalModule (Module nm kind) = isLocalModuleKind kind \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 unitModuleEnv :: Module -> a -> ModuleEnv a extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a +extendModuleEnv_C :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a @@ -288,28 +336,53 @@ delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b -rngModuleEnv :: ModuleEnv a -> [a] +moduleEnvElts :: ModuleEnv a -> [a] isEmptyModuleEnv :: ModuleEnv a -> Bool -lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a +lookupModuleEnv :: ModuleEnv a -> Module -> 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 delModuleEnvList = delListFromUFM delModuleEnv = delFromUFM plusModuleEnv = plusUFM lookupModuleEnv = lookupUFM +lookupModuleEnvByName = lookupUFM lookupWithDefaultModuleEnv = lookupWithDefaultUFM mapModuleEnv = mapUFM mkModuleEnv = listToUFM emptyModuleEnv = emptyUFM -rngModuleEnv = eltsUFM +moduleEnvElts = eltsUFM unitModuleEnv = unitUFM +unitModuleEnvByName = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM -\end{code} \ No newline at end of file +\end{code} + +\begin{code} + +type ModuleSet = UniqSet Module +mkModuleSet :: [Module] -> ModuleSet +extendModuleSet :: ModuleSet -> Module -> ModuleSet +emptyModuleSet :: ModuleSet +moduleSetElts :: ModuleSet -> [Module] +elemModuleSet :: Module -> ModuleSet -> Bool + +emptyModuleSet = emptyUniqSet +mkModuleSet = mkUniqSet +extendModuleSet = addOneToUniqSet +moduleSetElts = uniqSetToList +elemModuleSet = elementOfUniqSet +\end{code}