summaryrefslogtreecommitdiff
path: root/compiler/simplCore/FloatIn.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/simplCore/FloatIn.hs')
-rw-r--r--compiler/simplCore/FloatIn.hs16
1 files changed, 14 insertions, 2 deletions
diff --git a/compiler/simplCore/FloatIn.hs b/compiler/simplCore/FloatIn.hs
index 3e44e81cea..2593b1d7a1 100644
--- a/compiler/simplCore/FloatIn.hs
+++ b/compiler/simplCore/FloatIn.hs
@@ -19,6 +19,8 @@ module FloatIn ( floatInwards ) where
#include "HsVersions.h"
+import GhcPrelude
+
import CoreSyn
import MkCore
import HscTypes ( ModGuts(..) )
@@ -179,7 +181,7 @@ fiExpr dflags to_drop ann_expr@(_,AnnApp {})
-- lists without evaluating extra_fvs, and hence without
-- peering into each argument
- (_, extra_fvs) = foldl add_arg (fun_ty, extra_fvs0) ann_args
+ (_, extra_fvs) = foldl' add_arg (fun_ty, extra_fvs0) ann_args
extra_fvs0 = case ann_fun of
(_, AnnVar _) -> fun_fvs
_ -> emptyDVarSet
@@ -413,6 +415,16 @@ But there are wrinkles
cases like Trac #5658. This is implemented in sepBindsByJoinPoint;
if is_case is False we dump all floating cases right here.
+* Trac #14511 is another example of why we want to restrict float-in
+ of case-expressions. Consider
+ case indexArray# a n of (# r #) -> writeArray# ma i (f r)
+ Now, floating that indexing operation into the (f r) thunk will
+ not create any new thunks, but it will keep the array 'a' alive
+ for much longer than the programmer expected.
+
+ So again, not floating a case into a let or argument seems like
+ the Right Thing
+
For @Case@, the possible drop points for the 'to_drop'
bindings are:
(a) inside the scrutinee
@@ -459,7 +471,7 @@ fiExpr dflags to_drop (_, AnnCase scrut case_bndr ty alts)
alts_fvs = map alt_fvs alts
all_alts_fvs = unionDVarSets alts_fvs
alt_fvs (_con, args, rhs)
- = foldl delDVarSet (freeVarsOf rhs) (case_bndr:args)
+ = foldl' delDVarSet (freeVarsOf rhs) (case_bndr:args)
-- Delete case_bndr and args from free vars of rhs
-- to get free vars of alt