+ do_pair (b,r) = coreSatTopRhs b r `thenUs` \ (floats, r') ->
+ returnUs (floats, (b, r'))
+
+coreSatTopRhs :: Id -> CoreExpr -> UniqSM ([CoreBind], CoreExpr)
+-- The trick here is that if we see
+-- x = $wC p $wJust q
+-- we want to transform to
+-- sat = \a -> $wJust a
+-- x = $wC p sat q
+-- and NOT to
+-- x = let sat = \a -> $wJust a in $wC p sat q
+--
+-- The latter is bad because the thing was a value before, but
+-- is a thunk now, and that's wrong because now x may need to
+-- be in other bindings' SRTs.
+-- This has to be right for recursive as well as non-recursive bindings
+--
+-- Notice that it's right to give sat vanilla IdInfo; in particular NoCafRefs
+--
+-- You might worry that arity might increase, thus
+-- x = $wC a ==> x = \ b c -> $wC a b c
+-- but the simpifier does eta expansion vigorously, so I don't think this
+-- can occur. If it did, it would be a problem, because x's arity changes,
+-- so we have an ASSERT to check. (I use WARN so we can see the output.)
+
+coreSatTopRhs b rhs
+ = coreSatExprFloat rhs `thenUs` \ (floats, rhs1) ->
+ if exprIsValue rhs then
+ ASSERT( allLazy floats )
+ WARN( idArity b /= exprArity rhs1, ptext SLIT("Disaster!") <+> ppr b )
+ returnUs ([bind | FloatLet bind <- fromOL floats], rhs1)
+ else
+ mkBinds floats rhs1 `thenUs` \ rhs2 ->
+ WARN( idArity b /= exprArity rhs2, ptext SLIT("Disaster!") <+> ppr b )
+ returnUs ([], rhs2)