X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreLint.lhs;h=31a52f0bba114a573f1f126c7f4e92a287df7086;hb=ef47b5c2f44fce638b623c9cf5bb2f7f62ba619d;hp=2d5a4fd3918243ca45ddfebf26690e9de620d3aa;hpb=44ba24dc84d271ca9bd5ab5060cb63ed87f585e3;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 2d5a4fd..31a52f0 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -37,7 +37,7 @@ import Type ( Type, tyVarsOfType, coreEqType, TvSubst, TvSubstEnv, mkTvSubst, setTvSubstEnv, substTy, extendTvSubst, composeTvSubst, substTyVarBndr, isInScope, getTvSubstEnv, getTvInScope, mkTyVarTy ) -import Coercion ( Coercion, coercionKind, coercionKindTyConApp ) +import Coercion ( Coercion, coercionKind, coercionKindPredTy ) import TyCon ( isPrimTyCon, isNewTyCon ) import BasicTypes ( RecFlag(..), Boxity(..), isNonRec ) import StaticFlags ( opt_PprStyle_Debug ) @@ -431,7 +431,7 @@ checkKinds tyvar arg_ty (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} @@ -500,7 +500,7 @@ lintCoreAlt scrut_ty alt_ty alt@(LitAlt lit, args, rhs) = 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 -> + = lintBinders args $ \ args -> do { addLoc (CasePat alt) $ do { -- Check the pattern @@ -509,8 +509,7 @@ lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs) -- NB: args must be in scope here so that the lintCoreArgs line works. -- NB: relies on existential type args coming *after* ordinary type args - ; con_result_ty <- - lintCoreArgs (dataConRepType con) + ; con_result_ty <- lintCoreArgs (dataConRepType con) (map Type tycon_arg_tys ++ varsToCoreExprs args) ; checkTys con_result_ty scrut_ty (mkBadPatMsg con_result_ty scrut_ty) }