X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FOccName.lhs;h=debaa28bb3658222e57559411690e45f94d0149e;hb=8574f3b42b28eb9bc1471e4dd40a24035a40cb63;hp=d597a46f34af9fb1af1d5cb995eb0f3c08c9f774;hpb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index d597a46..debaa28 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -4,14 +4,8 @@
 %
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module OccName (
+        mk_deriv,
 	-- * The NameSpace type; abstact
 	NameSpace, tcName, clsName, tcClsName, dataName, varName, 
 	tvName, srcDataName,
@@ -32,8 +26,10 @@ module OccName (
 	setOccNameSpace,
 
 	-- ** Derived OccNames
+        isDerivedOccName,
 	mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
-	mkDerivedTyConOcc, mkNewTyCoOcc,
+	mkDerivedTyConOcc, mkNewTyCoOcc, 
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
   	mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
  	mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
 	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
@@ -73,8 +69,6 @@ module OccName (
 	startsVarSym, startsVarId, startsConSym, startsConId
     ) where
 
-#include "HsVersions.h"
-
 import Util
 import Unique
 import BasicTypes
@@ -82,6 +76,7 @@ import StaticFlags
 import UniqFM
 import UniqSet
 import FastString
+import FastTypes
 import Outputable
 import Binary
 
@@ -89,8 +84,9 @@ import GHC.Exts
 import Data.Char
 
 -- Unicode TODO: put isSymbol in libcompat
-#if __GLASGOW_HASKELL__ > 604
+#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ > 604
 #else
+isSymbol :: a -> Bool
 isSymbol = const False
 #endif
 
@@ -128,6 +124,9 @@ data NameSpace = VarName	-- Variables, including "real" data constructors
 -- The real   datacon has type Int -> Int -> T
 -- GHC chooses a representation based on the strictness etc.
 
+tcName, clsName, tcClsName :: NameSpace
+dataName, srcDataName      :: NameSpace
+tvName, varName            :: NameSpace
 
 -- Though type constructors and classes are in the same name space now,
 -- the NameSpace type is abstract, so we can easily separate them later
@@ -149,22 +148,23 @@ isTcClsName _	      = False
 isVarName :: NameSpace -> Bool	-- Variables or type variables, but not constructors
 isVarName TvName  = True
 isVarName VarName = True
-isVarName other   = False
+isVarName _       = False
 
 pprNameSpace :: NameSpace -> SDoc
-pprNameSpace DataName  = ptext SLIT("data constructor")
-pprNameSpace VarName   = ptext SLIT("variable")
-pprNameSpace TvName    = ptext SLIT("type variable")
-pprNameSpace TcClsName = ptext SLIT("type constructor or class")
+pprNameSpace DataName  = ptext (sLit "data constructor")
+pprNameSpace VarName   = ptext (sLit "variable")
+pprNameSpace TvName    = ptext (sLit "type variable")
+pprNameSpace TcClsName = ptext (sLit "type constructor or class")
 
 pprNonVarNameSpace :: NameSpace -> SDoc
 pprNonVarNameSpace VarName = empty
 pprNonVarNameSpace ns = pprNameSpace ns
 
+pprNameSpaceBrief :: NameSpace -> SDoc
 pprNameSpaceBrief DataName  = char 'd'
 pprNameSpaceBrief VarName   = char 'v'
-pprNameSpaceBrief TvName    = ptext SLIT("tv")
-pprNameSpaceBrief TcClsName = ptext SLIT("tc")
+pprNameSpaceBrief TvName    = ptext (sLit "tv")
+pprNameSpaceBrief TcClsName = ptext (sLit "tc")
 \end{code}
 
 
@@ -255,7 +255,7 @@ easy to build an OccEnv.
 \begin{code}
 instance Uniquable OccName where
   getUnique (OccName ns fs)
-      = mkUnique char (I# (uniqueOfFS fs))
+      = mkUnique char (iBox (uniqueOfFS fs))
       where	-- See notes above about this getUnique function
         char = case ns of
 		VarName   -> 'i'
@@ -304,7 +304,7 @@ filterOccEnv x (A y)       = A $ filterUFM x y
 instance Outputable a => Outputable (OccEnv a) where
     ppr (A x) = ppr x
 
-type OccSet = UniqFM OccName
+type OccSet = UniqSet OccName
 
 emptyOccSet	  :: OccSet
 unitOccSet	  :: OccName -> OccSet
@@ -351,20 +351,20 @@ occNameString (OccName _ s) = unpackFS s
 setOccNameSpace :: NameSpace -> OccName -> OccName
 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 
-isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
+isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc, isValOcc, isDataOcc :: OccName -> Bool
 
 isVarOcc (OccName VarName _) = True
-isVarOcc other               = False
+isVarOcc _                   = False
 
 isTvOcc (OccName TvName _) = True
-isTvOcc other              = False
+isTvOcc _                  = False
 
 isTcOcc (OccName TcClsName _) = True
-isTcOcc other                 = False
+isTcOcc _                     = False
 
 isValOcc (OccName VarName  _) = True
 isValOcc (OccName DataName _) = True
-isValOcc other		      = False
+isValOcc _                    = False
 
 -- Data constructor operator (starts with ':', or '[]')
 -- Pretty inefficient!
@@ -372,13 +372,13 @@ isDataSymOcc (OccName DataName s) = isLexConSym s
 isDataSymOcc (OccName VarName s)  
   | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
 		-- Jan06: I don't think this should happen
-isDataSymOcc other		  = False
+isDataSymOcc _                    = False
 
 isDataOcc (OccName DataName _) = True
 isDataOcc (OccName VarName s)  
   | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
 		-- Jan06: I don't think this should happen
-isDataOcc other		       = False
+isDataOcc _                    = False
 
 -- Any operator (data constructor or variable)
 -- Pretty inefficient!
@@ -431,7 +431,6 @@ Here's our convention for splitting up the interface file name space:
 
 This knowledge is encoded in the following functions.
 
-
 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 NB: The string must already be encoded!
 
@@ -442,13 +441,24 @@ mk_deriv :: NameSpace
 	 -> OccName
 
 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
+
+isDerivedOccName :: OccName -> Bool
+isDerivedOccName occ = 
+   case occNameString occ of
+     '$':c:_ | isAlphaNum c -> True
+     ':':c:_ | isAlphaNum c -> True
+     _other                 -> False
 \end{code}
 
 \begin{code}
 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
   	mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
  	mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
-	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc
+	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
+	mkInstTyCoOcc, mkEqPredCoOcc, 
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
+	mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
+	mkPArrayTyConOcc, mkPArrayDataConOcc, mkPReprTyConOcc, mkPADFunOcc
    :: OccName -> OccName
 
 -- These derived variables have a prefix that no Haskell value could have
@@ -467,6 +477,11 @@ mkNewTyCoOcc        = mk_simple_deriv tcName  ":Co"
 mkInstTyCoOcc       = mk_simple_deriv tcName  ":CoF"     -- derived from rep ty
 mkEqPredCoOcc	    = mk_simple_deriv tcName  "$co"
 
+-- used in derived instances
+mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"
+mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"
+mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"
+
 -- Generic derivable classes
 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 mkGenOcc2           = mk_simple_deriv varName  "$gto" 
@@ -487,6 +502,7 @@ mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
 mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
 mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
 
+mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 
 -- Data constructor workers are made by setting the name space
@@ -563,8 +579,8 @@ guys never show up in error messages.  What a hack.
 
 \begin{code}
 mkMethodOcc :: OccName -> OccName
-mkMethodOcc occ@(OccName VarName fs) = occ
-mkMethodOcc occ			     = mk_simple_deriv varName "$m" occ
+mkMethodOcc occ@(OccName VarName _) = occ
+mkMethodOcc occ                     = mk_simple_deriv varName "$m" occ
 \end{code}
 
 
@@ -589,6 +605,7 @@ tack on the '1', if necessary.
 type TidyOccEnv = OccEnv Int	-- The in-scope OccNames
 	-- Range gives a plausible starting point for new guesses
 
+emptyTidyOccEnv :: TidyOccEnv
 emptyTidyOccEnv = emptyOccEnv
 
 initTidyOccEnv :: [OccName] -> TidyOccEnv	-- Initialise with names to avoid!
@@ -659,18 +676,18 @@ isLexSym cs = isLexConSym cs || isLexVarSym cs
 -------------
 
 isLexConId cs				-- Prefix type or data constructors
-  | nullFS cs	      = False		-- 	e.g. "Foo", "[]", "(,)" 
-  | cs == FSLIT("[]") = True
-  | otherwise	      = startsConId (headFS cs)
+  | nullFS cs	       = False		-- 	e.g. "Foo", "[]", "(,)" 
+  | cs == (fsLit "[]") = True
+  | otherwise	       = startsConId (headFS cs)
 
 isLexVarId cs				-- Ordinary prefix identifiers
   | nullFS cs	      = False		-- 	e.g. "x", "_x"
   | otherwise         = startsVarId (headFS cs)
 
 isLexConSym cs				-- Infix type or data constructors
-  | nullFS cs	      = False		--	e.g. ":-:", ":", "->"
-  | cs == FSLIT("->") = True
-  | otherwise	      = startsConSym (headFS cs)
+  | nullFS cs	       = False		--	e.g. ":-:", ":", "->"
+  | cs == (fsLit "->") = True
+  | otherwise	       = startsConSym (headFS cs)
 
 isLexVarSym cs				-- Infix identifiers
   | nullFS cs	      = False		-- 	e.g. "+"
@@ -683,6 +700,7 @@ startsConSym c = c == ':'				-- Infix data constructors
 startsVarId c  = isLower c || c == '_'	-- Ordinary Ids
 startsConId c  = isUpper c || c == '('	-- Ordinary type constructors and data constructors
 
+isSymbolASCII :: Char -> Bool
 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 \end{code}