diff options
Diffstat (limited to 'compiler/coreSyn/CoreLint.hs')
| -rw-r--r-- | compiler/coreSyn/CoreLint.hs | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index a84f2fe029..9247498c74 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -786,8 +786,10 @@ lintCoreExpr (Lam var expr) lintCoreExpr e@(Case scrut var alt_ty alts) = -- Check the scrutinee - do { let scrut_diverges = exprIsBottom scrut - ; scrut_ty <- markAllJoinsBad $ lintCoreExpr scrut + do { scrut_ty <- markAllJoinsBad $ lintCoreExpr scrut + -- See Note [Join points are less general than the paper] + -- in CoreSyn + ; (alt_ty, _) <- lintInTy alt_ty ; (var_ty, _) <- lintInTy (idType var) @@ -810,7 +812,7 @@ lintCoreExpr e@(Case scrut var alt_ty alts) = , isAlgTyCon tycon , not (isAbstractTyCon tycon) , null (tyConDataCons tycon) - , not scrut_diverges + , not (exprIsBottom scrut) -> pprTrace "Lint warning: case binder's type has no constructors" (ppr var <+> ppr (idType var)) -- This can legitimately happen for type families $ return () @@ -880,6 +882,7 @@ lintCoreFun (Lam var body) nargs lintCoreFun expr nargs = markAllJoinsBadIf (nargs /= 0) $ + -- See Note [Join points are less general than the paper] lintCoreExpr expr ------------------ |