TvSubst, TvSubstEnv, mkTvSubst, setTvSubstEnv, substTy,
extendTvSubst, composeTvSubst, substTyVarBndr, isInScope,
getTvSubstEnv, getTvInScope, mkTyVarTy )
-import Coercion ( Coercion, coercionKind, coercionKindTyConApp )
-import TyCon ( isPrimTyCon )
+import Coercion ( Coercion, coercionKind, coercionKindPredTy )
+import TyCon ( isPrimTyCon, isNewTyCon )
import BasicTypes ( RecFlag(..), Boxity(..), isNonRec )
import StaticFlags ( opt_PprStyle_Debug )
import DynFlags ( DynFlags, DynFlag(..), dopt )
lintCoreArg fun_ty arg =
-- Make sure function type matches argument
do { arg_ty <- lintCoreExpr arg
- ; let err = mkAppMsg fun_ty arg_ty arg
+ ; let err1 = mkAppMsg fun_ty arg_ty arg
+ err2 = mkNonFunAppMsg fun_ty arg_ty arg
; case splitFunTy_maybe fun_ty of
Just (arg,res) ->
- do { checkTys arg arg_ty err
+ do { checkTys arg arg_ty err1
; return res }
- _ -> addErrL err }
+ _ -> addErrL err2 }
\end{code}
\begin{code}
(mkKindErrMsg tyvar arg_ty)
where
tyvar_kind = tyVarKind tyvar
- arg_kind | isCoVar tyvar = coercionKindTyConApp arg_ty
+ arg_kind | isCoVar tyvar = coercionKindPredTy arg_ty
| otherwise = typeKind arg_ty
\end{code}
lit_ty = literalType lit
lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs)
+ | isNewTyCon (dataConTyCon con) = addErrL (mkNewTyDataConAltMsg scrut_ty alt)
| Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty
= addLoc (CaseAlt alt) $ lintBinders args $ \ args ->
text "Scrutinee type:" <+> ppr scrut_ty,
text "Alternative:" <+> pprCoreAlt alt ]
+mkNewTyDataConAltMsg :: Type -> CoreAlt -> Message
+mkNewTyDataConAltMsg scrut_ty alt
+ = vcat [ text "Data alternative for newtype datacon",
+ text "Scrutinee type:" <+> ppr scrut_ty,
+ text "Alternative:" <+> pprCoreAlt alt ]
+
+
------------------------------------------------------
-- Other error messages
hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
hang (ptext SLIT("Arg:")) 4 (ppr arg)]
+mkNonFunAppMsg :: Type -> Type -> CoreExpr -> Message
+mkNonFunAppMsg fun_ty arg_ty arg
+ = vcat [ptext SLIT("Non-function type in function position"),
+ hang (ptext SLIT("Fun type:")) 4 (ppr fun_ty),
+ hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
+ hang (ptext SLIT("Arg:")) 4 (ppr arg)]
+
mkKindErrMsg :: TyVar -> Type -> Message
mkKindErrMsg tyvar arg_ty
= vcat [ptext SLIT("Kinds don't match in type application:"),