Use MD5 checksums for recompilation checking (fixes #1372, #1959)
[ghc-hetmet.git] / compiler / basicTypes / OccName.lhs
index c96cfd2..debaa28 100644 (file)
@@ -5,6 +5,7 @@
 
 \begin{code}
 module OccName (
+        mk_deriv,
        -- * The NameSpace type; abstact
        NameSpace, tcName, clsName, tcClsName, dataName, varName, 
        tvName, srcDataName,
@@ -25,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,
@@ -66,8 +69,6 @@ module OccName (
        startsVarSym, startsVarId, startsConSym, startsConId
     ) where
 
-#include "HsVersions.h"
-
 import Util
 import Unique
 import BasicTypes
@@ -85,6 +86,7 @@ import Data.Char
 -- Unicode TODO: put isSymbol in libcompat
 #if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ > 604
 #else
+isSymbol :: a -> Bool
 isSymbol = const False
 #endif
 
@@ -149,10 +151,10 @@ isVarName VarName = True
 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
@@ -161,8 +163,8 @@ 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}
 
 
@@ -429,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!
 
@@ -440,6 +441,13 @@ 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}
@@ -447,7 +455,8 @@ mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
        mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
        mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc,
-       mkInstTyCoOcc, mkEqPredCoOcc,
+       mkInstTyCoOcc, mkEqPredCoOcc, 
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
        mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
        mkPArrayTyConOcc, mkPArrayDataConOcc, mkPReprTyConOcc, mkPADFunOcc
    :: OccName -> OccName
@@ -468,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" 
@@ -662,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. "+"