[project @ 2002-09-06 14:40:28 by simonmar]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcMType.lhs

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index faa7827..d4d506a 100644 (file)
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -82,8 +82,9 @@ import PrelNames      ( cCallableClassKey, cReturnableClassKey, hasKey )
 import ForeignCall     ( Safety(..) )
 import FunDeps         ( grow )
 import PprType         ( pprPred, pprSourceType, pprTheta, pprClassPred )
-import Name            ( Name, NamedThing(..), setNameUnique, mkSystemName,
-                         mkInternalName, mkDerivedTyConOcc
+import Name            ( Name, NamedThing(..), setNameUnique, 
+                         mkInternalName, mkDerivedTyConOcc, 
+                         mkSystemTvNameEncoded,
                        )
 import VarSet
 import BasicTypes      ( Boxity(Boxed) )
@@ -106,7 +107,7 @@ import Outputable
 newTyVar :: Kind -> NF_TcM TcTyVar
 newTyVar kind
   = tcGetUnique        `thenNF_Tc` \ uniq ->
-    tcNewMutTyVar (mkSystemName uniq FSLIT("t")) kind VanillaTv
+    tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("t")) kind VanillaTv
 
 newTyVarTy  :: Kind -> NF_TcM TcType
 newTyVarTy kind
@@ -119,7 +120,7 @@ newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind)
 newKindVar :: NF_TcM TcKind
 newKindVar
   = tcGetUnique                                                        `thenNF_Tc` \ uniq ->
-    tcNewMutTyVar (mkSystemName uniq FSLIT("k")) superKind VanillaTv   `thenNF_Tc` \ kv ->
+    tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("k")) superKind VanillaTv  `thenNF_Tc` \ kv ->
     returnNF_Tc (TyVarTy kv)
 
 newKindVars :: Int -> NF_TcM [TcKind]
@@ -128,7 +129,7 @@ newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
 newBoxityVar :: NF_TcM TcKind
 newBoxityVar
   = tcGetUnique                                                          `thenNF_Tc` \ uniq ->
-    tcNewMutTyVar (mkSystemName uniq FSLIT("bx")) superBoxity VanillaTv  `thenNF_Tc` \ kv ->
+    tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx")) superBoxity VanillaTv  `thenNF_Tc` \ kv ->
     returnNF_Tc (TyVarTy kv)
 \end{code}
 
@@ -142,7 +143,7 @@ newBoxityVar
 \begin{code}
 newHoleTyVarTy :: NF_TcM TcType
   = tcGetUnique        `thenNF_Tc` \ uniq ->
-    tcNewMutTyVar (mkSystemName uniq FSLIT("h")) openTypeKind HoleTv   `thenNF_Tc` \ tv ->
+    tcNewMutTyVar (mkSystemTvNameEncoded uniq FSLIT("h")) openTypeKind HoleTv  `thenNF_Tc` \ tv ->
     returnNF_Tc (TyVarTy tv)
 
 readHoleResult :: TcType -> NF_TcM TcType
@@ -935,6 +936,10 @@ check_valid_theta ctxt []
 check_valid_theta ctxt theta
   = getDOptsTc                                 `thenNF_Tc` \ dflags ->
     warnTc (notNull dups) (dupPredWarn dups)   `thenNF_Tc_`
+       -- Actually, in instance decls and type signatures, 
+       -- duplicate constraints are eliminated by TcMonoType.hoistForAllTys,
+       -- so this error can only fire for the context of a class or
+       -- data type decl.
     mapTc_ (check_source_ty dflags ctxt) theta
   where
     (_,dups) = removeDups tcCmpPred theta