- -- Check that the name space is correct!
- cmpTyVar (L l ty@(HsTyVar tv)) classTV = -- just a type variable
- checkM (rdrNameOcc tv == nameOccName classTVName) $
- mustMatchErr l ty classTVName
- where
- classTVName = hsLTyVarName classTV
- cmpTyVar (L l ty@(HsKindSig (L _ (HsTyVar tv)) k)) _ | isRdrTyVar tv =
- noKindSigErr l tv -- additional kind sig not allowed at class parms
- cmpTyVar (L l otherTy) _ =
- tyVarExpectedErr l -- parameter must be a type variable
-
- -- Check that the name space is correct!
- chkTyVar (L l (HsKindSig (L _ (HsTyVar tv)) k))
- | isRdrTyVar tv = return $ Just (L l (KindedTyVar tv k))
- chkTyVar (L l (HsTyVar tv))
- | isRdrTyVar tv = return $ Just (L l (UserTyVar tv))
- chkTyVar (L l otherTy) = tyVarExpectedErr l >> return Nothing
- -- drop parameter; we stop after renaming anyways
-
- rn_derivs Nothing = returnM (Nothing, emptyFVs)
- rn_derivs (Just ds) = do
- ds' <- rnLHsTypes data_doc ds
- returnM (Just ds', extractHsTyNames_s ds')
-
- atNoCtxt = text "Associated data type declarations cannot have a context"
- atNoCons = text "Associated data type declarations cannot have any constructors"
- data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
-
-noKindSigErr l ty =
- addErrAt l $
- sep [ptext SLIT("No kind signature allowed at copies of class parameters:"),
- nest 2 $ ppr ty]
-
-mustMatchErr l ty classTV =
- addErrAt l $
- sep [ptext SLIT("Type variable"), quotes (ppr ty),
- ptext SLIT("must match corresponding class parameter"),
- quotes (ppr classTV)]
-
-tyVarExpectedErr l =
- addErrAt l (ptext SLIT("Type found where type variable expected"))
+
+rnTySig (tydecl@TyFunction {tcdLName = tycon, tcdTyVars = tyvars,
+ tcdKind = sig})
+ bindIdxVars =
+ do { checkM (not . null $ tyvars) $ addErr needOneIdx -- #indexes >= 1
+ ; bindIdxVars (ksig_doc tycon) tyvars $ \tyvars' -> do {
+ ; tycon' <- lookupLocatedTopBndrRn tycon
+ ; returnM (TyFunction {tcdLName = tycon', tcdTyVars = tyvars',
+ tcdIso = tcdIso tydecl, tcdKind = sig},
+ emptyFVs) } }
+
+ksig_doc tycon = text "In the kind signature for" <+> quotes (ppr tycon)
+needOneIdx = text "Kind signature requires at least one type index"
+
+-- Rename associated type declarations (in classes)
+--
+-- * This can be data declarations, type function signatures, and (default)
+-- type function equations.
+--
+rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
+rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
+ where
+ rn_at (tydecl@TyData {}) = rnTySig tydecl lookupIdxVars
+ rn_at (tydecl@TyFunction {}) = rnTySig tydecl lookupIdxVars
+ rn_at (tydelc@TySynonym {}) = panic "!!!TODO: case not impl yet"
+ rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
+
+ lookupIdxVars _ tyvars cont = mappM lookupIdxVar tyvars >>= cont
+ --
+ -- Type index variables must be class parameters, which are the only
+ -- type variables in scope at this point.
+ lookupIdxVar (L l tyvar) =
+ do
+ name' <- lookupOccRn (hsTyVarName tyvar)
+ return $ L l (replaceTyVarName tyvar name')