+lintTyApp ty arg_ty
+ = case splitForAllTy_maybe ty of
+ Nothing -> addErrL (mkTyAppMsg ty arg_ty)
+
+ Just (tyvar,body) ->
+ if not (isTyVar tyvar) then addErrL (mkTyAppMsg ty arg_ty) else
+ let
+ tyvar_kind = tyVarKind tyvar
+ argty_kind = typeKind arg_ty
+ in
+ if argty_kind `hasMoreBoxityInfo` tyvar_kind
+ -- Arg type might be boxed for a function with an uncommitted
+ -- tyvar; notably this is used so that we can give
+ -- error :: forall a:*. String -> a
+ -- and then apply it to both boxed and unboxed types.
+ then
+ returnL (substTy (mkTyVarSubst [tyvar] [arg_ty]) body)
+ else
+ addErrL (mkKindErrMsg tyvar arg_ty)
+
+lintTyApps fun_ty []
+ = returnL fun_ty
+
+lintTyApps fun_ty (arg_ty : arg_tys)
+ = lintTyApp fun_ty arg_ty `thenL` \ fun_ty' ->
+ lintTyApps fun_ty' arg_tys
+\end{code}
+
+
+
+%************************************************************************
+%* *
+\subsection[lintCoreAlts]{lintCoreAlts}
+%* *
+%************************************************************************
+
+\begin{code}
+checkAllCasesCovered :: CoreExpr -> Type -> [CoreAlt] -> LintM ()
+
+checkAllCasesCovered e ty [] = addErrL (mkNullAltsMsg e)
+
+checkAllCasesCovered e ty [(DEFAULT,_,_)] = nopL
+
+checkAllCasesCovered e scrut_ty alts
+ = case splitTyConApp_maybe scrut_ty of {
+ Nothing -> addErrL (badAltsMsg e);
+ Just (tycon, tycon_arg_tys) ->
+
+ if isPrimTyCon tycon then
+ checkL (hasDefault alts) (nonExhaustiveAltsMsg e)
+ else
+{- No longer needed
+#ifdef DEBUG
+ -- Algebraic cases are not necessarily exhaustive, because
+ -- the simplifer correctly eliminates case that can't
+ -- possibly match.
+ -- This code just emits a message to say so
+ let
+ missing_cons = filter not_in_alts (tyConDataCons tycon)
+ not_in_alts con = all (not_in_alt con) alts
+ not_in_alt con (DataCon con', _, _) = con /= con'
+ not_in_alt con other = True
+
+ case_bndr = case e of { Case _ bndr alts -> bndr }
+ in
+ if not (hasDefault alts || null missing_cons) then
+ pprTrace "Exciting (but not a problem)! Non-exhaustive case:"
+ (ppr case_bndr <+> ppr missing_cons)
+ nopL