Remove LazyUniqFM; fixes trac #3880
[ghc-hetmet.git] / compiler / basicTypes / Module.lhs
index 5047be1..f751380 100644 (file)
@@ -19,6 +19,7 @@ module Module
         moduleNameSlashes,
        mkModuleName,
        mkModuleNameFS,
+       stableModuleNameCmp,
 
         -- * The PackageId type
         PackageId,
@@ -26,15 +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
@@ -42,6 +46,7 @@ module Module
        modulePackageId, moduleName,
        pprModule,
        mkModule,
+        stableModuleCmp,
 
        -- * The ModuleLocation type
        ModLocation(..),
@@ -53,24 +58,27 @@ module Module
        extendModuleEnvList_C, plusModuleEnv_C,
        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
-       moduleEnvKeys, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv,
+       moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+        unitModuleEnv, isEmptyModuleEnv,
         foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
 
        -- * ModuleName mappings
        ModuleNameEnv,
 
-       -- * Sets of modules
-       ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet,
-       elemModuleSet
+       -- * Sets of Modules
+       ModuleSet, 
+       emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
     ) where
 
+import Config
 import Outputable
 import qualified Pretty
 import Unique
 import FiniteMap
-import LazyUniqFM
+import UniqFM
 import FastString
 import Binary
+import Util
 
 import System.FilePath
 \end{code}
@@ -82,6 +90,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,
@@ -114,15 +124,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)
@@ -137,7 +149,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
@@ -159,6 +171,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 ->
@@ -178,7 +194,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)
@@ -198,6 +214,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
 
@@ -205,8 +224,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
@@ -235,9 +259,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)
 
@@ -259,9 +296,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
@@ -271,27 +307,31 @@ 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).
+-- had used @-ignore-package@).
+
+-- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 
 integerPackageId, primPackageId,
   basePackageId, rtsPackageId, haskell98PackageId,
-  thPackageId, ndpPackageId, mainPackageId  :: PackageId
+  thPackageId, dphSeqPackageId, dphParPackageId,
+  mainPackageId  :: PackageId
 primPackageId      = fsToPackageId (fsLit "ghc-prim")
-integerPackageId   = fsToPackageId (fsLit "integer")
+integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
 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.
+-- | 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}
 
@@ -302,55 +342,78 @@ mainPackageId        = fsToPackageId (fsLit "main")
 %************************************************************************
 
 \begin{code}
-type ModuleEnv elt = FiniteMap Module elt
-
-emptyModuleEnv       :: ModuleEnv a
-mkModuleEnv          :: [(Module, a)] -> ModuleEnv a
-unitModuleEnv        :: Module -> a -> ModuleEnv a
-extendModuleEnv      :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv_C    :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
-plusModuleEnv        :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-extendModuleEnvList  :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-extendModuleEnvList_C  :: (a->a->a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-                  
-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
-lookupModuleEnv      :: ModuleEnv a -> Module     -> Maybe a
+-- | A map keyed off of 'Module's
+newtype ModuleEnv elt = ModuleEnv (FiniteMap Module elt)
+
+filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
+filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)
+
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+elemModuleEnv m (ModuleEnv e) = elemFM m e
+
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)
+
+extendModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv_C f (ModuleEnv e) m x = ModuleEnv (addToFM_C f e m x)
+
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)
+
+extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
+                      -> ModuleEnv a
+extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)
+
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)
+
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)
+
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)
+
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupModuleEnv (ModuleEnv e) m = lookupFM e m
+
 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
-
-filterModuleEnv f   = filterFM (\_ v -> f v)
-elemModuleEnv       = elemFM
-extendModuleEnv     = addToFM
-extendModuleEnv_C   = addToFM_C
-extendModuleEnvList = addListToFM
-extendModuleEnvList_C = addListToFM_C
-plusModuleEnv_C     = plusFM_C
-delModuleEnvList    = delListFromFM
-delModuleEnv        = delFromFM
-plusModuleEnv       = plusFM
-lookupModuleEnv     = lookupFM
-lookupWithDefaultModuleEnv = lookupWithDefaultFM
-mapModuleEnv f      = mapFM (\_ v -> f v)
-mkModuleEnv         = listToFM
-emptyModuleEnv      = emptyFM
-moduleEnvKeys       = keysFM
-moduleEnvElts       = eltsFM
-unitModuleEnv       = unitFM
-isEmptyModuleEnv    = isEmptyFM
-foldModuleEnv f     = foldFM (\_ v -> f v)
+lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m
+
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)
+
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+mkModuleEnv xs = ModuleEnv (listToFM xs)
+
+emptyModuleEnv :: ModuleEnv a
+emptyModuleEnv = ModuleEnv emptyFM
+
+moduleEnvKeys :: ModuleEnv a -> [Module]
+moduleEnvKeys (ModuleEnv e) = keysFM e
+
+moduleEnvElts :: ModuleEnv a -> [a]
+moduleEnvElts (ModuleEnv e) = eltsFM e
+
+moduleEnvToList :: ModuleEnv a -> [(Module, a)]
+moduleEnvToList (ModuleEnv e) = fmToList e
+
+unitModuleEnv :: Module -> a -> ModuleEnv a
+unitModuleEnv m x = ModuleEnv (unitFM m x)
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e
+
+foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
+foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
 \end{code}
 
 \begin{code}
+-- | A set of 'Module's
 type ModuleSet = FiniteMap Module ()
+
 mkModuleSet    :: [Module] -> ModuleSet
 extendModuleSet :: ModuleSet -> Module -> ModuleSet
 emptyModuleSet  :: ModuleSet
@@ -368,5 +431,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}