Kind and type checking of indexed types

[ghc-hetmet.git] / compiler / rename / RnSource.lhs

diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index e29c2fe..606139b 100644 (file)
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -43,7 +43,7 @@ import SrcLoc         ( Located(..), unLoc, noLoc )
 import DynFlags        ( DynFlag(..) )
 import Maybes          ( seqMaybe )
 import Maybe            ( isNothing, isJust )
-import Monad           ( liftM )
+import Monad           ( liftM, when )
 import BasicTypes       ( Boxity(..) )
 \end{code}
 
@@ -280,7 +280,7 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
        -- The typechecker (not the renamer) checks that all 
        -- the declarations are for the right class
     let
-       at_doc   = text "In the associated types in an instance declaration"
+       at_doc   = text "In the associated types of an instance declaration"
        at_names = map (head . tyClDeclNames . unLoc) ats
     in
     checkDupNames at_doc at_names              `thenM_`
@@ -787,8 +787,11 @@ rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
         rnTyClDecl tydecl
     rn_at _                      = panic "RnSource.rnATs: invalid TyClDecl"
 
-    lookupIdxVars _ tyvars cont = mappM lookupIdxVar tyvars >>= cont
-    --
+    lookupIdxVars _ tyvars cont = 
+      do { checkForDups tyvars;
+        ; tyvars' <- mappM lookupIdxVar tyvars
+        ; cont tyvars'
+        }
     -- Type index variables must be class parameters, which are the only
     -- type variables in scope at this point.
     lookupIdxVar (L l tyvar) =
@@ -796,9 +799,27 @@ rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
        name' <- lookupOccRn (hsTyVarName tyvar)
        return $ L l (replaceTyVarName tyvar name')
 
+    -- Type variable may only occur once.
+    --
+    checkForDups [] = return ()
+    checkForDups (L loc tv:ltvs) = 
+      do { setSrcSpan loc $
+            when (hsTyVarName tv `ltvElem` ltvs) $
+              addErr (repeatedTyVar tv)
+        ; checkForDups ltvs
+        }
+
+    rdrName `ltvElem` [] = False
+    rdrName `ltvElem` (L _ tv:ltvs)
+      | rdrName == hsTyVarName tv = True
+      | otherwise                = rdrName `ltvElem` ltvs
+
 noPatterns = text "Default definition for an associated synonym cannot have"
             <+> text "type pattern"
 
+repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
+                  quotes (ppr tv)
+
 -- This data decl will parse OK
 --     data T = a Int
 -- treating "a" as the constructor.