X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FOccName.lhs;h=faf7aa8988c94c6dbe4d0c10cf49823a73569fc5;hb=3dfd7d76aa269a1a5a68427aeb7c93ae42948af6;hp=c2d4533f3f3901d546e650cf4001ff516bc981da;hpb=98bf57340b8945ea786dc18f2d1ecbe1baed0a4d;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index c2d4533..faf7aa8 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -18,7 +18,7 @@ module OccName (
 	mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
 	mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
  	mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
-	mkGenOcc1, mkGenOcc2, 
+	mkGenOcc1, mkGenOcc2, mkLocalOcc,
 	
 	isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
 
@@ -40,8 +40,9 @@ module OccName (
 
 #include "HsVersions.h"
 
-import Char	( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
+import Char	( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
 import Util	( thenCmp )
+import Unique	( Unique )
 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
 import GlaExts
@@ -280,7 +281,7 @@ NB: The string must already be encoded!
 mk_deriv :: NameSpace 
 	 -> String		-- Distinguishes one sort of derived name from another
 	 -> EncodedString	-- Must be already encoded!!  We don't want to encode it a 
-				-- second time because encoding isn't itempotent
+				-- second time because encoding isn't idempotent
 	 -> OccName
 
 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
@@ -292,15 +293,15 @@ mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
-mkWorkerOcc        = mk_simple_deriv varName  "$w"
-mkDefaultMethodOcc = mk_simple_deriv varName  "$dm"
-mkDerivedTyConOcc  = mk_simple_deriv tcName   ":"	-- The : prefix makes sure it classifies
-mkClassTyConOcc    = mk_simple_deriv tcName   ":T"	-- as a tycon/datacon
-mkClassDataConOcc  = mk_simple_deriv dataName ":D"	--
-mkDictOcc	   = mk_simple_deriv varName  "$d"
-mkIPOcc		   = mk_simple_deriv varName  "$i"
-mkSpecOcc	   = mk_simple_deriv varName  "$s"
-mkForeignExportOcc = mk_simple_deriv varName  "$f"
+mkWorkerOcc         = mk_simple_deriv varName  "$w"
+mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
+mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"	-- The : prefix makes sure it classifies
+mkClassTyConOcc     = mk_simple_deriv tcName   ":T"	-- as a tycon/datacon
+mkClassDataConOcc   = mk_simple_deriv dataName ":D"	--
+mkDictOcc	    = mk_simple_deriv varName  "$d"
+mkIPOcc		    = mk_simple_deriv varName  "$i"
+mkSpecOcc	    = mk_simple_deriv varName  "$s"
+mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"      -- Generics
 mkGenOcc2           = mk_simple_deriv varName  "$gto"        -- Generics
 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
@@ -309,9 +310,17 @@ mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 \begin{code}
 mkSuperDictSelOcc :: Int 	-- Index of superclass, eg 3
 		  -> OccName 	-- Class, eg "Ord"
-		  -> OccName	-- eg "p3Ord"
+		  -> OccName	-- eg "$p3Ord"
 mkSuperDictSelOcc index cls_occ
   = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
+
+mkLocalOcc :: Unique 		-- Unique
+	   -> OccName		-- Local name (e.g. "sat")
+	   -> OccName		-- Nice unique version ("$L23sat")
+mkLocalOcc uniq occ
+   = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
+	-- The Unique might print with characters 
+	-- that need encoding (e.g. 'z'!)
 \end{code}
 
 
@@ -449,7 +458,7 @@ alreadyEncoded s = all ok s
 			-- in names we'd have to encode them.  But we do put
 			-- spaces in ccall "occurrences", and we don't want to
 			-- reject them here
-		   ok ch  = ISALPHANUM ch
+		   ok ch  = isAlphaNum ch
 
 alreadyEncodedFS :: FAST_STRING -> Bool
 alreadyEncodedFS fs = alreadyEncoded (_UNPK_ fs)
@@ -578,6 +587,7 @@ decode_escape (c : rest)
     go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))
 
 decode_escape (c : rest) = pprTrace "decode_escape" (char c) (decode rest)
+decode_escape []	 = pprTrace "decode_escape" (text "empty") ""
 \end{code}