X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=1e1fb31f846afd7ed2bbf709d9ecc7192ed99d17;hb=ac10f8408520a30e8437496d320b8b86afda2e8f;hp=c440369916dfd984a5d58d51611519341e90d3e5;hpb=23f40f0e9be6d4aa5cf9ea31d73f4013f8e7b4bd;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index c440369..1e1fb31 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -11,22 +11,22 @@ module Name (
 	-- The Name type
 	Name,					-- Abstract
 	BuiltInSyntax(..), 
-	mkInternalName, mkSystemName, 
-	mkSystemNameEncoded, mkSysTvName, 
+	mkInternalName, mkSystemName,
+	mkSystemVarName, mkSysTvName, 
 	mkFCallName, mkIPName,
 	mkExternalName, mkWiredInName,
 
 	nameUnique, setNameUnique,
-	nameOccName, nameModule, nameModule_maybe, nameModuleName,
-	setNameOcc, 
+	nameOccName, nameModule, nameModule_maybe,
+	tidyNameOcc, 
 	hashName, localiseName,
 
-	nameSrcLoc, nameParent, nameParent_maybe,
+	nameSrcLoc, nameParent, nameParent_maybe, isImplicitName, 
 
 	isSystemName, isInternalName, isExternalName,
-	isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
+	isTyVarName, isWiredInName, isBuiltInSyntax,
 	wiredInNameTyThing_maybe, 
-	nameIsLocalOrFrom, isHomePackageName,
+	nameIsLocalOrFrom,
 	
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
@@ -38,11 +38,11 @@ module Name (
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName		-- All of it
-import Module		( Module, ModuleName, moduleName, isHomeModule )
-import CmdLineOpts	( opt_Static )
+import Module		( Module, moduleFS )
 import SrcLoc		( noSrcLoc, wiredInSrcLoc, SrcLoc )
 import Unique		( Unique, Uniquable(..), getKey, pprUnique )
-import Maybes		( orElse )
+import Maybes		( orElse, isJust )
+import FastString	( FastString, zEncodeFS )
 import Outputable
 \end{code}
 
@@ -120,7 +120,6 @@ All built-in syntax is for wired-in things.
 nameUnique		:: Name -> Unique
 nameOccName		:: Name -> OccName 
 nameModule		:: Name -> Module
-nameModuleName		:: Name -> ModuleName
 nameSrcLoc		:: Name -> SrcLoc
 
 nameUnique  name = n_uniq name
@@ -133,7 +132,6 @@ nameIsLocalOrFrom :: Module -> Name -> Bool
 isInternalName	  :: Name -> Bool
 isExternalName	  :: Name -> Bool
 isSystemName	  :: Name -> Bool
-isHomePackageName :: Name -> Bool
 isWiredInName	  :: Name -> Bool
 
 isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
@@ -162,9 +160,12 @@ nameParent name = case nameParent_maybe name of
 			Just parent -> parent
 			Nothing     -> name
 
-nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
-nameModuleName name = moduleName (nameModule name)
+isImplicitName :: Name -> Bool
+-- An Implicit Name is one has a parent; that is, one whose definition
+-- derives from the parent thing
+isImplicitName name = isJust (nameParent_maybe name)
 
+nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
 nameModule_maybe (Name { n_sort = External mod _})    = Just mod
 nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
 nameModule_maybe name				      = Nothing
@@ -173,13 +174,6 @@ nameIsLocalOrFrom from name
   | isExternalName name = from == nameModule name
   | otherwise		= True
 
-isHomePackageName name
-  | isExternalName name = isHomeModule (nameModule name)
-  | otherwise		= True  	-- Internal and system names
-
-isDllName :: Name -> Bool	-- Does this name refer to something in a different DLL?
-isDllName nm = not opt_Static && not (isHomePackageName nm)
-
 isTyVarName :: Name -> Bool
 isTyVarName name = isTvOcc (nameOccName name)
 
@@ -218,26 +212,20 @@ mkWiredInName mod occ uniq mb_parent thing built_in
 	   n_sort = WiredIn mod mb_parent thing built_in,
 	   n_occ = occ, n_loc = wiredInSrcLoc }
 
-mkSystemName :: Unique -> UserFS -> Name
-mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System, 
-			      n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+mkSystemName :: Unique -> OccName -> Name
+mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System, 
+			       n_occ = occ, n_loc = noSrcLoc }
 
--- Use this version when the string is already encoded.  Avoids duplicating
--- the string each time a new name is created.
-mkSystemNameEncoded :: Unique -> EncodedFS -> Name
-mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System, 
-			             n_occ = mkSysOccFS varName fs, 
-				     n_loc = noSrcLoc }
+mkSystemVarName :: Unique -> FastString -> Name
+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
 
-mkSysTvName :: Unique -> EncodedFS -> Name
-mkSysTvName uniq fs = Name { n_uniq = uniq, n_sort = System, 
-		             n_occ = mkSysOccFS tvName fs, 
-			     n_loc = noSrcLoc }
+mkSysTvName :: Unique -> FastString -> Name
+mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) 
 
-mkFCallName :: Unique -> EncodedString -> Name
+mkFCallName :: Unique -> String -> Name
 	-- The encoded string completely describes the ccall
 mkFCallName uniq str =  Name { n_uniq = uniq, n_sort = Internal, 
-			       n_occ = mkFCallOcc str, n_loc = noSrcLoc }
+			       n_occ = mkVarOcc str, n_loc = noSrcLoc }
 
 mkIPName :: Unique -> OccName -> Name
 mkIPName uniq occ
@@ -253,8 +241,12 @@ mkIPName uniq occ
 -- one in the thing it's the name of.  If you know what I mean.
 setNameUnique name uniq = name {n_uniq = uniq}
 
-setNameOcc :: Name -> OccName -> Name
-setNameOcc name occ = name {n_occ = occ}
+tidyNameOcc :: Name -> OccName -> Name
+-- We set the OccName of a Name when tidying
+-- In doing so, we change System --> Internal, so that when we print
+-- it we don't get the unique by default.  It's tidy now!
+tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
+tidyNameOcc name 			    occ = name { n_occ = occ }
 
 localiseName :: Name -> Name
 localiseName n = n { n_sort = Internal }
@@ -311,7 +303,6 @@ instance NamedThing Name where
 
 \begin{code}
 instance Outputable Name where
-	-- When printing interfaces, all Internals have been given nice print-names
     ppr name = pprName name
 
 instance OutputableBndr Name where
@@ -326,40 +317,47 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
       Internal    	      -> pprInternal sty uniq occ
 
 pprExternal sty uniq mod occ is_wired is_builtin
-  | codeStyle sty        = ppr mod_name <> char '_' <> ppr_occ_name occ
+  | codeStyle sty        = ppr_z_module mod <> char '_' <> ppr_z_occ_name occ
 	-- In code style, always qualify
 	-- ToDo: maybe we could print all wired-in things unqualified
 	-- 	 in code style, to reduce symbol table bloat?
-  | debugStyle sty       = ppr mod_name <> dot <> ppr_occ_name occ
+  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
 			   <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
-					    text (briefOccNameFlavour occ), 
+					    pprNameSpaceBrief (occNameSpace occ), 
 		 			    pprUnique uniq])
   | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
 	-- never qualify builtin syntax
-  | unqualStyle sty mod_name occ = ppr_occ_name occ
-  | otherwise		 	 = ppr mod_name <> dot <> ppr_occ_name occ
-  where
-    mod_name = moduleName mod
+  | unqualStyle sty mod occ = ppr_occ_name occ
+  | otherwise		    = ppr mod <> dot <> ppr_occ_name occ
 
 pprInternal sty uniq occ
   | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = ppr_occ_name occ <> braces (hsep [text (briefOccNameFlavour occ), 
+  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ), 
 				 		       pprUnique uniq])
+  | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique uniq
+			-- For debug dumps, we're not necessarily dumping
+			-- tidied code, so we need to print the uniques.
   | otherwise      = ppr_occ_name occ	-- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
 pprSystem sty uniq occ
   | codeStyle sty  = pprUnique uniq
   | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
-		     <> braces (text (briefOccNameFlavour occ))
+		     <> braces (pprNameSpaceBrief (occNameSpace occ))
   | otherwise	   = ppr_occ_name occ <> char '_' <> pprUnique uniq
 				-- If the tidy phase hasn't run, the OccName
 				-- is unlikely to be informative (like 's'),
 				-- so print the unique
 
-ppr_occ_name occ = pprEncodedFS (occNameFS occ)
+ppr_occ_name occ = ftext (occNameFS occ)
 	-- Don't use pprOccName; instead, just print the string of the OccName; 
 	-- we print the namespace in the debug stuff above
+
+-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
+-- cached behind the scenes in the FastString implementation.
+ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
+ppr_z_module   mod = ftext (zEncodeFS (moduleFS mod))
+
 \end{code}
 
 %************************************************************************