X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=3aeb03b8bf49e7c87fc875418a2b26fd3bdbef10;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=a508c74132a3f287137f12e6a260a20c80a0b761;hpb=a8a2fc9c81ec4e8991a9a9f75f26c19d7f88d560;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index a508c74..3aeb03b 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -12,7 +12,7 @@ module Name (
 	Name,					-- Abstract
 	BuiltInSyntax(..), 
 	mkInternalName, mkSystemName,
-	mkSystemVarName, mkSystemVarNameEncoded, mkSysTvName, 
+	mkSystemVarName, mkSysTvName, 
 	mkFCallName, mkIPName,
 	mkExternalName, mkWiredInName,
 
@@ -21,7 +21,7 @@ module Name (
 	setNameOcc, 
 	hashName, localiseName,
 
-	nameSrcLoc, nameParent, nameParent_maybe,
+	nameSrcLoc, nameParent, nameParent_maybe, isImplicitName, 
 
 	isSystemName, isInternalName, isExternalName,
 	isTyVarName, isWiredInName, isBuiltInSyntax,
@@ -38,10 +38,11 @@ module Name (
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName		-- All of it
-import Module		( Module )
+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}
 
@@ -159,6 +160,11 @@ nameParent name = case nameParent_maybe name of
 			Just parent -> parent
 			Nothing     -> 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
@@ -210,21 +216,16 @@ mkSystemName :: Unique -> OccName -> Name
 mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System, 
 			       n_occ = occ, n_loc = noSrcLoc }
 
-mkSystemVarName :: Unique -> UserFS -> Name
-mkSystemVarName uniq fs = mkSystemName uniq (mkVarOcc fs)
-
--- Use this version when the string is already encoded.  Avoids duplicating
--- the string each time a new name is created.
-mkSystemVarNameEncoded :: Unique -> EncodedFS -> Name
-mkSystemVarNameEncoded uniq fs = mkSystemName uniq (mkSysOccFS varName fs) 
+mkSystemVarName :: Unique -> FastString -> Name
+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
 
-mkSysTvName :: Unique -> EncodedFS -> Name
-mkSysTvName uniq fs = mkSystemName uniq (mkSysOccFS tvName fs) 
+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
@@ -312,13 +313,13 @@ 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 <> 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 <> 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
@@ -327,7 +328,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
 
 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
@@ -338,15 +339,21 @@ pprInternal sty uniq occ
 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}
 
 %************************************************************************