[project @ 1999-01-15 14:06:50 by simonm]

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

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 11244fb..ede2a97 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -20,6 +20,7 @@ module OccName (
        mkClassTyConOcc, mkClassDataConOcc,
        
        isTvOcc, isTCOcc, isVarOcc, isConSymOcc, isConOcc, isSymOcc,
+       isWildCardOcc, isAnonOcc, 
        pprOccName, occNameString, occNameFlavour, 
 
        -- The basic form of names
@@ -37,7 +38,13 @@ module OccName (
 
 #include "HsVersions.h"
 
-import Char    ( isAlpha, isUpper, isLower, isAlphanum, ord )
+#if __HASKELL1__ > 4
+#define ISALPHANUM isAlphaNum
+#else
+#define ISALPHANUM isAlphanum
+#endif
+
+import Char    ( isAlpha, isUpper, isLower, ISALPHANUM, ord )
 import Util    ( thenCmp )
 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
 import Outputable
@@ -390,7 +397,7 @@ occNameFlavour (OccName TvOcc _ _ _)                     = "Type variable"
 occNameFlavour (OccName TCOcc s _ _)                = "Type constructor or class"
 
 isVarOcc, isTCOcc, isTvOcc,
- isConSymOcc, isSymOcc :: OccName -> Bool
+ isConSymOcc, isSymOcc, isWildCardOcc :: OccName -> Bool
 
 isVarOcc (OccName VarOcc _ _ _) = True
 isVarOcc other                  = False
@@ -406,6 +413,10 @@ isConSymOcc (OccName _ s _ _) = isLexConSym s
 isSymOcc (OccName _ s _ _) = isLexSym s
 
 isConOcc (OccName _ s _ _) = isLexCon s
+
+isWildCardOcc (OccName _ s _ _) = (_HEAD_ s) == '_' && _LENGTH_ s == 1 
+
+isAnonOcc (OccName _ s _ _) = (_HEAD_ s) == '_'
 \end{code}
 
 
@@ -460,7 +471,11 @@ initTidyOccEnv = foldl (\env (OccName _ fs _ _) -> addToFM env fs 1) emptyTidyOc
 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 
 tidyOccName in_scope occ@(OccName occ_sp real _ _)
-  | not (real `elemFM` in_scope)
+  | not (real `elemFM` in_scope) &&
+    not (isLexCon real)                        -- Hack alert!   Specialised versions of overloaded
+                                       -- constructors end up as ordinary Ids, but we don't
+                                       -- want them as ConIds in interface files.
+
   = (addToFM in_scope real 1, occ)     -- First occurrence
 
   | otherwise                          -- Already occurs
@@ -540,7 +555,7 @@ We provide two interfaces for efficiency.
 \begin{code}
 identToC :: String -> FAST_STRING
 identToC str
-  | all isAlphanum str && not std = _PK_ str
+  | all ISALPHANUM str && not std = _PK_ str
   | std                          = _PK_ ("Zs" ++ encode str)
   | otherwise                    = _PK_ (encode str)
   where
@@ -548,7 +563,7 @@ identToC str
 
 identFsToC :: FAST_STRING -> FAST_STRING
 identFsToC fast_str
-  | all isAlphanum str && not std = fast_str
+  | all ISALPHANUM str && not std = fast_str
   | std                                  = _PK_ ("Zs" ++ encode str)
   | otherwise                    = _PK_ (encode str)
   where
@@ -564,7 +579,7 @@ encode [] = []
 encode (c:cs) = encode_ch c ++ encode cs
 
 encode_ch :: Char -> String
-encode_ch c | isAlphanum c = [c]
+encode_ch c | ISALPHANUM c = [c]
        -- Common case first
 encode_ch 'Z'  = "ZZ"
 encode_ch '&'  = "Za"
@@ -577,7 +592,7 @@ encode_ch '#'  = "Zh"
 encode_ch '<'  = "Zl"
 encode_ch '-'  = "Zm"
 encode_ch '!'  = "Zn"
-encode_ch '.'  = "Zd"
+encode_ch '.'  = "Zs"
 encode_ch '\'' = "Zq"
 encode_ch '*'  = "Zt"
 encode_ch '+'  = "Zp"