Avoid nasty name clash with associated data types (fixes Trac #2888)

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

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 091296a..e158763 100644 (file)
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -35,6 +35,7 @@ import TcIface
 import TcType
 import {- Kind parts of -} Type
 import Var
+import Coercion
 import TyCon
 import Class
 import Name
@@ -166,8 +167,8 @@ tcHsQuantifiedType tv_names hs_ty
        ; return (tvs, ty) } }
 
 -- Used for the deriving(...) items
-tcHsDeriv :: LHsType Name -> TcM ([TyVar], Class, [Type])
-tcHsDeriv = addLocM (tc_hs_deriv [])
+tcHsDeriv :: HsType Name -> TcM ([TyVar], Class, [Type])
+tcHsDeriv = tc_hs_deriv []
 
 tc_hs_deriv :: [LHsTyVarBndr Name] -> HsType Name
             -> TcM ([TyVar], Class, [Type])
@@ -676,15 +677,17 @@ tcDataKindSig (Just kind)
        ; us   <- newUniqueSupply 
        ; let uniqs = uniqsFromSupply us
        ; return [ mk_tv span uniq str kind 
-                | ((kind, str), uniq) <- arg_kinds `zip` names `zip` uniqs ] }
+                | ((kind, str), uniq) <- arg_kinds `zip` dnames `zip` uniqs ] }
   where
     (arg_kinds, res_kind) = splitKindFunTys kind
     mk_tv loc uniq str kind = mkTyVar name kind
        where
           name = mkInternalName uniq occ loc
           occ  = mkOccName tvName str
+         
+    dnames = map ('$' :) names -- Note [Avoid name clashes for associated data types]
 
-    names :: [String]  -- a,b,c...aa,ab,ac etc
+    names :: [String]
     names = [ c:cs | cs <- "" : names, c <- ['a'..'z'] ] 
 
 badKindSig :: Kind -> SDoc
@@ -693,6 +696,24 @@ badKindSig kind
        2 (ppr kind)
 \end{code}
 
+Note [Avoid name clashes for associated data types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider    class C a b where
+               data D b :: * -> *
+When typechecking the decl for D, we'll invent an extra type variable for D,
+to fill out its kind.  We *don't* want this type variable to be 'a', because
+in an .hi file we'd get
+            class C a b where
+               data D b a 
+which makes it look as if there are *two* type indices.  But there aren't!
+So we use $a instead, which cannot clash with a user-written type variable.
+Remember that type variable binders in interface files are just FastStrings,
+not proper Names.
+
+(The tidying phase can't help here because we don't tidy TyCons.  Another
+alternative would be to record the number of indexing parameters in the 
+interface file.)
+
 
 %************************************************************************
 %*                                                                     *
@@ -763,16 +784,17 @@ tcPatSig :: UserTypeCtxt
         -> LHsType Name
         -> BoxySigmaType
         -> TcM (TcType,           -- The type to use for "inside" the signature
-                [(Name,TcType)])  -- The new bit of type environment, binding
+                [(Name, TcType)], -- The new bit of type environment, binding
                                   -- the scoped type variables
+                 CoercionI)        -- Coercion due to unification with actual ty
 tcPatSig ctxt sig res_ty
   = do { (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig
 
        ; if null sig_tvs then do {
                -- The type signature binds no type variables, 
                -- and hence is rigid, so use it to zap the res_ty
-                 boxyUnify sig_ty res_ty
-               ; return (sig_ty, [])
+                 coi <- boxyUnify sig_ty res_ty
+               ; return (sig_ty, [], coi)
 
        } else do {
                -- Type signature binds at least one scoped type variable
@@ -795,7 +817,8 @@ tcPatSig ctxt sig res_ty
                -- unifying, and reading out the results.
                -- This is a strictly local operation.
        ; box_tvs <- mapM tcInstBoxyTyVar sig_tvs
-       ; boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty) res_ty
+       ; coi <- boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty) 
+                           res_ty
        ; sig_tv_tys <- mapM readFilledBox box_tvs
 
                -- Check that each is bound to a distinct type variable,
@@ -805,7 +828,7 @@ tcPatSig ctxt sig res_ty
        ; check binds_in_scope tv_binds
        
                -- Phew!
-       ; return (res_ty, tv_binds)
+       ; return (res_ty, tv_binds, coi)
        } }
   where
     check _ [] = return ()