X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FModule.lhs;h=9afef942e7193a7884e372979fa9388dd7e0ae31;hb=432b9c9322181a3644083e3c19b7e240d90659e7;hp=22941a2d91f107e68331ddc9d2d08f368df867ad;hpb=d51f42f602bf9a6d1b356c41228a534c88723f65;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 22941a2..9afef94 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -19,6 +19,7 @@ module Module moduleNameSlashes, mkModuleName, mkModuleNameFS, + stableModuleNameCmp, -- * The PackageId type PackageId, @@ -26,13 +27,18 @@ module Module packageIdFS, stringToPackageId, packageIdString, + stablePackageIdCmp, -- * Wired-in PackageIds + -- $wired_in_packages + primPackageId, + integerPackageId, basePackageId, rtsPackageId, haskell98PackageId, thPackageId, - ndpPackageId, + dphSeqPackageId, + dphParPackageId, mainPackageId, -- * The Module type @@ -40,6 +46,7 @@ module Module modulePackageId, moduleName, pprModule, mkModule, + stableModuleCmp, -- * The ModuleLocation type ModLocation(..), @@ -57,12 +64,11 @@ module Module -- * ModuleName mappings ModuleNameEnv, - -- * Sets of modules - ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, - elemModuleSet + -- * Sets of Modules + ModuleSet, + emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet ) where -#include "HsVersions.h" import Outputable import qualified Pretty import Unique @@ -70,6 +76,7 @@ import FiniteMap import LazyUniqFM import FastString import Binary +import Util import System.FilePath \end{code} @@ -81,6 +88,8 @@ import System.FilePath %************************************************************************ \begin{code} +-- | Where a module lives on the file system: the actual locations +-- of the .hs, .hi and .o files, if we have them data ModLocation = ModLocation { ml_hs_file :: Maybe FilePath, @@ -113,15 +122,17 @@ 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 +-- ^ Add the @-boot@ suffix to .hs, .hi and .o files addBootSuffix path = path ++ "-boot" addBootSuffix_maybe :: Bool -> FilePath -> FilePath +-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@ addBootSuffix_maybe is_boot path | is_boot = addBootSuffix path | otherwise = path addBootSuffixLocn :: ModLocation -> ModLocation +-- ^ Add the @-boot@ suffix to all file paths associated with the module addBootSuffixLocn locn = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn) , ml_hi_file = addBootSuffix (ml_hi_file locn) @@ -136,7 +147,7 @@ addBootSuffixLocn locn %************************************************************************ \begin{code} --- | A ModuleName is a simple string, eg. @Data.List@. +-- | A ModuleName is essentially a simple string, e.g. @Data.List@. newtype ModuleName = ModuleName FastString instance Uniquable ModuleName where @@ -158,6 +169,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 +-- ^ Compares module names lexically, rather than by their 'Unique's +stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2 + pprModuleName :: ModuleName -> SDoc pprModuleName (ModuleName nm) = getPprStyle $ \ sty -> @@ -177,7 +192,7 @@ 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 +-- | 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) @@ -197,6 +212,9 @@ data Module = Module { } deriving (Eq, Ord) +instance Uniquable Module where + getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n) + instance Outputable Module where ppr = pprModule @@ -204,8 +222,13 @@ 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) -instance Uniquable PackageId where - getUnique pid = getUnique (packageIdFS pid) +-- | This gives a stable ordering, as opposed to the Ord instance which +-- gives an ordering based on the 'Unique's 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 @@ -234,9 +257,22 @@ pprPackagePrefix p mod = getPprStyle doc %************************************************************************ \begin{code} -newtype PackageId = PId FastString deriving( Eq, Ord ) -- includes the version +-- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0 +newtype PackageId = PId FastString deriving( Eq ) -- 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 +-- ^ Compares package ids lexically, rather than by their 'Unique's +stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2 + instance Outputable PackageId where ppr pid = text (packageIdString pid) @@ -258,9 +294,8 @@ packageIdString = unpackFS . packageIdFS -- ----------------------------------------------------------------------------- --- Package Ids that are wired in - --- Certain packages are "known" to the compiler, in that we know about certain +-- $wired_in_packages +-- 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 @@ -270,25 +305,32 @@ packageIdString = unpackFS . packageIdFS -- 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, +-- (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). - -basePackageId, rtsPackageId, haskell98PackageId, - thPackageId, ndpPackageId, mainPackageId :: PackageId -basePackageId = fsToPackageId FSLIT("base") -rtsPackageId = fsToPackageId FSLIT("rts") -haskell98PackageId = fsToPackageId FSLIT("haskell98") -thPackageId = fsToPackageId FSLIT("template-haskell") -ndpPackageId = fsToPackageId FSLIT("ndp") - --- 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") +-- had used @-ignore-package@). + +-- Make sure you change 'Packages.findWiredInPackages' if you add an entry here + +integerPackageId, primPackageId, + basePackageId, rtsPackageId, haskell98PackageId, + thPackageId, dphSeqPackageId, dphParPackageId, + 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") +dphSeqPackageId = fsToPackageId (fsLit "dph-seq") +dphParPackageId = fsToPackageId (fsLit "dph-par") + +-- | This is the package Id for the current program. It is the default +-- package Id if you don't specify a package name. We don't add this prefix +-- to symbol names, since there can be only one main package per program. +mainPackageId = fsToPackageId (fsLit "main") \end{code} %************************************************************************ @@ -298,6 +340,7 @@ mainPackageId = fsToPackageId FSLIT("main") %************************************************************************ \begin{code} +-- | A map keyed off of 'Module's type ModuleEnv elt = FiniteMap Module elt emptyModuleEnv :: ModuleEnv a @@ -346,7 +389,9 @@ foldModuleEnv f = foldFM (\_ v -> f v) \end{code} \begin{code} +-- | A set of 'Module's type ModuleSet = FiniteMap Module () + mkModuleSet :: [Module] -> ModuleSet extendModuleSet :: ModuleSet -> Module -> ModuleSet emptyModuleSet :: ModuleSet @@ -364,5 +409,6 @@ A ModuleName has a Unique, so we can build mappings of these using UniqFM. \begin{code} +-- | A map keyed off of 'ModuleName's (actually, their 'Unique's) type ModuleNameEnv elt = UniqFM elt \end{code}