\begin{code}
module Module
(
- Module -- abstract, instance of Eq, Ord, Outputable
+ Module, moduleName, mod_kind
+ -- abstract, instance of Eq, Ord, Outputable
, ModuleName
, ModuleKind(..)
- , isPackageKind
+ , isLocalModuleKind
, moduleNameString -- :: ModuleName -> EncodedString
, moduleNameUserString -- :: ModuleName -> UserString
+ , moduleNameFS -- :: ModuleName -> EncodedFS
- , moduleString -- :: Module -> EncodedString
- , moduleUserString -- :: Module -> UserString
- , moduleName -- :: Module -> ModuleName
+ , moduleString -- :: Module -> EncodedString
+ , moduleUserString -- :: Module -> UserString
+ , moduleName -- :: Module -> ModuleName
--- , mkVanillaModule -- :: ModuleName -> Module
+ , mkVanillaModule -- :: ModuleName -> Module
-- , mkThisModule -- :: ModuleName -> Module
--- , mkPrelModule -- :: UserString -> Module
- , mkModule -- :: ModuleName -> ModuleKind -> Module
-
--- , isLocalModule -- :: Module -> Bool
+ , mkPrelModule -- :: UserString -> Module
+ , mkModule -- :: ModuleName -> ModuleKind -> Module
+ , isLocalModule -- :: Module -> Bool
- , mkSrcModule
+-- , mkSrcModule
- , mkSrcModuleFS -- :: UserFS -> ModuleName
- , mkSysModuleFS -- :: EncodedFS -> ModuleName
+ , mkModuleName -- :: UserString -> ModuleName
+ , mkModuleNameFS -- :: UserFS -> ModuleName
+ , mkSysModuleNameFS -- :: EncodedFS -> ModuleName
- , pprModule, pprModuleName
+ , pprModule,
, PackageName
-- Where to find a .hi file
, WhereFrom(..)
+ , ModuleEnv,
+ , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
+ , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
+ , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
+ , rngModuleEnv, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
+
) where
#include "HsVersions.h"
import CmdLineOpts ( opt_InPackage )
import FastString ( FastString, uniqueOfFS )
import Unique ( Uniquable(..), mkUniqueGrimily )
+import UniqFM
\end{code}
from a different package.
\begin{code}
+data Module = Module ModuleName ModuleKind
+
data ModuleKind
= SourceOnly FilePath -- .hs
| ObjectCode FilePath FilePath -- .o, .hi
| InPackage PackageName
-isPackageKind (InPackage _) = True
-isPackageKind _ = False
+moduleName (Module m _) = m
+moduleKind (Module _ k) = k
+
+isLocalModuleKind (InPackage _) = False
+isLocalModuleKind _ = True
type PackageName = FastString -- No encoding at all
-preludePackage :: PackageName
-preludePackage = SLIT("std")
+preludePackage :: ModuleKind
+preludePackage = InPackage SLIT("std")
instance Outputable ModuleKind where
ppr (SourceOnly path_hs)
%************************************************************************
\begin{code}
-type ModuleName = EncodedFS
+newtype ModuleName = ModuleName EncodedFS
-- Haskell module names can include the quote character ',
-- so the module names have the z-encoding applied to them
+instance Uniquable ModuleName where
+ getUnique (ModuleName nm) = mkUniqueGrimily (uniqueOfFS nm)
+
+instance Eq ModuleName where
+ nm1 == nm2 = getUnique nm1 == getUnique nm2
+
+-- Warning: gives an ordering relation based on the uniques of the
+-- FastStrings which are the (encoded) module names. This is _not_
+-- a lexicographical ordering.
+instance Ord ModuleName where
+ nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
+
+instance Outputable ModuleName where
+ ppr = pprModuleName
+
+
pprModuleName :: ModuleName -> SDoc
-pprModuleName nm = pprEncodedFS nm
+pprModuleName (ModuleName nm) = pprEncodedFS nm
+
+moduleNameFS :: ModuleName -> EncodedFS
+moduleNameFS (ModuleName mod) = mod
moduleNameString :: ModuleName -> EncodedString
-moduleNameString mod = _UNPK_ mod
+moduleNameString (ModuleName mod) = _UNPK_ mod
moduleNameUserString :: ModuleName -> UserString
-moduleNameUserString mod = decode (_UNPK_ mod)
+moduleNameUserString (ModuleName mod) = decode (_UNPK_ mod)
-mkSrcModule :: UserString -> ModuleName
-mkSrcModule s = _PK_ (encode s)
+-- used to be called mkSrcModule
+mkModuleName :: UserString -> ModuleName
+mkModuleName s = ModuleName (_PK_ (encode s))
-mkSrcModuleFS :: UserFS -> ModuleName
-mkSrcModuleFS s = encodeFS s
+-- used to be called mkSrcModuleFS
+mkModuleNameFS :: UserFS -> ModuleName
+mkModuleNameFS s = ModuleName (encodeFS s)
-mkSysModuleFS :: EncodedFS -> ModuleName
-mkSysModuleFS s = s
-\end{code}
-
-\begin{code}
-data Module
- = Module {
- mod_name :: ModuleName,
- mod_kind :: ModuleKind
- }
+-- used to be called mkSysModuleFS
+mkSysModuleNameFS :: EncodedFS -> ModuleName
+mkSysModuleNameFS s = ModuleName s
\end{code}
\begin{code}
ppr = pprModule
instance Uniquable Module where
- getUnique (Module nm _) = mkUniqueGrimily (uniqueOfFS nm)
+ getUnique (Module nm _) = getUnique nm
-- Same if they have the same name.
instance Eq Module where
-- | otherwise = AnotherPackage pack_name
---mkVanillaModule :: ModuleName -> Module
---mkVanillaModule name = Module name ThisPackage
- -- Used temporarily when we first come across Foo.x in an interface
- -- file, but before we've opened Foo.hi.
- -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
+-- Used temporarily when we first come across Foo.x in an interface
+-- file, but before we've opened Foo.hi.
+-- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
+mkVanillaModule :: ModuleName -> Module
+mkVanillaModule name = Module name (panic "mkVanillaModule:unknown mod_kind field")
--mkThisModule :: ModuleName -> Module -- The module being compiled
--mkThisModule name = Module name ThisPackage
---mkPrelModule :: ModuleName -> Module
---mkPrelModule name = mkModule name preludePackage
+mkPrelModule :: ModuleName -> Module
+mkPrelModule name = Module name preludePackage
moduleString :: Module -> EncodedString
-moduleString (Module mod _) = _UNPK_ mod
+moduleString (Module (ModuleName fs) _) = _UNPK_ fs
moduleName :: Module -> ModuleName
moduleName (Module mod _) = mod
moduleUserString :: Module -> UserString
moduleUserString (Module mod _) = moduleNameUserString mod
+
+isLocalModule :: Module -> Bool
+isLocalModule (Module nm kind) = isLocalModuleKind kind
\end{code}
+%************************************************************************
+%* *
+\subsection{@ModuleEnv@s}
+%* *
+%************************************************************************
+
\begin{code}
---isLocalModule :: Module -> Bool
---isLocalModule (Module _ ThisPackage) = True
---isLocalModule _ = False
+type ModuleEnv elt = UniqFM elt
+
+emptyModuleEnv :: ModuleEnv a
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+unitModuleEnv :: Module -> a -> ModuleEnv a
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+extendModuleEnvList :: 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
+rngModuleEnv :: ModuleEnv a -> [a]
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
+
+elemModuleEnv = elemUFM
+extendModuleEnv = addToUFM
+extendModuleEnvList = addListToUFM
+plusModuleEnv_C = plusUFM_C
+delModuleEnvList = delListFromUFM
+delModuleEnv = delFromUFM
+plusModuleEnv = plusUFM
+lookupModuleEnv = lookupUFM
+lookupWithDefaultModuleEnv = lookupWithDefaultUFM
+mapModuleEnv = mapUFM
+mkModuleEnv = listToUFM
+emptyModuleEnv = emptyUFM
+rngModuleEnv = eltsUFM
+unitModuleEnv = unitUFM
+isEmptyModuleEnv = isNullUFM
+foldModuleEnv = foldUFM
\end{code}
projects / ghc-hetmet.git / blobdiff