X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FName.lhs;h=bbc249f053a5697c6336564e111c6a30138c9f1a;hb=0abe050cfddb8fee8c11f382266d73078d9008f7;hp=7dc6fe92093884612b39aa6fb567de4fe1236ba3;hpb=6c4e3c1ce1ee67c6355a811a6d4698efb343e361;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs
index 7dc6fe9..bbc249f 100644
--- a/compiler/basicTypes/Name.lhs
+++ b/compiler/basicTypes/Name.lhs
@@ -32,26 +32,22 @@ module Name (
 	
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
-	getSrcLoc, getSrcSpan, getOccString
+	getSrcLoc, getSrcSpan, getOccString,
+ 	pprInfixName, pprPrefixName
     ) where
 
-#include "HsVersions.h"
-
 import {-# SOURCE #-} TypeRep( TyThing )
 
 import OccName
 import Module
 import SrcLoc
-import UniqFM
 import Unique
 import Maybes
 import Binary
-import FastMutInt
 import FastTypes
 import FastString
 import Outputable
 
-import Data.IORef
 import Data.Array
 \end{code}
 
@@ -311,20 +307,9 @@ instance NamedThing Name where
 
 \begin{code}
 instance Binary Name where
-   put_ bh name = do
-      case getUserData bh of { 
-        UserData { ud_symtab_map = symtab_map_ref,
-                   ud_symtab_next = symtab_next } -> do
-         symtab_map <- readIORef symtab_map_ref
-         case lookupUFM symtab_map name of
-           Just (off,_) -> put_ bh off
-           Nothing -> do
-              off <- readFastMutInt symtab_next
-              writeFastMutInt symtab_next (off+1)
-              writeIORef symtab_map_ref
-                  $! addToUFM symtab_map name (off,name)
-              put_ bh off          
-     }
+   put_ bh name =
+      case getUserData bh of 
+        UserData{ ud_put_name = put_name } -> put_name bh name
 
    get bh = do
         i <- get bh
@@ -361,7 +346,7 @@ pprExternal sty uniq mod occ is_wired is_builtin
 	-- 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,
+		<> braces (hsep [if is_wired then ptext (sLit "(w)") else empty,
 				 pprNameSpaceBrief (occNameSpace occ), 
 		 		 pprUnique uniq])
   | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
@@ -411,8 +396,8 @@ pprNameLoc :: Name -> SDoc
 pprNameLoc name
   | isGoodSrcSpan loc = pprDefnLoc loc
   | isInternalName name || isSystemName name 
-                      = ptext SLIT("<no location info>")
-  | otherwise         = ptext SLIT("Defined in ") <> ppr (nameModule name)
+                      = ptext (sLit "<no location info>")
+  | otherwise         = ptext (sLit "Defined in ") <> ppr (nameModule name)
   where loc = nameSrcSpan name
 \end{code}
 
@@ -438,5 +423,11 @@ getOccString	    :: NamedThing a => a -> String
 getSrcLoc	    = nameSrcLoc	   . getName
 getSrcSpan	    = nameSrcSpan	   . getName
 getOccString 	    = occNameString	   . getOccName
+
+pprInfixName, pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc
+-- See Outputable.pprPrefixVar, pprInfixVar; 
+-- add parens or back-quotes as appropriate
+pprInfixName  n = pprInfixVar  (isSymOcc (getOccName n)) (ppr n)
+pprPrefixName n = pprPrefixVar (isSymOcc (getOccName n)) (ppr n)
 \end{code}