- Just (tyvar,body) | (getTyVarKind tyvar == getTypeKind arg_ty) ->
- returnL(Just(instantiateTy [(tyvar,arg_ty)] body))
- _ -> addErrL (mkTyAppMsg ty arg_ty e) `seqL` returnL Nothing
+ Nothing -> addErrL (mkTyAppMsg SLIT("Illegal") ty arg_ty e) `seqL` returnL Nothing
+
+ Just (tyvar,body) ->
+ let
+ tyvar_kind = tyVarKind tyvar
+ argty_kind = typeKind arg_ty
+ in
+ if tyvar_kind == argty_kind
+-- SUSPICIOUS! (tyvar_kind `isSubKindOf` argty_kind
+-- || argty_kind `isSubKindOf` tyvar_kind)
+ then
+ returnL(Just(instantiateTy [(tyvar,arg_ty)] body))
+ else
+ pprTrace "lintCoreArg:kinds:" (ppCat [ppr PprDebug tyvar_kind, ppr PprDebug argty_kind]) $
+ addErrL (mkTyAppMsg SLIT("Kinds not right in") ty arg_ty e) `seqL` returnL Nothing