--- mkLocalNonRec is used only for *nested*, *non-recursive* bindings
-mkLocalNonRec :: Id -> RhsDemand -- Lhs: id with demand
- -> Floats -> CoreExpr -- Rhs: let binds in body
- -> UniqSM (Floats, Id) -- The new Id may have an evaldUnfolding,
- -- to record that it's been evaluated
-
-mkLocalNonRec bndr dem floats rhs
- | isUnLiftedType (idType bndr)
- -- If this is an unlifted binding, we always make a case for it.
- = ASSERT( not (isUnboxedTupleType (idType bndr)) )
- let
- float = FloatCase bndr rhs (exprOkForSpeculation rhs)
- in
- return (addFloat floats float, evald_bndr)
-
- | isStrict dem
- -- It's a strict let so we definitely float all the bindings
- = let -- Don't make a case for a value binding,
- -- even if it's strict. Otherwise we get
- -- case (\x -> e) of ...!
- float | exprIsHNF rhs = FloatLet (NonRec bndr rhs)
- | otherwise = FloatCase bndr rhs (exprOkForSpeculation rhs)
- in
- return (addFloat floats float, evald_bndr)
-
- | otherwise
- = do (floats', rhs') <- floatRhs NotTopLevel NonRecursive bndr (floats, rhs)
- return (addFloat floats' (FloatLet (NonRec bndr rhs')),
- if exprIsHNF rhs' then evald_bndr else bndr)
-
- where
- evald_bndr = bndr `setIdUnfolding` evaldUnfolding
- -- Record if the binder is evaluated
-
-
-mkBinds :: Floats -> CoreExpr -> UniqSM CoreExpr
-mkBinds (Floats _ binds) body
- | isNilOL binds = return body
- | otherwise = do body' <- deLam body
- -- Lambdas are not allowed as the body of a 'let'
- return (foldrOL mk_bind body' binds)
- where
- mk_bind (FloatCase bndr rhs _) body = Case rhs bndr (exprType body) [(DEFAULT, [], body)]
- mk_bind (FloatLet bind) body = Let bind body
-
-
--- ---------------------------------------------------------------------------
--- Eliminate Lam as a non-rhs (STG doesn't have such a thing)
--- We arrange that they only show up as the RHS of a let(rec)
--- ---------------------------------------------------------------------------
-
-deLam :: CoreExpr -> UniqSM CoreExpr
--- Takes an expression that may be a lambda,
--- and returns one that definitely isn't:
--- (\x.e) ==> let f = \x.e in f
-deLam expr = do
- (floats, expr) <- deLamFloat expr
- mkBinds floats expr
-
-
-deLamFloat :: CoreExpr -> UniqSM (Floats, CoreExpr)
--- Remove top level lambdas by let-bindinig
-
-deLamFloat (Note n expr) = do
- -- You can get things like
- -- case e of { p -> coerce t (\s -> ...) }
- (floats, expr') <- deLamFloat expr
- return (floats, Note n expr')
-
-deLamFloat (Cast e co) = do
- (floats, e') <- deLamFloat e
- return (floats, Cast e' co)