X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FModule.lhs;h=57509a00fed8049d4bcdb24393ea871de7a2b6d6;hp=ba0459d01192469b427bbddbc1b770b538aba8a7;hb=48b6c777e2e84cc42a27a50642bcb41a0bd2c1d7;hpb=49c98d143c382a1341e1046f5ca00819a25691ba diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index ba0459d..57509a0 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -16,14 +16,37 @@ module Module pprModuleName, moduleNameFS, moduleNameString, + moduleNameSlashes, mkModuleName, mkModuleNameFS, + stableModuleNameCmp, + + -- * The PackageId type + PackageId, + fsToPackageId, + packageIdFS, + stringToPackageId, + packageIdString, + stablePackageIdCmp, + + -- * Wired-in PackageIds + primPackageId, + integerPackageId, + basePackageId, + rtsPackageId, + haskell98PackageId, + thPackageId, + ndpPackageId, + dphSeqPackageId, + dphParPackageId, + mainPackageId, -- * The Module type Module, modulePackageId, moduleName, pprModule, mkModule, + stableModuleCmp, -- * The ModuleLocation type ModLocation(..), @@ -35,8 +58,8 @@ module Module extendModuleEnvList_C, plusModuleEnv_C, delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv, lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv, - moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv, - extendModuleEnv_C, filterModuleEnv, + moduleEnvKeys, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, + foldModuleEnv, extendModuleEnv_C, filterModuleEnv, -- * ModuleName mappings ModuleNameEnv, @@ -46,14 +69,16 @@ module Module elemModuleSet ) where -#include "HsVersions.h" import Outputable +import qualified Pretty import Unique import FiniteMap -import UniqFM -import PackageConfig +import LazyUniqFM import FastString import Binary +import Util + +import System.FilePath \end{code} %************************************************************************ @@ -140,6 +165,10 @@ instance Binary ModuleName where put_ bh (ModuleName fs) = put_ bh fs get bh = do fs <- get bh; return (ModuleName fs) +stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering +-- Compare lexically, not by unique +stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2 + pprModuleName :: ModuleName -> SDoc pprModuleName (ModuleName nm) = getPprStyle $ \ sty -> @@ -158,6 +187,11 @@ mkModuleName s = ModuleName (mkFastString s) mkModuleNameFS :: FastString -> ModuleName mkModuleNameFS s = ModuleName s + +-- Returns the string version of the module name, with dots replaced by slashes +moduleNameSlashes :: ModuleName -> String +moduleNameSlashes = dots_to_slashes . moduleNameString + where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c) \end{code} %************************************************************************ @@ -181,12 +215,21 @@ instance Binary Module where put_ bh (Module p n) = put_ bh p >> put_ bh n get bh = do p <- get bh; n <- get bh; return (Module p n) +-- This gives a stable ordering, as opposed to the Ord instance which +-- gives an ordering based on the Uniques of the components, which may +-- not be stable from run to run of the compiler. +stableModuleCmp :: Module -> Module -> Ordering +stableModuleCmp (Module p1 n1) (Module p2 n2) + = (p1 `stablePackageIdCmp` p2) `thenCmp` + (n1 `stableModuleNameCmp` n2) + mkModule :: PackageId -> ModuleName -> Module mkModule = Module pprModule :: Module -> SDoc pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n +pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc pprPackagePrefix p mod = getPprStyle doc where doc sty @@ -194,7 +237,7 @@ pprPackagePrefix p mod = getPprStyle doc if p == mainPackageId then empty -- never qualify the main package in code else ftext (zEncodeFS (packageIdFS p)) <> char '_' - | Just pkg <- qualModule sty mod = ftext (packageIdFS pkg) <> char ':' + | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':' -- the PrintUnqualified tells us which modules have to -- be qualified with package names | otherwise = empty @@ -202,6 +245,86 @@ pprPackagePrefix p mod = getPprStyle doc %************************************************************************ %* * +\subsection{PackageId} +%* * +%************************************************************************ + +\begin{code} +newtype PackageId = PId FastString deriving( Eq ) -- includes the version + -- here to avoid module loops with PackageConfig + +instance Uniquable PackageId where + getUnique pid = getUnique (packageIdFS pid) + +-- Note: *not* a stable lexicographic ordering, a faster unique-based +-- ordering. +instance Ord PackageId where + nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2 + +stablePackageIdCmp :: PackageId -> PackageId -> Ordering +stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2 + +instance Outputable PackageId where + ppr pid = text (packageIdString pid) + +instance Binary PackageId where + put_ bh pid = put_ bh (packageIdFS pid) + get bh = do { fs <- get bh; return (fsToPackageId fs) } + +fsToPackageId :: FastString -> PackageId +fsToPackageId = PId + +packageIdFS :: PackageId -> FastString +packageIdFS (PId fs) = fs + +stringToPackageId :: String -> PackageId +stringToPackageId = fsToPackageId . mkFastString + +packageIdString :: PackageId -> String +packageIdString = unpackFS . packageIdFS + + +-- ----------------------------------------------------------------------------- +-- Package Ids that are wired in + +-- Certain packages are "known" to the compiler, in that we know about certain +-- entities that reside in these packages, and the compiler needs to +-- declare static Modules and Names that refer to these packages. Hence +-- the wired-in packages can't include version numbers, since we don't want +-- to bake the version numbers of these packages into GHC. +-- +-- So here's the plan. Wired-in packages are still versioned as +-- normal in the packages database, and you can still have multiple +-- versions of them installed. However, for each invocation of GHC, +-- only a single instance of each wired-in package will be recognised +-- (the desired one is selected via -package/-hide-package), and GHC +-- will use the unversioned PackageId below when referring to it, +-- including in .hi files and object file symbols. Unselected +-- versions of wired-in packages will be ignored, as will any other +-- package that depends directly or indirectly on it (much as if you +-- had used -ignore-package). + +integerPackageId, primPackageId, + basePackageId, rtsPackageId, haskell98PackageId, + thPackageId, ndpPackageId, mainPackageId :: PackageId +primPackageId = fsToPackageId (fsLit "ghc-prim") +integerPackageId = fsToPackageId (fsLit "integer") +basePackageId = fsToPackageId (fsLit "base") +rtsPackageId = fsToPackageId (fsLit "rts") +haskell98PackageId = fsToPackageId (fsLit "haskell98") +thPackageId = fsToPackageId (fsLit "template-haskell") +ndpPackageId = fsToPackageId (fsLit "ndp") +dphSeqPackageId = fsToPackageId (fsLit "dph-seq") +dphParPackageId = fsToPackageId (fsLit "dph-par") + +-- This is the package Id for the program. It is the default package +-- Id if you don't specify a package name. We don't add this prefix +-- to symbol name, since there can be only one main package per program. +mainPackageId = fsToPackageId (fsLit "main") +\end{code} + +%************************************************************************ +%* * \subsection{@ModuleEnv@s} %* * %************************************************************************ @@ -222,6 +345,7 @@ 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 +moduleEnvKeys :: ModuleEnv a -> [Module] moduleEnvElts :: ModuleEnv a -> [a] isEmptyModuleEnv :: ModuleEnv a -> Bool @@ -246,6 +370,7 @@ lookupWithDefaultModuleEnv = lookupWithDefaultFM mapModuleEnv f = mapFM (\_ v -> f v) mkModuleEnv = listToFM emptyModuleEnv = emptyFM +moduleEnvKeys = keysFM moduleEnvElts = eltsFM unitModuleEnv = unitFM isEmptyModuleEnv = isEmptyFM