import VarSet ( elemVarSet )
import Name ( Name )
import Outputable
-import Util ( zipLazy, isSingleton, notNull )
+import Util ( zipLazy, isSingleton, notNull, sortLe )
import List ( partition )
import SrcLoc ( Located(..), unLoc, getLoc )
import ListSetOps ( equivClasses )
do { tc_ty_thing <- tcLookupLocated (tcdLName decl)
; let tc_kind = case tc_ty_thing of { AThing k -> k }
; unifyKind tc_kind (foldr (mkArrowKind . kindedTyVarKind)
- liftedTypeKind kinded_tvs)
+ (result_kind decl)
+ kinded_tvs)
; thing_inside kinded_tvs }
+ where
+ result_kind (TyData { tcdKindSig = Just kind }) = kind
+ result_kind other = liftedTypeKind
+ -- On GADT-style declarations we allow a kind signature
+ -- data T :: *->* where { ... }
kindedTyVarKind (L _ (KindedTyVar _ k)) = k
\end{code}
ptext SLIT("You can only use type variables, arrows, and tuples")])
recSynErr syn_decls
- = setSrcSpan (getLoc (head syn_decls)) $
+ = setSrcSpan (getLoc (head sorted_decls)) $
addErr (sep [ptext SLIT("Cycle in type synonym declarations:"),
- nest 2 (vcat (map ppr_decl syn_decls))])
+ nest 2 (vcat (map ppr_decl sorted_decls))])
where
+ sorted_decls = sortLocated syn_decls
ppr_decl (L loc decl) = ppr loc <> colon <+> ppr decl
recClsErr cls_decls
- = setSrcSpan (getLoc (head cls_decls)) $
+ = setSrcSpan (getLoc (head sorted_decls)) $
addErr (sep [ptext SLIT("Cycle in class declarations (via superclasses):"),
- nest 2 (vcat (map ppr_decl cls_decls))])
+ nest 2 (vcat (map ppr_decl sorted_decls))])
where
+ sorted_decls = sortLocated cls_decls
ppr_decl (L loc decl) = ppr loc <> colon <+> ppr (decl { tcdSigs = [] })
+sortLocated :: [Located a] -> [Located a]
+sortLocated things = sortLe le things
+ where
+ le (L l1 _) (L l2 _) = l1 <= l2
+
exRecConErr name
= ptext SLIT("Can't combine named fields with locally-quantified type variables or context")
$$