X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FOccName.lhs;h=529117c9a5434bf63de42a947f91032f62385a8c;hb=026ea0a939957d22803f19b88b1bed2c779e46c5;hp=2de02e760fcbb3ccfaca34343ae59a08565175c1;hpb=b0306f6e4545478d031ff619ee7c666cc1d8d381;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 2de02e7..529117c 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -27,7 +27,7 @@ module OccName (
 	foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
 
 	mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
-	mkVarOcc, mkVarOccEncoded,
+	mkVarOcc, mkVarOccEncoded, mkTyVarOcc,
 	mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
 	mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
  	mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
@@ -35,7 +35,7 @@ module OccName (
 	mkDataConWrapperOcc, mkDataConWorkerOcc,
 	
 	isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
-	reportIfUnused,
+	parenSymOcc, reportIfUnused,
 
 	occNameFS, occNameString, occNameUserString, occNameSpace, 
 	occNameFlavour, briefOccNameFlavour,
@@ -62,6 +62,7 @@ import Char	( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
 import Util	( thenCmp )
 import Unique	( Unique, mkUnique, Uniquable(..) )
 import BasicTypes ( Boxity(..), Arity )
+import StaticFlags ( opt_PprStyle_Debug )
 import UniqFM
 import UniqSet
 import FastString
@@ -93,7 +94,7 @@ type EncodedString = String	-- Encoded form
 pprEncodedFS :: EncodedFS -> SDoc
 pprEncodedFS fs
   = getPprStyle 	$ \ sty ->
-    if userStyle sty
+    if userStyle sty || dumpStyle sty
 	-- ftext (decodeFS fs) would needlessly pack the string again
 	then text (decode (unpackFS fs))
         else ftext fs
@@ -161,9 +162,9 @@ nameSpaceString TcClsName = "Type constructor or class"
 
 \begin{code}
 data OccName = OccName 
-			NameSpace
-			EncodedFS
-   {-! derive : Binary !-}
+    { occNameSpace  :: NameSpace
+    , occNameFS     :: EncodedFS
+    }
 \end{code}
 
 
@@ -241,6 +242,9 @@ mkOccName ns s = mkSysOcc ns (encode s)
 mkVarOcc :: UserFS -> OccName
 mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
 
+mkTyVarOcc :: UserFS -> OccName
+mkTyVarOcc fs = mkSysOccFS tvName (encodeFS fs)
+
 mkVarOccEncoded :: EncodedFS -> OccName
 mkVarOccEncoded fs = mkSysOccFS varName fs
 \end{code}
@@ -342,18 +346,12 @@ intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
 %************************************************************************
 
 \begin{code} 
-occNameFS :: OccName -> EncodedFS
-occNameFS (OccName _ s) = s
-
 occNameString :: OccName -> EncodedString
 occNameString (OccName _ s) = unpackFS s
 
 occNameUserString :: OccName -> UserString
 occNameUserString occ = decode (occNameString occ)
 
-occNameSpace :: OccName -> NameSpace
-occNameSpace (OccName sp _) = sp
-
 setOccNameSpace :: NameSpace -> OccName -> OccName
 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 
@@ -402,9 +400,15 @@ isDataOcc other		       = False
 
 -- Any operator (data constructor or variable)
 -- Pretty inefficient!
-isSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
-isSymOcc (OccName VarName s)  = isLexSym (decodeFS s)
-isSymOcc other		      = False
+isSymOcc (OccName DataName s)  = isLexConSym (decodeFS s)
+isSymOcc (OccName TcClsName s) = isLexConSym (decodeFS s)
+isSymOcc (OccName VarName s)   = isLexSym (decodeFS s)
+isSymOcc other		       = False
+
+parenSymOcc :: OccName -> SDoc -> SDoc
+-- Wrap parens around an operator
+parenSymOcc occ doc | isSymOcc occ = parens doc
+		    | otherwise    = doc
 \end{code}
 
 
@@ -492,7 +496,7 @@ mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
--- to DataName
+-- to VarName
 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ 
 \end{code}
 
@@ -515,9 +519,22 @@ mkLocalOcc uniq occ
 
 \begin{code}
 mkDFunOcc :: EncodedString	-- Typically the class and type glommed together e.g. "OrdMaybe"
-	  -> OccName		-- "$fOrdMaybe"
+				-- Only used in debug mode, for extra clarity
+	  -> Bool		-- True <=> hs-boot instance dfun
+	  -> Int		-- Unique index
+	  -> OccName		-- "$f3OrdMaybe"
 
-mkDFunOcc string = mk_deriv VarName "$f" string
+-- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
+-- thing when we compile the mother module. Reason: we don't know exactly
+-- what the  mother module will call it.
+
+mkDFunOcc info_str is_boot index 
+  = mk_deriv VarName prefix string
+  where
+    prefix | is_boot   = "$fx"
+	   | otherwise = "$f"
+    string | opt_PprStyle_Debug = show index ++ info_str
+	   | otherwise		= show index
 \end{code}
 
 We used to add a '$m' to indicate a method, but that gives rise to bad