+ go env ((bndr, rhs) : pairs) (bndr' : bndrs')
+ = simplRecOrTopPair env top_lvl bndr bndr' rhs `thenSmpl` \ (floats, env) ->
+ addFloats env floats (\env -> go env pairs bndrs')
+\end{code}
+
+
+simplRecOrTopPair is used for
+ * recursive bindings (whether top level or not)
+ * top-level non-recursive bindings
+
+It assumes the binder has already been simplified, but not its IdInfo.
+
+\begin{code}
+simplRecOrTopPair :: SimplEnv
+ -> TopLevelFlag
+ -> InId -> OutId -- Binder, both pre-and post simpl
+ -> InExpr -- The RHS and its environment
+ -> SimplM (FloatsWith SimplEnv)
+
+simplRecOrTopPair env top_lvl bndr bndr' rhs
+ | preInlineUnconditionally env top_lvl bndr -- Check for unconditional inline
+ = tick (PreInlineUnconditionally bndr) `thenSmpl_`
+ returnSmpl (emptyFloats env, extendSubst env bndr (ContEx (getSubstEnv env) rhs))
+
+ | otherwise
+ = simplLazyBind env top_lvl Recursive bndr bndr' rhs env
+ -- May not actually be recursive, but it doesn't matter
+\end{code}
+
+
+simplLazyBind is used for
+ * recursive bindings (whether top level or not)
+ * top-level non-recursive bindings
+ * non-top-level *lazy* non-recursive bindings
+
+[Thus it deals with the lazy cases from simplNonRecBind, and all cases
+from SimplRecOrTopBind]
+
+Nota bene:
+ 1. It assumes that the binder is *already* simplified,
+ and is in scope, but not its IdInfo
+
+ 2. It assumes that the binder type is lifted.
+
+ 3. It does not check for pre-inline-unconditionallly;
+ that should have been done already.
+
+\begin{code}
+simplLazyBind :: SimplEnv
+ -> TopLevelFlag -> RecFlag
+ -> InId -> OutId -- Binder, both pre-and post simpl
+ -> InExpr -> SimplEnv -- The RHS and its environment
+ -> SimplM (FloatsWith SimplEnv)
+
+simplLazyBind env top_lvl is_rec bndr bndr' rhs rhs_se
+ = -- Substitute IdInfo on binder, in the light of earlier
+ -- substitutions in this very letrec, and extend the
+ -- in-scope env, so that the IdInfo for this binder extends
+ -- over the RHS for the binder itself.
+ --
+ -- This is important. Manuel found cases where he really, really
+ -- wanted a RULE for a recursive function to apply in that function's
+ -- own right-hand side.
+ --
+ -- NB: does no harm for non-recursive bindings
+ let
+ is_top_level = isTopLevel top_lvl
+ bndr_ty' = idType bndr'
+ bndr'' = simplIdInfo (getSubst rhs_se) (idInfo bndr) bndr'
+ env1 = modifyInScope env bndr'' bndr''
+ rhs_env = setInScope rhs_se env1
+ ok_float_unlifted = not is_top_level && isNonRec is_rec
+ rhs_cont = mkStop bndr_ty' AnRhs
+ in
+ -- Simplify the RHS; note the mkStop, which tells
+ -- the simplifier that this is the RHS of a let.
+ simplExprF rhs_env rhs rhs_cont `thenSmpl` \ (floats, rhs1) ->
+
+ -- If any of the floats can't be floated, give up now
+ -- (The allLifted predicate says True for empty floats.)
+ if (not ok_float_unlifted && not (allLifted floats)) then
+ completeLazyBind env1 top_lvl bndr bndr''
+ (wrapFloats floats rhs1)
+ else
+
+ -- ANF-ise a constructor or PAP rhs
+ mkAtomicArgs False {- Not strict -}
+ ok_float_unlifted rhs1 `thenSmpl` \ (aux_binds, rhs2) ->
+
+ -- If the result is a PAP, float the floats out, else wrap them
+ -- By this time it's already been ANF-ised (if necessary)
+ if isEmptyFloats floats && null aux_binds then -- Shortcut a common case
+ completeLazyBind env1 top_lvl bndr bndr'' rhs2
+
+ -- We use exprIsTrivial here because we want to reveal lone variables.
+ -- E.g. let { x = letrec { y = E } in y } in ...
+ -- Here we definitely want to float the y=E defn.
+ -- exprIsValue definitely isn't right for that.
+ --
+ -- BUT we can't use "exprIsCheap", because that causes a strictness bug.
+ -- x = let y* = E in case (scc y) of { T -> F; F -> T}
+ -- The case expression is 'cheap', but it's wrong to transform to
+ -- y* = E; x = case (scc y) of {...}
+ -- Either we must be careful not to float demanded non-values, or
+ -- we must use exprIsValue for the test, which ensures that the
+ -- thing is non-strict. I think. The WARN below tests for this.
+ else if is_top_level || exprIsTrivial rhs2 || exprIsValue rhs2 then
+
+ -- There's a subtlety here. There may be a binding (x* = e) in the
+ -- floats, where the '*' means 'will be demanded'. So is it safe
+ -- to float it out? Answer no, but it won't matter because
+ -- we only float if arg' is a WHNF,
+ -- and so there can't be any 'will be demanded' bindings in the floats.
+ -- Hence the assert
+ WARN( any demanded_float (floatBinds floats),
+ ppr (filter demanded_float (floatBinds floats)) )
+
+ tick LetFloatFromLet `thenSmpl_` (
+ addFloats env1 floats $ \ env2 ->
+ addAtomicBinds env2 aux_binds $ \ env3 ->
+ completeLazyBind env3 top_lvl bndr bndr'' rhs2)
+
+ else
+ completeLazyBind env1 top_lvl bndr bndr'' (wrapFloats floats rhs1)
+
+#ifdef DEBUG
+demanded_float (NonRec b r) = isStrictDmd (idNewDemandInfo b) && not (isUnLiftedType (idType b))
+ -- Unlifted-type (cheap-eagerness) lets may well have a demanded flag on them
+demanded_float (Rec _) = False
+#endif