diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-07-08 15:09:52 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-07-09 23:01:24 -0400 |
| commit | d2e290d3280841647354ddf5ca9abdd974bce0d5 (patch) | |
| tree | f8e2274f28a725ed0a7d32753e3aefc64d2a69a2 /compiler/coreSyn/CoreLint.hs | |
| parent | a35e091616a24b57c229cf50c8d43f8f6bfb5524 (diff) | |
| download | haskell-d2e290d3280841647354ddf5ca9abdd974bce0d5.tar.gz | |
Fix erroneous float in CoreOpt
The simple optimiser was making an invalid transformation
to join points -- yikes. The fix is easy.
I also added some documentation about the fact that GHC uses
a slightly more restrictive version of join points than does
the paper.
Fix #16918
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 ------------------ |