diff options
Diffstat (limited to 'compiler/coreSyn/CoreLint.hs')
| -rw-r--r-- | compiler/coreSyn/CoreLint.hs | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index f879a30300..1cbfcd6c50 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -749,7 +749,7 @@ lintCoreExpr (Let (NonRec bndr rhs) body) | isId bndr = do { lintSingleBinding NotTopLevel NonRecursive (bndr,rhs) ; addLoc (BodyOfLetRec [bndr]) - (lintIdBndr NotTopLevel LetBind bndr $ \_ -> + (lintBinder LetBind bndr $ \_ -> addGoodJoins [bndr] $ lintCoreExpr body) } @@ -826,7 +826,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = ; subst <- getTCvSubst ; ensureEqTys var_ty scrut_ty (mkScrutMsg var var_ty scrut_ty subst) - ; lintIdBndr NotTopLevel CaseBind var $ \_ -> + ; lintBinder CaseBind var $ \_ -> do { -- Check the alternatives mapM_ (lintCoreAlt scrut_ty alt_ty) alts ; checkCaseAlts e scrut_ty alts @@ -1247,6 +1247,7 @@ lintIdBndr top_lvl bind_site id linterF (mkNonTopExternalNameMsg id) ; (ty, k) <- lintInTy (idType id) + -- See Note [Levity polymorphism invariants] in CoreSyn ; lintL (isJoinId id || not (isKindLevPoly k)) (text "Levity-polymorphic binder:" <+> @@ -1257,6 +1258,11 @@ lintIdBndr top_lvl bind_site id linterF checkL (not is_top_lvl && is_let_bind) $ mkBadJoinBindMsg id + -- Check that the Id does not have type (t1 ~# t2) or (t1 ~R# t2); + -- if so, it should be a CoVar, and checked by lintCoVarBndr + ; lintL (not (isCoercionType ty)) + (text "Non-CoVar has coercion type" <+> ppr id <+> dcolon <+> ppr ty) + ; let id' = setIdType id ty ; addInScopeVar id' $ (linterF id') } where |