diff options
| author | David Feuer <david.feuer@gmail.com> | 2017-09-07 23:56:35 -0400 |
|---|---|---|
| committer | David Feuer <David.Feuer@gmail.com> | 2017-09-07 23:56:36 -0400 |
| commit | 011e15aa2d6949fc56126f1028ea25d5497196d9 (patch) | |
| tree | 2dfff303e970953b1d5fb5959911b8352ec14b29 /compiler/rename/RnExpr.hs | |
| parent | cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f (diff) | |
| download | haskell-011e15aa2d6949fc56126f1028ea25d5497196d9.tar.gz | |
Deal with unbreakable blocks in Applicative Do
The renamer wasn't able to deal with more than a couple strict
patterns in a row with `ApplicativeDo` when using the heuristic
splitter. Update it to work with them properly.
Reviewers: simonmar, austin, bgamari, hvr
Reviewed By: simonmar
Subscribers: RyanGlScott, lippling, rwbarton, thomie
GHC Trac Issues: #14163
Differential Revision: https://phabricator.haskell.org/D3900
Diffstat (limited to 'compiler/rename/RnExpr.hs')
| -rw-r--r-- | compiler/rename/RnExpr.hs | 7 |
1 files changed, 5 insertions, 2 deletions
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 477a448332..5ccefb8467 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -1821,9 +1821,12 @@ slurpIndependentStmts slurpIndependentStmts stmts = go [] [] emptyNameSet stmts where -- If we encounter a BindStmt that doesn't depend on a previous BindStmt - -- in this group, then add it to the group. + -- in this group, then add it to the group. We have to be careful about + -- strict patterns though; splitSegments expects that if we return Just + -- then we have actually done some splitting. Otherwise it will go into + -- an infinite loop (#14163). go lets indep bndrs ((L loc (BindStmt pat body bind_op fail_op ty), fvs) : rest) - | isEmptyNameSet (bndrs `intersectNameSet` fvs) + | isEmptyNameSet (bndrs `intersectNameSet` fvs) && not (isStrictPattern pat) = go lets ((L loc (BindStmt pat body bind_op fail_op ty), fvs) : indep) bndrs' rest where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat) |