[project @ 2000-11-07 15:21:38 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / OccName.lhs

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index e2da548..a794b75 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -8,18 +8,19 @@
 module OccName (
        -- The NameSpace type; abstact
        NameSpace, tcName, clsName, tcClsName, dataName, varName, ipName,
-       tvName, uvName, nameSpaceString, 
+       tvName, nameSpaceString, 
 
        -- The OccName type
        OccName,        -- Abstract, instance of Outputable
        pprOccName, 
 
-       mkSrcOccFS, mkSysOcc, mkSysOccFS, mkCCallOcc, mkSrcVarOcc, mkKindOccFS,
+       mkOccFS, mkSysOcc, mkSysOccFS, mkCCallOcc, mkVarOcc, mkKindOccFS,
        mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
        mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
        mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
+       mkGenOcc1, mkGenOcc2, 
        
-       isSysOcc, isTvOcc, isUvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
+       isSysOcc, isTvOcc, isDataOcc, isDataSymOcc, isSymOcc, isIPOcc, isValOcc,
 
        occNameFS, occNameString, occNameUserString, occNameSpace, occNameFlavour, 
        setOccNameSpace,
@@ -39,7 +40,7 @@ module OccName (
 
 #include "HsVersions.h"
 
-import Char    ( isDigit, isAlpha, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt, intToDigit )
+import Char    ( isDigit, isUpper, isLower, ISALPHANUM, ord, chr, digitToInt )
 import Util    ( thenCmp )
 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
@@ -85,7 +86,6 @@ data NameSpace = VarName      -- Variables
               | IPName         -- Implicit Parameters
               | DataName       -- Data constructors
               | TvName         -- Type variables
-              | UvName         -- Usage variables
               | TcClsName      -- Type constructors and classes; Haskell has them
                                -- in the same name space for now.
               deriving( Eq, Ord )
@@ -98,7 +98,6 @@ tcClsName = TcClsName         -- Not sure which!
 
 dataName = DataName
 tvName   = TvName
-uvName   = UvName
 varName  = VarName
 ipName   = IPName
 
@@ -108,7 +107,6 @@ nameSpaceString DataName  = "Data constructor"
 nameSpaceString VarName   = "Variable"
 nameSpaceString IPName    = "Implicit Param"
 nameSpaceString TvName    = "Type variable"
-nameSpaceString UvName    = "Usage variable"
 nameSpaceString TcClsName = "Type constructor or class"
 \end{code}
 
@@ -176,7 +174,7 @@ mkCCallOcc :: EncodedString -> OccName
 -- But then alreadyEncoded complains about the braces!
 mkCCallOcc str = OccName varName (_PK_ str)
 
--- Kind constructors get a speical function.  Uniquely, they are not encoded,
+-- Kind constructors get a special function.  Uniquely, they are not encoded,
 -- so that they have names like '*'.  This means that *even in interface files*
 -- we'll get kinds like (* -> (* -> *)).  We can't use mkSysOcc because it
 -- has an ASSERT that doesn't hold.
@@ -187,11 +185,11 @@ mkKindOccFS occ_sp fs = OccName occ_sp fs
 *Source-code* things are encoded.
 
 \begin{code}
-mkSrcOccFS :: NameSpace -> UserFS -> OccName
-mkSrcOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
+mkOccFS :: NameSpace -> UserFS -> OccName
+mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
 
-mkSrcVarOcc :: UserFS -> OccName
-mkSrcVarOcc fs = mkSysOccFS varName (encodeFS fs)
+mkVarOcc :: UserFS -> OccName
+mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
 \end{code}
 
 
@@ -224,14 +222,11 @@ occNameFlavour (OccName sp _) = nameSpaceString sp
 \end{code}
 
 \begin{code}
-isTvOcc, isDataSymOcc, isSymOcc, isUvOcc :: OccName -> Bool
+isTvOcc, isDataSymOcc, isSymOcc :: OccName -> Bool
 
 isTvOcc (OccName TvName _) = True
 isTvOcc other              = False
 
-isUvOcc (OccName UvName _) = True
-isUvOcc other              = False
-
 isValOcc (OccName VarName  _) = True
 isValOcc (OccName DataName _) = True
 isValOcc other               = False
@@ -308,7 +303,8 @@ 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)
 
 
@@ -438,8 +434,8 @@ The basic encoding scheme is this.
 * Most other printable characters translate to 'zx' or 'Zx' for some
        alphabetic character x
 
-* The others translate as 'zxdd' where 'dd' is exactly two hexadecimal
-       digits for the ord of the character
+* The others translate as 'znnnU' where 'nnn' is the decimal number
+        of the character
 
        Before          After
        --------------------------
@@ -532,9 +528,7 @@ encode_ch '/'  = "zs"
 encode_ch '*'  = "zt"
 encode_ch '_'  = "zu"
 encode_ch '%'  = "zv"
-encode_ch c    = ['z', 'x', intToDigit hi, intToDigit lo]
-              where
-                (hi,lo) = ord c `quotRem` 16
+encode_ch c    = 'z' : shows (ord c) "U"
 \end{code}
 
 Decode is used for user printing.
@@ -577,14 +571,15 @@ decode_escape ('s' : rest) = '/' : decode rest
 decode_escape ('t' : rest) = '*' : decode rest
 decode_escape ('u' : rest) = '_' : decode rest
 decode_escape ('v' : rest) = '%' : decode rest
-decode_escape ('x' : d1 : d2 : rest) = chr (digitToInt d1 * 16 + digitToInt d2)  : decode rest
 
 -- Tuples are coded as Z23T
+-- Characters not having a specific code are coded as z224U
 decode_escape (c : rest)
   | isDigit c = go (digitToInt c) rest
   where
     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
     go n ('T' : rest)          = '(' : replicate n ',' ++ ')' : decode rest
+    go n ('U' : rest)           = chr n : decode rest
     go n other = pprPanic "decode_escape" (ppr n <+> text (c:rest))
 
 decode_escape (c : rest) = pprTrace "decode_escape" (char c) (decode rest)