X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=ff8096a9298862f0586d258cf02eeac320eee2bc;hb=3c1b89ab88b2f349a698e9eb05d0e971a670f245;hp=bbdb46a2f5f70cc86379c7a5c97ab99394fdbb19;hpb=111cee3f1ad93816cb828e38b38521d85c3bcebb;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index bbdb46a..ff8096a 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -14,18 +14,28 @@ module Name (
 	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, isUserImportedName, isUserImportedExplicitlyName, nameSrcLoc,
-	isLocallyDefinedName, isDynName,
+	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, isDynamicModule )
+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}
@@ -170,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.
@@ -407,9 +428,17 @@ 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
 
@@ -419,10 +448,14 @@ isUserImportedExplicitlyName other			           			 = False
 isUserImportedName (Name { n_prov = NonLocalDef (UserImport _ _ _) _ }) = True
 isUserImportedName other			           		= False
 
-isDynName :: Name -> Bool
-	-- Does this name come from a DLL?
-isDynName nm = not (isLocallyDefinedName nm) && 
-	       isDynamicModule (nameModule nm)
+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)
 
@@ -463,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
@@ -508,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}
 %*									*
 %************************************************************************
@@ -605,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}