[project @ 1998-02-10 17:14:23 by simonm]

[ghc-hetmet.git] / ghc / compiler / reader / RdrHsSyn.lhs

diff --git a/ghc/compiler/reader/RdrHsSyn.lhs b/ghc/compiler/reader/RdrHsSyn.lhs
index 5cd65dd..f7f9eed 100644 (file)
--- a/ghc/compiler/reader/RdrHsSyn.lhs
+++ b/ghc/compiler/reader/RdrHsSyn.lhs
@@ -46,9 +46,9 @@ module RdrHsSyn (
        qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
        dummyRdrVarName, dummyRdrTcName,
        isUnqual, isQual,
-       showRdr, rdrNameOcc, ieOcc,
+       showRdr, rdrNameOcc, rdrNameModule, ieOcc,
        cmpRdr, prefixRdrName,
-       mkOpApp, mkClassDecl
+       mkOpApp, mkClassDecl, isClassDataConRdrName
 
     ) where
 
@@ -56,16 +56,15 @@ module RdrHsSyn (
 
 import HsSyn
 import Lex
-import PrelMods                ( pRELUDE )
-import BasicTypes      ( Module(..), NewOrData, IfaceFlavour(..), Unused )
-import Name            ( ExportFlag(..), pprModule,
-                         OccName(..), pprOccName, 
+import BasicTypes      ( Module(..), IfaceFlavour(..), Unused )
+import Name            ( pprModule, OccName(..), pprOccName, 
                          prefixOccName, NamedThing )
 import Util            ( thenCmp )
-import CoreSyn         ( GenCoreExpr )
 import HsPragmas       ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
 import List            ( nub )
 import Outputable
+
+import Char            ( isUpper )
 \end{code}
 
 \begin{code}
@@ -169,6 +168,17 @@ mkClassDecl cxt cname tyvars sigs mbinds prags loc
                                            where
                                               s1 = SLIT(":") _APPEND_ s
 
+-- This nasty little function tests for whether a RdrName was 
+-- constructed by the above process.  It's used only for filtering
+-- out duff error messages.  Maybe there's a tidier way of doing this
+-- but I can't work up the energy to find it.
+
+isClassDataConRdrName rdr_name
+ = case rdrNameOcc rdr_name of
+       TCOcc s -> case _UNPK_ s of
+                       ':' : c : _ -> isUpper c
+                       other       -> False
+       other -> False
 \end{code}
 
 %************************************************************************
@@ -198,6 +208,7 @@ lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
 
+
 varUnqual n = Unqual (VarOcc n)
 
 isUnqual (Unqual _)   = True
@@ -221,6 +232,9 @@ rdrNameOcc :: RdrName -> OccName
 rdrNameOcc (Unqual occ)   = occ
 rdrNameOcc (Qual _ occ _) = occ
 
+rdrNameModule :: RdrName -> Module
+rdrNameModule (Qual m _ _) = m
+
 ieOcc :: RdrNameIE -> OccName
 ieOcc ie = rdrNameOcc (ieName ie)