isKindSigDecl other = False
-- definition of an instance of an indexed type
-isIdxTyDecl = isJust . tcdTyPats
+isIdxTyDecl tydecl
+ | isSynDecl tydecl || isDataDecl tydecl = isJust (tcdTyPats tydecl)
+ | otherwise = False
\end{code}
Dealing with names
-- We use the equality to filter out duplicate field names
tyClDeclNames (TyFunction {tcdLName = name}) = [name]
-tyClDeclNames (TySynonym {tcdLName = name,
- tcdTyPats= Nothing}) = [name]
-tyClDeclNames (TySynonym {} ) = [] -- type equation
+tyClDeclNames (TySynonym {tcdLName = name}) = [name]
tyClDeclNames (ForeignType {tcdLName = name}) = [name]
tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
cvBindsAndSigs (unLoc $4)
; (ctxt, tc, tvs, tparms) = unLoc $2}
; checkTyVars tparms False -- only type vars allowed
+ ; checkKindSigs ats
; return $ L (comb4 $1 $2 $3 $4)
(mkClassDecl (ctxt, tc, tvs)
(unLoc $3) sigs binds ats) } }
checkTyClHdr, -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName], [LHsType RdrName])
checkTyVars, -- [LHsType RdrName] -> Bool -> P ()
checkSynHdr, -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName], Maybe [LHsType RdrName])
+ checkKindSigs, -- [LTyClDecl RdrName] -> P ()
checkTopTypeD, -- LTyClDecl RdrName -> P (HsDecl RdrName)
checkInstType, -- HsType -> P HsType
checkPattern, -- HsExp -> P HsPat
-> (Bag (LHsBind RdrName), [LSig RdrName], [LTyClDecl RdrName])
-- Input decls contain just value bindings and signatures
-- and in case of class or instance declarations also
--- associated data or synonym definitions
+-- associated type declarations
cvBindsAndSigs fb = go (fromOL fb)
where
go [] = (emptyBag, [], [])
tvs' <- collects tvs ts
collect tvs' t
+-- Check that associated type declarations of a class are all kind signatures.
+--
+checkKindSigs :: [LTyClDecl RdrName] -> P ()
+checkKindSigs = mapM_ check
+ where
+ check (L l tydecl)
+ | isKindSigDecl tydecl
+ || isSynDecl tydecl = return ()
+ | otherwise =
+ parseError l "Type declaration in a class must be a kind signature or synonym default"
+
-- Wrap a toplevel type or data declaration into 'TyClD' and ensure for
-- data declarations that all type parameters are variables only (which is in
-- contrast to type functions and associated type declarations).
import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl,
ForeignDecl(..), HsGroup(..), HsValBinds(..),
Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
- instDeclATs,
+ instDeclATs, isIdxTyDecl,
LIE )
import RnEnv
import IfaceEnv ( ifaceExportNames )
new_tc tc_decl
= do { main_name <- newTopSrcBinder mod Nothing main_rdr
; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
- ; return (main_name : sub_names) }
+ ; if isIdxTyDecl (unLoc tc_decl) -- index type definitions
+ then return ( sub_names) -- are usage occurences
+ else return (main_name : sub_names) }
where
(main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
inst_ats inst_decl
- = mappM (liftM tail . new_tc) (instDeclATs (unLoc inst_decl))
- -- drop main_rdr (already declared in class)
+ = mappM new_tc (instDeclATs (unLoc inst_decl))
\end{code}
-- to remove the context).
\end{code}
-Renaming of the associated data definitions requires adding the instance
-context, as the rhs of an AT declaration may use ATs from classes in the
-context.
+Renaming of the associated type definitions in instances.
+
+* In the case of associated data and newtype definitions we add the instance
+ context.
+* We raise an error if we encounter a kind signature in an instance.
\begin{code}
rnATDefs :: HsContext RdrName -> [LTyClDecl RdrName]
-> RnM ([LTyClDecl Name], FreeVars)
rnATDefs ctxt atDecls =
- mapFvRn (wrapLocFstM addCtxtAndRename) atDecls
+ mapFvRn (wrapLocFstM rnAtDef) atDecls
where
- -- The parser won't accept anything, but a data declaration
- addCtxtAndRename ty@TyData {tcdCtxt = L l tyCtxt} =
- rnTyClDecl (ty {tcdCtxt = L l (ctxt ++ tyCtxt)})
- -- The source loc is somewhat half hearted... -=chak
+ rnAtDef tydecl@TyFunction {} =
+ do
+ addErr noKindSig
+ rnTyClDecl tydecl
+ rnAtDef tydecl@TySynonym {} = rnTyClDecl tydecl
+ rnAtDef tydecl@TyData {tcdCtxt = L l tyCtxt} =
+ do
+ checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
+ rnTyClDecl (tydecl {tcdCtxt = L l (ctxt ++ tyCtxt)})
+ -- The source loc is somewhat half hearted... -=chak
+ rnAtDef _ =
+ panic "RnSource.rnATDefs: not a type declaration"
+
+noKindSig = text "Instances cannot have kind signatures"
\end{code}
For the method bindings in class and instance decls, we extend the
-- Rename associated type declarations (in classes)
--
--- * This can be data declarations, type function signatures, and (default)
--- type function equations.
+-- * This can be kind 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 (tydecl@TySynonym {}) = rnTyClDecl tydecl
+ rn_at (tydecl@TySynonym {}) =
+ do
+ checkM (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
+ rnTyClDecl tydecl
rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
lookupIdxVars _ tyvars cont = mappM lookupIdxVar tyvars >>= cont
name' <- lookupOccRn (hsTyVarName tyvar)
return $ L l (replaceTyVarName tyvar name')
+noPatterns = text "Default definition for an associated synonym cannot have"
+ <+> text "type pattern"
+
-- This data decl will parse OK
-- data T = a Int
-- treating "a" as the constructor.