-coreRhsToStg :: StgEnv -> CoreExpr -> RhsDemand -> UniqSM StgRhs
-coreRhsToStg env rhs dem
- = coreExprToStg env rhs dem `thenUs` \ stg_expr ->
- returnUs (exprToRhs dem stg_expr)
-
-exprToRhs :: RhsDemand -> StgExpr -> StgRhs
-exprToRhs dem (StgLet (StgNonRec var1 rhs) (StgApp var2 []))
- | var1 == var2
- = rhs
- -- This curious stuff is to unravel what a lambda turns into
- -- We have to do it this way, rather than spot a lambda in the
- -- incoming rhs. Why? Because trivial bindings might conceal
- -- what the rhs is actually like.
-
-{-
- We reject the following candidates for 'static constructor'dom:
-
- - any dcon that takes a lit-lit as an arg.
- - [Win32 DLLs only]: any dcon that is (or takes as arg)
- that's living in a DLL.
-
- These constraints are necessary to ensure that the code
- generated in the end for the static constructors, which
- live in the data segment, remain valid - i.e., it has to
- be constant. For obvious reasons, that's hard to guarantee
- with lit-lits. The second case of a constructor referring
- to static closures hiding out in some DLL is an artifact
- of the way Win32 DLLs handle global DLL variables. A (data)
- symbol exported from a DLL has to be accessed through a
- level of indirection at the site of use, so whereas
-
- extern StgClosure y_closure;
- extern StgClosure z_closure;
- x = { ..., &y_closure, &z_closure };
-
- is legal when the symbols are in scope at link-time, it is
- not when y_closure is in a DLL. So, any potential static
- closures that refers to stuff that's residing in a DLL
- will be put in an (updateable) thunk instead.
-
- An alternative strategy is to support the generation of
- constructors (ala C++ static class constructors) which will
- then be run at load time to fix up static closures.
--}
-exprToRhs dem (StgCon (DataCon con) args _)
- | not is_dynamic &&
- all (not.is_lit_lit) args = StgRhsCon noCCS con args
- where
- is_dynamic = isDynCon con || any (isDynArg) args
-
- is_lit_lit (StgVarArg _) = False
- is_lit_lit (StgConArg x) =
- case x of
- Literal l -> isLitLitLit l
- _ -> False
-
-exprToRhs dem expr
- = StgRhsClosure noCCS -- No cost centre (ToDo?)
- stgArgOcc -- safe
- noSRT -- figure out later
- bOGUS_FVs
- (if isOnceDem dem then SingleEntry else Updatable)
- -- HA! Paydirt for "dem"
- []
- expr
-
-isDynCon :: DataCon -> Bool
-isDynCon con = isDynName (dataConName con)
-
-isDynArg :: StgArg -> Bool
-isDynArg (StgVarArg v) = isDynName (idName v)
-isDynArg (StgConArg con) =
- case con of
- DataCon dc -> isDynCon dc
- Literal l -> isLitLitLit l
- _ -> False
-
-isDynName :: Name -> Bool
-isDynName nm =
- not (isLocallyDefinedName nm) &&
- isDynamicModule (nameModule nm)