X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FModule.lhs;h=ef93a4739ede6046e98c0a014896074479730265;hb=f278f0676579f67075033a4f9857715909c4b71e;hp=863fbdf4aa0cb73a0f97b3910e1e9c4ca2d4e50c;hpb=0b72ea61234c748c45a8ae305d5d6b8e81a67c93;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 863fbdf..ef93a47 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -37,7 +37,6 @@ module Module
 	rtsPackageId,
 	haskell98PackageId,
 	thPackageId,
-        ndpPackageId,
         dphSeqPackageId,
         dphParPackageId,
 	mainPackageId,
@@ -59,7 +58,8 @@ 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
@@ -70,15 +70,19 @@ module Module
 	emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
     ) where
 
+#include "Typeable.h"
+
+import Config
 import Outputable
 import qualified Pretty
 import Unique
 import FiniteMap
-import LazyUniqFM
+import UniqFM
 import FastString
 import Binary
 import Util
 
+import Data.Data
 import System.FilePath
 \end{code}
 
@@ -170,6 +174,14 @@ instance Binary ModuleName where
   put_ bh (ModuleName fs) = put_ bh fs
   get bh = do fs <- get bh; return (ModuleName fs)
 
+INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
+
+instance Data ModuleName where
+  -- don't traverse?
+  toConstr _   = abstractConstr "ModuleName"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "ModuleName"
+
 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 -- ^ Compares module names lexically, rather than by their 'Unique's
 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
@@ -213,6 +225,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
 
@@ -220,6 +235,14 @@ 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_TYPEABLE0(Module,moduleTc,"Module")
+
+instance Data Module where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Module"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Module"
+
 -- | 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.
@@ -267,6 +290,14 @@ instance Uniquable PackageId where
 instance Ord PackageId where
   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 
+INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
+
+instance Data PackageId where
+  -- don't traverse?
+  toConstr _   = abstractConstr "PackageId"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "PackageId"
+
 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
 -- ^ Compares package ids lexically, rather than by their 'Unique's
 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
@@ -303,7 +334,7 @@ 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
+-- (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
@@ -314,15 +345,14 @@ packageIdString = unpackFS . packageIdFS
 
 integerPackageId, primPackageId,
   basePackageId, rtsPackageId, haskell98PackageId,
-  thPackageId, ndpPackageId, dphSeqPackageId, dphParPackageId,
+  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")
 
@@ -340,51 +370,71 @@ mainPackageId	   = fsToPackageId (fsLit "main")
 
 \begin{code}
 -- | A map keyed off of 'Module's
-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
+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}