[project @ 2000-06-12 11:04:50 by panne]
[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs
index 46e0a01..ff8096a 100644 (file)
@@ -10,22 +10,32 @@ module Name (
 
        -- The Name type
        Name,                                   -- Abstract
-       mkLocalName, mkImportedLocalName, mkSysLocalName, 
-       mkTopName,
+       mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
+       mkTopName, mkIPName,
        mkDerivedName, mkGlobalName, mkKnownKeyGlobal,
        mkWiredInIdName,   mkWiredInTyConName,
+       mkUnboundName, isUnboundName,
+
        maybeWiredInIdName, maybeWiredInTyConName,
        isWiredInName, hashName,
 
        nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason,
        tidyTopName, 
-       nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule,
+       nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName,
 
-       isUserExportedName, isUserImportedExplicitlyName, nameSrcLoc,
-       isLocallyDefinedName,
+       isUserExportedName, isUserImportedName, isUserImportedExplicitlyName, 
+       maybeUserImportedFrom,
+       nameSrcLoc, isLocallyDefinedName, isDllName,
 
        isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
        
+       -- Environment
+       NameEnv,
+       emptyNameEnv, unitNameEnv, nameEnvElts, 
+       addToNameEnv_C, addToNameEnv, addListToNameEnv,
+       plusNameEnv, plusNameEnv_C, extendNameEnv, 
+       lookupNameEnv, delFromNameEnv, elemNameEnv, 
+
 
        -- Provenance
        Provenance(..), ImportReason(..), pprProvenance,
@@ -34,7 +44,7 @@ module Name (
 
        -- Class NamedThing and overloaded friends
        NamedThing(..),
-       getSrcLoc, isLocallyDefined, getOccString
+       getSrcLoc, isLocallyDefined, getOccString, toRdrName
     ) where
 
 #include "HsVersions.h"
@@ -43,12 +53,13 @@ import {-# SOURCE #-} Var   ( Id, setIdName )
 import {-# SOURCE #-} TyCon ( TyCon, setTyConName )
 
 import OccName         -- All of it
-import Module          ( Module, moduleName, pprModule, mkVanillaModule )
+import Module          ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule )
 import RdrName         ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
-import CmdLineOpts     ( opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
+import CmdLineOpts     ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
 
 import SrcLoc          ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
-import Unique          ( pprUnique, Unique, Uniquable(..), u2i )
+import Unique          ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
+import UniqFM
 import Outputable
 import GlaExts
 \end{code}
@@ -118,6 +129,12 @@ mkSysLocalName :: Unique -> UserFS -> Name
 mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local, 
                                n_occ = mkSrcVarOcc fs, n_prov = systemProvenance }
 
+mkCCallName :: Unique -> EncodedString -> Name
+       -- The encoded string completely describes the ccall
+mkCCallName uniq str =  Name { n_uniq = uniq, n_sort = Local, 
+                              n_occ = mkCCallOcc str, 
+                              n_prov = NonLocalDef ImplicitImport True }
+
 mkTopName :: Unique -> Module -> FAST_STRING -> Name
        -- Make a top-level name; make it Global if top-level
        -- things should be externally visible; Local otherwise
@@ -133,6 +150,14 @@ mkTopName uniq mod fs
           n_occ  = mkSrcVarOcc (_PK_ ((_UNPK_ fs) ++ show uniq)),
           n_prov = LocalDef noSrcLoc NotExported }
 
+mkIPName :: Unique -> OccName -> Name
+mkIPName uniq occ
+  = Name { n_uniq = uniq,
+          n_sort = Local,
+          n_occ  = occ,
+          -- ZZ is this an appropriate provinence?
+          n_prov = SystemProv }
+
 ------------------------- Wired in names -------------------------
 
 mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
@@ -156,6 +181,16 @@ mkDerivedName :: (OccName -> OccName)
 
 mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)}
 
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: RdrName -> Name
+mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
+
+isUnboundName :: Name -> Bool
+isUnboundName name = name `hasKey` unboundKey
+\end{code}
+
+\begin{code}
 -- When we renumber/rename things, we need to be
 -- able to change a Name's Unique to match the cached
 -- one in the thing it's the name of.  If you know what I mean.
@@ -233,6 +268,7 @@ all_toplev_ids_visible =
        opt_EnsureSplittableC            -- Splitting requires visiblilty
 \end{code}
 
+
 \begin{code}
 setNameProvenance :: Name -> Provenance -> Name        
        -- setNameProvenance used to only change the provenance of 
@@ -392,15 +428,35 @@ nameSortModule (WiredInId    mod _) = mod
 nameSortModule (WiredInTyCon mod _) = mod
 
 nameRdrName :: Name -> RdrName
+-- Makes a qualified name for top-level (Global) names, whether locally defined or not
+-- and an unqualified name just for Locals
 nameRdrName (Name { n_sort = Local, n_occ = occ }) = mkRdrUnqual occ
 nameRdrName (Name { n_sort = sort,  n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ
 
+ifaceNameRdrName :: Name -> RdrName
+-- Makes a qualified naem for imported things, 
+-- and an unqualified one for local things
+ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
+                  | otherwise          = mkRdrQual   (moduleName (nameModule n)) (nameOccName n) 
+
 isUserExportedName (Name { n_prov = LocalDef _ Exported }) = True
 isUserExportedName other                                  = False
 
 isUserImportedExplicitlyName (Name { n_prov = NonLocalDef (UserImport _ _ explicit) _ }) = explicit
 isUserImportedExplicitlyName other                                                      = False
 
+isUserImportedName (Name { n_prov = NonLocalDef (UserImport _ _ _) _ }) = True
+isUserImportedName other                                               = False
+
+maybeUserImportedFrom (Name { n_prov = NonLocalDef (UserImport m _ _) _ }) = Just m
+maybeUserImportedFrom other                                               = Nothing
+
+isDllName :: Name -> Bool
+       -- Does this name refer to something in a different DLL?
+isDllName nm = not opt_Static &&
+              not (isLocallyDefinedName nm) && 
+              not (isLocalModule (nameModule nm))
+
 nameSrcLoc name = provSrcLoc (n_prov name)
 
 provSrcLoc (LocalDef loc _)                    = loc        
@@ -440,13 +496,16 @@ isGlobalName other                     = True
 isExternallyVisibleName name = isGlobalName name
 
 hasBetterProv :: Name -> Name -> Bool
-hasBetterProv name1 name2
-  = case n_prov name1 of
-       LocalDef _ _    -> True
-       SystemProv      -> False
-       NonLocalDef _ _ -> case n_prov name2 of
-                               LocalDef _ _ -> False
-                               other        -> True
+-- Choose 
+--     a local thing                 over an   imported thing
+--     a user-imported thing         over a    non-user-imported thing
+--     an explicitly-imported thing  over an   implicitly imported thing
+hasBetterProv n1 n2
+  = case (n_prov n1, n_prov n2) of
+       (LocalDef _ _,                        _                           ) -> True
+       (NonLocalDef (UserImport _ _ True) _, _                           ) -> True
+       (NonLocalDef (UserImport _ _ _   ) _, NonLocalDef ImplicitImport _) -> True
+       other                                                               -> False
 
 isSystemName (Name {n_prov = SystemProv}) = True
 isSystemName other                       = False
@@ -485,6 +544,43 @@ instance NamedThing Name where
 
 %************************************************************************
 %*                                                                     *
+\subsection{Name environment}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type NameEnv a = UniqFM a      -- Domain is Name
+
+emptyNameEnv            :: 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
+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
+delFromNameEnv          :: NameEnv a -> Name -> NameEnv a
+elemNameEnv             :: Name -> NameEnv a -> Bool
+unitNameEnv             :: Name -> a -> NameEnv a
+
+emptyNameEnv            = emptyUFM
+nameEnvElts             = eltsUFM
+addToNameEnv_C          = addToUFM_C
+addToNameEnv            = addToUFM
+addListToNameEnv = addListToUFM
+plusNameEnv             = plusUFM
+plusNameEnv_C           = plusUFM_C
+extendNameEnv           = addListToUFM
+lookupNameEnv           = lookupUFM
+delFromNameEnv          = delFromUFM
+elemNameEnv             = elemUFM
+unitNameEnv             = unitUFM
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Pretty printing}
 %*                                                                     *
 %************************************************************************
@@ -582,10 +678,12 @@ class NamedThing a where
 getSrcLoc          :: NamedThing a => a -> SrcLoc
 isLocallyDefined    :: NamedThing a => a -> Bool
 getOccString       :: NamedThing a => a -> String
+toRdrName          :: NamedThing a => a -> RdrName
 
 getSrcLoc          = nameSrcLoc           . getName
 isLocallyDefined    = isLocallyDefinedName . getName
 getOccString x     = occNameString (getOccName x)
+toRdrName          = ifaceNameRdrName     . getName
 \end{code}
 
 \begin{code}