- will_float_past_lambda = -- Will escape lambda if let-bound
- ids_only_lvl `ltMajLvl` ctxt_lvl
-
- worth_type_abstraction = -- Will escape (more) lambda(s)/type lambda(s)
- -- if type abstracted
- (ids_only_lvl `ltLvl` tyvars_only_lvl)
- && not (is_trivial de_ann_expr) -- avoids abstracting trivial type applications
-
- de_ann_expr = deAnnotate expr
-
- is_trivial (App e a)
- | notValArg a = is_trivial e
- is_trivial (Var _) = True
- is_trivial _ = False
-
- offending_tyvars = filter offending tv_list
- --non_offending_tyvars = filter (not . offending) tv_list
- --non_offending_tyvars_lvl = foldr (maxLvl . tyvarLevel tenv) tOP_LEVEL non_offending_tyvars
-
- offending tyvar = ids_only_lvl `ltLvl` tyvarLevel tenv tyvar
-
- manifestly_whnf = manifestlyWHNF de_ann_expr || manifestlyBottom de_ann_expr
-
- maybe_unTopify Top | not (canFloatToTop (ty, expr)) = Level 0 0
- maybe_unTopify lvl = lvl
- {- ToDo [Andre]: the line above (maybe) should be Level 1 0,
- -- so that the let will not go past the *last* lambda if it can
- -- generate a space leak. If it is already in major level 0
- -- It won't do any harm to give it a Level 1 0.
- -- we should do the same test not only for things with level Top,
- -- but also for anything that gets a major level 0.
- the problem is that
- f = \a -> let x = [1..1000]
- in zip a x
- ==>
- f = let x = [1..1000]
- in \a -> zip a x
- is just as bad as floating x to the top level.
- Notice it would be OK in cases like
- f = \a -> let x = [1..1000]
- y = length x
- in a + y
- ==>
- f = let x = [1..1000]
- y = length x
- in \a -> a + y
- as x will be gc'd after y is updated.
- [We did not hit any problems with the above (Level 0 0) code
- in nofib benchmark]
- -}
+ -- Will escape lambda if let-bound
+ will_float_past_lambda = ids_only_lvl `ltMajLvl` ctxt_lvl
+
+ -- Will escape (more) lambda(s)/type lambda(s) if type abstracted
+ worth_type_abstraction = (ids_only_lvl `ltLvl` tyvars_only_lvl)
+ && not expr_is_trivial -- Avoids abstracting trivial type applications
+
+ offending_tyvars = filter offending_tv (varSetElems fvs)
+ offending_tv var | isId var = False
+ | otherwise = ids_only_lvl `ltLvl` varLevel env var
+
+ expr_is_trivial = exprIsTrivial de_ann_expr
+ expr_is_bottom = exprIsBottom de_ann_expr
+ de_ann_expr = deAnnotate expr