[commit: ghc] master: Improve error message when a variable is used both as kind and type variable (661c1c1)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/661c1c112eb40efd75ac61643c3e1231f60d58d4

>---------------------------------------------------------------

commit 661c1c112eb40efd75ac61643c3e1231f60d58d4
Author: Simon Peyton Jones <[email protected]>
Date:   Mon Nov 26 12:18:15 2012 +0000

    Improve error message when a variable is used both as kind and type variable
    
    Fixes Trac #7404

>---------------------------------------------------------------

 compiler/rename/RnTypes.lhs |   15 +++++++++++++++
 1 files changed, 15 insertions(+), 0 deletions(-)

diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 7867c5c..b515f3a 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -370,9 +370,17 @@ bindHsTyVars doc mb_assoc kv_bndrs tv_bndrs thing_inside
                                  , kv <- kvs ]
              all_kvs = filterOut (`elemLocalRdrEnv` rdr_env) $
                        nub (kv_bndrs ++ kvs_from_tv_bndrs)
+             overlap_kvs = [ kv | kv <- all_kvs, any ((==) kv . hsLTyVarName) tvs ]
+                -- These variables appear both as kind and type variables
+                -- in the same declaration; eg  type family  T (x :: *) (y :: x)
+                -- We disallow this: too confusing!
+
        ; poly_kind <- xoptM Opt_PolyKinds
        ; unless (poly_kind || null all_kvs) 
                 (addErr (badKindBndrs doc all_kvs))
+       ; unless (null overlap_kvs) 
+                (addErr (overlappingKindVars doc overlap_kvs))
+
        ; loc <- getSrcSpanM
        ; kv_names <- mapM (newLocalBndrRn . L loc) all_kvs
        ; bindLocalNamesFV kv_names $ 
@@ -428,6 +436,13 @@ rnHsBndrSig doc (HsWB { hswb_cts = ty@(L loc _) }) thing_inside
        ; (res, fvs2) <- thing_inside (HsWB { hswb_cts = ty', hswb_kvs = kv_names, hswb_tvs = tv_names })
        ; return (res, fvs1 `plusFV` fvs2) } }
 
+overlappingKindVars :: HsDocContext -> [RdrName] -> SDoc
+overlappingKindVars doc kvs
+  = vcat [ ptext (sLit "Kind variable") <> plural kvs <+> 
+           ptext (sLit "also used as type variable") <> plural kvs 
+           <> colon <+> pprQuotedList kvs
+         , docOfHsDocContext doc ]
+
 badKindBndrs :: HsDocContext -> [RdrName] -> SDoc
 badKindBndrs doc kvs
   = vcat [ hang (ptext (sLit "Unexpected kind variable") <> plural kvs