[project @ 2000-10-03 08:43:00 by simonpj]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index ff8096a..ddfae90 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -13,7 +13,7 @@ module Name (
        mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
        mkTopName, mkIPName,
        mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
-       mkWiredInIdName,   mkWiredInTyConName,
+       mkWiredInIdName, mkWiredInTyConName,
        mkUnboundName, isUnboundName,
 
        maybeWiredInIdName, maybeWiredInTyConName,
@@ -28,13 +28,14 @@ module Name (
        nameSrcLoc, isLocallyDefinedName, isDllName,
 
        isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
+       isTyVarName,
        
        -- Environment
-       NameEnv,
+       NameEnv, mkNameEnv,
        emptyNameEnv, unitNameEnv, nameEnvElts, 
-       addToNameEnv_C, addToNameEnv, addListToNameEnv,
-       plusNameEnv, plusNameEnv_C, extendNameEnv, 
-       lookupNameEnv, delFromNameEnv, elemNameEnv, 
+       extendNameEnv_C, extendNameEnv, 
+       plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
+       lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv, 
 
 
        -- Provenance
@@ -58,7 +59,9 @@ import RdrName                ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
 import CmdLineOpts     ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
 
 import SrcLoc          ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
-import Unique          ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
+import Unique          ( Unique, Uniquable(..), u2i, hasKey, pprUnique )
+import PrelNames       ( unboundKey )
+import Maybes          ( expectJust )
 import UniqFM
 import Outputable
 import GlaExts
@@ -119,8 +122,8 @@ mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod,
                                        n_occ = occ, n_prov = prov }
                                
 
-mkKnownKeyGlobal :: (RdrName, Unique) -> Name
-mkKnownKeyGlobal (rdr_name, uniq)
+mkKnownKeyGlobal :: RdrName -> Unique -> Name
+mkKnownKeyGlobal rdr_name uniq
   = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
                      (rdrNameOcc rdr_name)
                      systemProvenance
@@ -164,13 +167,10 @@ mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
 mkWiredInIdName uniq mod occ id = Name { n_uniq = uniq, n_sort = WiredInId mod id,
                                         n_occ = occ, n_prov = SystemProv }
 
--- mkWiredInTyConName takes a FAST_STRING instead of
--- an OccName, which is a bit yukky but that's what the 
--- clients find easiest.
-mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name
-mkWiredInTyConName uniq mod fs tycon
+mkWiredInTyConName :: Unique -> Module -> OccName -> TyCon -> Name
+mkWiredInTyConName uniq mod occ tycon
   = Name { n_uniq = uniq, n_sort = WiredInTyCon mod tycon,
-          n_occ = mkSrcOccFS tcName fs, n_prov = SystemProv }
+          n_occ = occ, n_prov = SystemProv }
 
 
 ---------------------------------------------------------------------
@@ -455,6 +455,7 @@ isDllName :: Name -> Bool
        -- Does this name refer to something in a different DLL?
 isDllName nm = not opt_Static &&
               not (isLocallyDefinedName nm) && 
+-- isLocallyDefinedName test is needed because nameModule won't work on local names
               not (isLocalModule (nameModule nm))
 
 nameSrcLoc name = provSrcLoc (n_prov name)
@@ -490,6 +491,9 @@ isLocalName _                           = False
 isGlobalName (Name {n_sort = Local}) = False
 isGlobalName other                  = True
 
+isTyVarName :: Name -> Bool
+isTyVarName name = isTvOcc (nameOccName name)
+
 -- Global names are by definition those that are visible
 -- outside the module, *as seen by the linker*.  Externally visible
 -- does not mean visible at the source level (that's isExported).
@@ -552,30 +556,35 @@ instance NamedThing Name where
 type NameEnv a = UniqFM a      -- Domain is Name
 
 emptyNameEnv            :: NameEnv a
+mkNameEnv       :: [(Name,a)] -> NameEnv a
 nameEnvElts             :: NameEnv a -> [a]
-addToNameEnv_C          :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
-addToNameEnv            :: NameEnv a -> Name -> a -> NameEnv a
-addListToNameEnv :: NameEnv a -> [(Name,a)] -> NameEnv a
+extendNameEnv_C  :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
+extendNameEnv           :: NameEnv a -> Name -> a -> NameEnv a
 plusNameEnv             :: NameEnv a -> NameEnv a -> NameEnv a
 plusNameEnv_C           :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
-extendNameEnv           :: NameEnv a -> [(Name,a)] -> NameEnv a
-lookupNameEnv           :: NameEnv a -> Name -> Maybe a
+extendNameEnvList:: NameEnv a -> [(Name,a)] -> NameEnv a
 delFromNameEnv          :: NameEnv a -> Name -> NameEnv a
 elemNameEnv             :: Name -> NameEnv a -> Bool
 unitNameEnv             :: Name -> a -> NameEnv a
+lookupNameEnv           :: NameEnv a -> Name -> Maybe a
+lookupNameEnv_NF :: NameEnv a -> Name -> a
+mapNameEnv      :: (a->b) -> NameEnv a -> NameEnv b
 
 emptyNameEnv            = emptyUFM
+mkNameEnv       = listToUFM
 nameEnvElts             = eltsUFM
-addToNameEnv_C          = addToUFM_C
-addToNameEnv            = addToUFM
-addListToNameEnv = addListToUFM
+extendNameEnv_C  = addToUFM_C
+extendNameEnv           = addToUFM
 plusNameEnv             = plusUFM
 plusNameEnv_C           = plusUFM_C
-extendNameEnv           = addListToUFM
-lookupNameEnv           = lookupUFM
+extendNameEnvList= addListToUFM
 delFromNameEnv          = delFromUFM
 elemNameEnv             = elemUFM
+mapNameEnv      = mapUFM
 unitNameEnv             = unitUFM
+
+lookupNameEnv                 = lookupUFM
+lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupUFM env n)
 \end{code}