-import CoreUtils( exprType, exprIsValue, etaExpand, exprArity, exprOkForSpeculation )
+import CoreUtils( exprType, exprIsHNF, etaExpand, exprArity, exprOkForSpeculation )
-- Ensure that the argument of DataToTagOp is evaluated
eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
eval_data2tag_arg app@(fun `App` arg)
-- Ensure that the argument of DataToTagOp is evaluated
eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
eval_data2tag_arg app@(fun `App` arg)
= returnUs (emptyFloats, app) -- The arg is evaluated
| otherwise -- Arg not evaluated, so evaluate it
= newVar (exprType arg) `thenUs` \ arg_id ->
= returnUs (emptyFloats, app) -- The arg is evaluated
| otherwise -- Arg not evaluated, so evaluate it
= newVar (exprType arg) `thenUs` \ arg_id ->
= let -- Don't make a case for a value binding,
-- even if it's strict. Otherwise we get
-- case (\x -> e) of ...!
= let -- Don't make a case for a value binding,
-- even if it's strict. Otherwise we get
-- case (\x -> e) of ...!
| otherwise = FloatCase bndr rhs (exprOkForSpeculation rhs)
in
returnUs (addFloat floats float, evald_bndr)
| otherwise = FloatCase bndr rhs (exprOkForSpeculation rhs)
in
returnUs (addFloat floats float, evald_bndr)
| otherwise
= floatRhs NotTopLevel NonRecursive bndr (floats, rhs) `thenUs` \ (floats', rhs') ->
returnUs (addFloat floats' (FloatLet (NonRec bndr rhs')),
| otherwise
= floatRhs NotTopLevel NonRecursive bndr (floats, rhs) `thenUs` \ (floats', rhs') ->
returnUs (addFloat floats' (FloatLet (NonRec bndr rhs')),