Be cleverer in dataConCannotMatch, fixes Trac #5168

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

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 439a2f8..5489ea7 100644 (file)
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -42,7 +42,7 @@ module OccName (
        mkTyVarOcc, mkTyVarOccFS,
        mkTcOcc, mkTcOccFS,
        mkClsOcc, mkClsOccFS,
-       mkDFunOcc,
+        mkDFunOcc,
        mkTupleOcc, 
        setOccNameSpace,
 
@@ -209,6 +209,7 @@ data OccName = OccName
     { occNameSpace  :: !NameSpace
     , occNameFS     :: !FastString
     }
+    deriving Typeable
 \end{code}
 
 
@@ -221,8 +222,6 @@ instance Ord OccName where
     compare (OccName sp1 s1) (OccName sp2 s2) 
        = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
 
-INSTANCE_TYPEABLE0(OccName,occNameTc,"OccName")
-
 instance Data OccName where
   -- don't traverse?
   toConstr _   = abstractConstr "OccName"
@@ -720,7 +719,9 @@ tidyOccName in_scope occ@(OccName occ_sp fs)
        Just n  ->      -- Already used: make a new guess, 
                        -- change the guess base, and try again
                   tidyOccName  (extendOccEnv in_scope occ (n+1))
-                               (mkOccName occ_sp (unpackFS fs ++ show n))
+                                (mkOccName occ_sp (base_occ ++ show n))
+  where
+    base_occ = reverse (dropWhile isDigit (reverse (unpackFS fs)))
 \end{code}
 
 %************************************************************************