#include "HsVersions.h"
-import SimplMonad
+import SimplMonad
import IdInfo
import CoreSyn
import Rules
import BasicTypes
import DynFlags
import Util
+import MonadUtils
import Outputable
+import FastString
import Data.List
\end{code}
= env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
seInScope = extendInScopeSet (seInScope env) id }
-extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
+extendFloats :: SimplEnv -> OutBind -> SimplEnv
-- Add these bindings to the floats, and extend the in-scope env too
-extendFloats env binds
- = env { seFloats = seFloats env `addFlts` new_floats,
+extendFloats env bind
+ = env { seFloats = seFloats env `addFlts` unitFloat bind,
seInScope = extendInScopeSetList (seInScope env) bndrs }
where
- bndrs = bindersOfBinds binds
- new_floats = Floats (toOL binds)
- (foldr (andFF . classifyFF) FltLifted binds)
+ bndrs = bindersOf bind
addFloats :: SimplEnv -> SimplEnv -> SimplEnv
-- Add the floats for env2 to env1;
\begin{code}
simplBinders, simplLamBndrs
:: SimplEnv -> [InBndr] -> SimplM (SimplEnv, [OutBndr])
-simplBinders env bndrs = mapAccumLSmpl simplBinder env bndrs
-simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
+simplBinders env bndrs = mapAccumLM simplBinder env bndrs
+simplLamBndrs env bndrs = mapAccumLM simplLamBndr env bndrs
-------------
simplBinder :: SimplEnv -> InBndr -> SimplM (SimplEnv, OutBndr)
-- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
simplLamBndr env bndr
| isId bndr && hasSomeUnfolding old_unf = seqId id2 `seq` return (env2, id2) -- Special case
- | otherwise = seqId id1 `seq` return (env1, id1) -- Normal case
+ | otherwise = simplBinder env bndr -- Normal case
where
old_unf = idUnfolding bndr
(env1, id1) = substIdBndr env bndr