X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FModule.lhs;h=57509a00fed8049d4bcdb24393ea871de7a2b6d6;hp=9d60247b55c69eaa0b94531c350e273aa1aa583b;hb=48b6c777e2e84cc42a27a50642bcb41a0bd2c1d7;hpb=98c68a1c5b63aadf9c7917274519d95bbe9394d4 diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs index 9d60247..57509a0 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 + 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(..), @@ -62,14 +69,16 @@ 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} %************************************************************************ @@ -156,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 -> @@ -178,7 +191,7 @@ 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 '/' else c) + where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c) \end{code} %************************************************************************ @@ -202,8 +215,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) + = (p1 `stablePackageIdCmp` p2) `thenCmp` + (n1 `stableModuleNameCmp` n2) mkModule :: PackageId -> ModuleName -> Module mkModule = Module @@ -232,9 +250,20 @@ 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 + +stablePackageIdCmp :: PackageId -> PackageId -> Ordering +stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2 + instance Outputable PackageId where ppr pid = text (packageIdString pid) @@ -275,18 +304,23 @@ 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") +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") +mainPackageId = fsToPackageId (fsLit "main") \end{code} %************************************************************************