Module
~~~~~~~~~~
Simply the name of a module, represented as a FastString.
-These are Uniquable, hence we can build FiniteMaps with Modules as
+These are Uniquable, hence we can build Maps with Modules as
the keys.
\begin{code}
integerPackageId,
basePackageId,
rtsPackageId,
- haskell98PackageId,
- sybPackageId,
thPackageId,
- ndpPackageId,
dphSeqPackageId,
dphParPackageId,
mainPackageId,
extendModuleEnvList_C, plusModuleEnv_C,
delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
- moduleEnvKeys, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv,
- foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
+ moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+ unitModuleEnv, isEmptyModuleEnv,
+ foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
-- * ModuleName mappings
ModuleNameEnv,
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 Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
import System.FilePath
\end{code}
\begin{code}
-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
newtype ModuleName = ModuleName FastString
+ deriving Typeable
instance Uniquable ModuleName where
getUnique (ModuleName nm) = getUnique nm
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
+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
modulePackageId :: !PackageId, -- pkg-1.0
moduleName :: !ModuleName -- A.B.C
}
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Typeable)
instance Uniquable Module where
getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
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 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.
mkModule = Module
pprModule :: Module -> SDoc
-pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
+pprModule mod@(Module p n) =
+ pprPackagePrefix p mod <> pprModuleName n
-pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
+pprPackagePrefix :: PackageId -> Module -> SDoc
pprPackagePrefix p mod = getPprStyle doc
where
doc sty
\begin{code}
-- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
-newtype PackageId = PId FastString deriving( Eq )
+newtype PackageId = PId FastString deriving( Eq, Typeable )
-- here to avoid module loops with PackageConfig
instance Uniquable PackageId where
instance Ord PackageId where
nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
+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
-- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
integerPackageId, primPackageId,
- basePackageId, rtsPackageId, haskell98PackageId, sybPackageId,
- thPackageId, ndpPackageId, dphSeqPackageId, dphParPackageId,
+ basePackageId, rtsPackageId,
+ 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")
-sybPackageId = fsToPackageId (fsLit "syb")
+rtsPackageId = fsToPackageId (fsLit "rts")
thPackageId = fsToPackageId (fsLit "template-haskell")
-ndpPackageId = fsToPackageId (fsLit "ndp")
dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
dphParPackageId = fsToPackageId (fsLit "dph-par")
\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 (Map Module elt)
+
+filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
+filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
+
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+elemModuleEnv m (ModuleEnv e) = Map.member m e
+
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
+
+extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
+
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
+
+extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
+ -> ModuleEnv a
+extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
+
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
+
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
+
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
+
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
+
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 = Map.findWithDefault x m e
+
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
+
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+mkModuleEnv xs = ModuleEnv (Map.fromList xs)
+
+emptyModuleEnv :: ModuleEnv a
+emptyModuleEnv = ModuleEnv Map.empty
+
+moduleEnvKeys :: ModuleEnv a -> [Module]
+moduleEnvKeys (ModuleEnv e) = Map.keys e
+
+moduleEnvElts :: ModuleEnv a -> [a]
+moduleEnvElts (ModuleEnv e) = Map.elems e
+
+moduleEnvToList :: ModuleEnv a -> [(Module, a)]
+moduleEnvToList (ModuleEnv e) = Map.toList e
+
+unitModuleEnv :: Module -> a -> ModuleEnv a
+unitModuleEnv m x = ModuleEnv (Map.singleton m x)
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+isEmptyModuleEnv (ModuleEnv e) = Map.null e
+
+foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
+foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
\end{code}
\begin{code}
-- | A set of 'Module's
-type ModuleSet = FiniteMap Module ()
+type ModuleSet = Map Module ()
mkModuleSet :: [Module] -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
moduleSetElts :: ModuleSet -> [Module]
elemModuleSet :: Module -> ModuleSet -> Bool
-emptyModuleSet = emptyFM
-mkModuleSet ms = listToFM [(m,()) | m <- ms ]
-extendModuleSet s m = addToFM s m ()
-moduleSetElts = keysFM
-elemModuleSet = elemFM
+emptyModuleSet = Map.empty
+mkModuleSet ms = Map.fromList [(m,()) | m <- ms ]
+extendModuleSet s m = Map.insert m () s
+moduleSetElts = Map.keys
+elemModuleSet = Map.member
\end{code}
A ModuleName has a Unique, so we can build mappings of these using
projects / ghc-hetmet.git / blobdiff