X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FModule.lhs;h=8d9cb3b047af27f0fd06f81e522b96ace0ccbbff;hb=9367b24fde0c3f5efa5934e69571f5834ed43548;hp=0221a1b87fc32afe66040219cc2dfaba9fd23763;hpb=4b01f5dedecdab28e2524f7d9adc77449f596dcc;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 0221a1b..8d9cb3b 100644 --- a/compiler/basicTypes/Module.lhs +++ b/compiler/basicTypes/Module.lhs @@ -28,6 +28,8 @@ module Module packageIdString, -- * Wired-in PackageIds + primPackageId, + integerPackageId, basePackageId, rtsPackageId, haskell98PackageId, @@ -40,6 +42,7 @@ module Module modulePackageId, moduleName, pprModule, mkModule, + stableModuleCmp, -- * The ModuleLocation type ModLocation(..), @@ -62,14 +65,14 @@ module Module elemModuleSet ) where -#include "HsVersions.h" import Outputable import qualified Pretty import Unique import FiniteMap -import UniqFM +import LazyUniqFM import FastString import Binary +import Util import System.FilePath \end{code} @@ -181,6 +184,7 @@ mkModuleNameFS s = ModuleName s moduleNameSlashes :: ModuleName -> String moduleNameSlashes = dots_to_slashes . moduleNameString where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c) + \end{code} %************************************************************************ @@ -204,8 +208,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 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) + = (packageIdFS p1 `compare` packageIdFS p2) `thenCmp` + (moduleNameFS n1 `compare` moduleNameFS n2) mkModule :: PackageId -> ModuleName -> Module mkModule = Module @@ -234,9 +243,17 @@ pprPackagePrefix p mod = getPprStyle doc %************************************************************************ \begin{code} -newtype PackageId = PId FastString deriving( Eq, Ord ) -- includes the version +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 + instance Outputable PackageId where ppr pid = text (packageIdString pid) @@ -277,18 +294,21 @@ packageIdString = unpackFS . packageIdFS -- package that depends directly or indirectly on it (much as if you -- had used -ignore-package). -basePackageId, rtsPackageId, haskell98PackageId, +integerPackageId, primPackageId, + 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") +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") -- 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") +mainPackageId = fsToPackageId (fsLit "main") \end{code} %************************************************************************