X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FModule.lhs;h=f4e413d26336a50b571444fd344bf134b15758cd;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=4b59757c6a286c560a621611a80518859d2ffed7;hpb=392095c950c3e242e88bf56bb401869a2f291abf;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index 4b59757..f4e413d 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -1,80 +1,34 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-2002 +% (c) The University of Glasgow, 2004 % -ModuleName +Module ~~~~~~~~~~ -Simply the name of a module, represented as a Z-encoded FastString. +Simply the name of a module, represented as a 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 -~~~~~~~~~~~~~ -When compiling module A, which imports module B, we need to -know whether B will be in the same DLL as A. - If it's in the same DLL, we refer to B_f_closure - If it isn't, we refer to _imp__B_f_closure -When compiling A, we record in B's Module value whether it's -in a different DLL, by setting the DLL flag. - - - - \begin{code} module Module ( - Module, -- Abstract, instance of Eq, Ord, Outputable + Module -- Abstract, instance of Eq, Ord, Outputable + , pprModule -- :: ModuleName -> SDoc - , ModLocation(..), - , showModMsg + , ModLocation(..) + , addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn - , ModuleName - , pprModuleName -- :: ModuleName -> SDoc - , printModulePrefix + , moduleString -- :: ModuleName -> String + , moduleFS -- :: ModuleName -> FastString - , moduleName -- :: Module -> ModuleName - , moduleNameString -- :: ModuleName -> EncodedString - , moduleNameUserString -- :: ModuleName -> UserString - , moduleNameFS -- :: ModuleName -> EncodedFS - - , moduleString -- :: Module -> EncodedString - , moduleUserString -- :: Module -> UserString - - , mkBasePkgModule -- :: UserString -> Module - , mkThPkgModule -- :: UserString -> Module - , mkHomeModule -- :: ModuleName -> Module - , isHomeModule -- :: Module -> Bool - , mkPackageModule -- :: ModuleName -> Module - - , mkModuleName -- :: UserString -> ModuleName - , mkModuleNameFS -- :: UserFS -> ModuleName - , mkSysModuleNameFS -- :: EncodedFS -> ModuleName - - , pprModule, + , mkModule -- :: String -> ModuleName + , mkModuleFS -- :: FastString -> ModuleName - , ModuleEnv, + , ModuleEnv , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv - , extendModuleEnv_C - , lookupModuleEnvByName, extendModuleEnvByName, unitModuleEnvByName + , extendModuleEnv_C, filterModuleEnv , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet @@ -83,55 +37,13 @@ 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} - -%************************************************************************ -%* * -\subsection{Interface file flavour} -%* * -%************************************************************************ - -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.) - -\begin{code} -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{Module locations} @@ -142,34 +54,23 @@ instance Outputable PackageInfo where data ModLocation = ModLocation { ml_hs_file :: Maybe FilePath, + -- The source file, if we have one. Package modules + -- probably don't have source files. - ml_hspp_file :: Maybe FilePath, -- Path of preprocessed source + ml_hi_file :: FilePath, + -- Where the .hi file is, whether or not it exists + -- yet. Always of form foo.hi, even if there is an + -- hi-boot file (we add the -boot suffix later) - 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 + ml_obj_file :: FilePath + -- Where the .o file is, whether or not it exists yet. + -- (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 @@ -180,6 +81,23 @@ 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. +\begin{code} +addBootSuffix :: FilePath -> FilePath +-- Add the "-boot" suffix to .hs, .hi and .o files +addBootSuffix path = path ++ "-boot" + +addBootSuffix_maybe :: Bool -> FilePath -> FilePath +addBootSuffix_maybe is_boot path + | is_boot = addBootSuffix path + | otherwise = path + +addBootSuffixLocn :: ModLocation -> ModLocation +addBootSuffixLocn locn + = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) + , ml_hi_file = addBootSuffix (ml_hi_file locn) + , ml_obj_file = addBootSuffix (ml_obj_file locn) } +\end{code} + %************************************************************************ %* * @@ -188,130 +106,51 @@ where the object file will reside if/when it is created. %************************************************************************ \begin{code} -newtype ModuleName = ModuleName EncodedFS +newtype Module = Module FastString -- 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 Binary Module where + put_ bh (Module m) = put_ bh m + get bh = do m <- get bh; return (Module m) -instance Uniquable ModuleName where - getUnique (ModuleName nm) = getUnique nm +instance Uniquable Module where + getUnique (Module nm) = getUnique nm -instance Eq ModuleName where +instance Eq Module where nm1 == nm2 = getUnique nm1 == getUnique nm2 -- Warning: gives an ordering relation based on the uniques of the -- FastStrings which are the (encoded) module names. This is _not_ -- a lexicographical ordering. -instance Ord ModuleName where +instance Ord Module where nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 -instance Outputable ModuleName where - ppr = pprModuleName - - -pprModuleName :: ModuleName -> SDoc -pprModuleName (ModuleName nm) = pprEncodedFS nm - -moduleNameFS :: ModuleName -> EncodedFS -moduleNameFS (ModuleName mod) = mod - -moduleNameString :: ModuleName -> EncodedString -moduleNameString (ModuleName mod) = unpackFS mod - -moduleNameUserString :: ModuleName -> UserString -moduleNameUserString (ModuleName mod) = decode (unpackFS mod) - --- used to be called mkSrcModule -mkModuleName :: UserString -> ModuleName -mkModuleName s = ModuleName (mkFastString (encode s)) - --- used to be called mkSrcModuleFS -mkModuleNameFS :: UserFS -> ModuleName -mkModuleNameFS s = ModuleName (encodeFS s) - --- used to be called mkSysModuleFS -mkSysModuleNameFS :: EncodedFS -> ModuleName -mkSysModuleNameFS s = ModuleName s -\end{code} - -\begin{code} instance Outputable Module where ppr = pprModule -instance Uniquable Module where - getUnique (Module nm _) = getUnique nm - --- Same if they have the same name. -instance Eq Module where - m1 == m2 = getUnique m1 == getUnique m2 +pprModule :: Module -> SDoc +pprModule (Module nm) = + getPprStyle $ \ sty -> + if codeStyle sty + then ftext (zEncodeFS nm) + else ftext nm --- Warning: gives an ordering relation based on the uniques of the --- FastStrings which are the (encoded) module names. This is _not_ --- a lexicographical ordering. -instance Ord Module where - m1 `compare` m2 = getUnique m1 `compare` getUnique m2 -\end{code} +moduleFS :: Module -> FastString +moduleFS (Module mod) = mod +moduleString :: Module -> String +moduleString (Module mod) = unpackFS mod -\begin{code} -pprModule :: Module -> SDoc -pprModule (Module mod p) = getPprStyle $ \ sty -> - if debugStyle sty then - -- Print the package too - -- Don't use '.' because it gets confused - -- with module names - brackets (ppr p) <> pprModuleName mod - else - pprModuleName mod -\end{code} - +-- used to be called mkSrcModule +mkModule :: String -> Module +mkModule s = Module (mkFastString s) -\begin{code} -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) _) = unpackFS fs - -moduleName :: Module -> ModuleName -moduleName (Module mod pkg_info) = mod - -moduleUserString :: Module -> UserString -moduleUserString (Module mod _) = moduleNameUserString mod - -printModulePrefix :: Module -> Bool - -- When printing, say M.x -printModulePrefix (Module nm ThisPackage) = False -printModulePrefix _ = True +-- used to be called mkSrcModuleFS +mkModuleFS :: FastString -> Module +mkModuleFS s = Module s \end{code} - %************************************************************************ %* * \subsection{@ModuleEnv@s} @@ -320,9 +159,6 @@ 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 @@ -343,15 +179,11 @@ 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 +filterModuleEnv :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a --- The ByName variants -lookupModuleEnvByName :: ModuleEnv a -> ModuleName -> Maybe a -unitModuleEnvByName :: ModuleName -> a -> ModuleEnv a -extendModuleEnvByName :: ModuleEnv a -> ModuleName -> a -> ModuleEnv a - +filterModuleEnv = filterUFM elemModuleEnv = elemUFM extendModuleEnv = addToUFM -extendModuleEnvByName = addToUFM extendModuleEnv_C = addToUFM_C extendModuleEnvList = addListToUFM plusModuleEnv_C = plusUFM_C @@ -359,20 +191,17 @@ delModuleEnvList = delListFromUFM delModuleEnv = delFromUFM plusModuleEnv = plusUFM lookupModuleEnv = lookupUFM -lookupModuleEnvByName = lookupUFM lookupWithDefaultModuleEnv = lookupWithDefaultUFM mapModuleEnv = mapUFM mkModuleEnv = listToUFM emptyModuleEnv = emptyUFM moduleEnvElts = eltsUFM unitModuleEnv = unitUFM -unitModuleEnvByName = unitUFM isEmptyModuleEnv = isNullUFM foldModuleEnv = foldUFM \end{code} \begin{code} - type ModuleSet = UniqSet Module mkModuleSet :: [Module] -> ModuleSet extendModuleSet :: ModuleSet -> Module -> ModuleSet