+coreToStgArgs (arg : args) -- Non-type argument
+ = coreToStgArgs args `thenLne` \ (stg_args, args_fvs) ->
+ coreToStgExpr arg `thenLne` \ (arg', arg_fvs, escs) ->
+ let
+ fvs = args_fvs `unionFVInfo` arg_fvs
+ stg_arg = case arg' of
+ StgApp v [] -> StgVarArg v
+ StgConApp con [] -> StgVarArg (dataConWrapId con)
+ StgLit lit -> StgLitArg lit
+ _ -> pprPanic "coreToStgArgs" (ppr arg)
+ in
+ returnLne (stg_arg : stg_args, fvs)
+
+
+-- ---------------------------------------------------------------------------
+-- The magic for lets:
+-- ---------------------------------------------------------------------------
+
+coreToStgLet
+ :: Bool -- True <=> yes, we are let-no-escaping this let
+ -> CoreBind -- bindings
+ -> CoreExpr -- body
+ -> LneM (StgExpr, -- new let
+ FreeVarsInfo, -- variables free in the whole let
+ EscVarsSet, -- variables that escape from the whole let
+ Bool) -- True <=> none of the binders in the bindings
+ -- is among the escaping vars
+
+coreToStgLet let_no_escape bind body
+ = fixLne (\ ~(_, _, _, rec_bind_lvs, _, rec_body_fvs, _, _) ->
+
+ -- Do the bindings, setting live_in_cont to empty if
+ -- we ain't in a let-no-escape world
+ getVarsLiveInCont `thenLne` \ live_in_cont ->
+ setVarsLiveInCont
+ (if let_no_escape then live_in_cont else emptyVarSet)
+ (vars_bind rec_bind_lvs rec_body_fvs bind)
+ `thenLne` \ (bind2, bind_fvs, bind_escs, env_ext) ->
+
+ -- The live variables of this binding are the ones which are live
+ -- by virtue of being accessible via the free vars of the binding (lvs_from_fvs)
+ -- together with the live_in_cont ones
+ lookupLiveVarsForSet (binders `minusFVBinders` bind_fvs)
+ `thenLne` \ lvs_from_fvs ->
+ let
+ bind_lvs = lvs_from_fvs `unionVarSet` live_in_cont
+ in
+
+ -- bind_fvs and bind_escs still include the binders of the let(rec)
+ -- but bind_lvs does not
+
+ -- Do the body
+ extendVarEnvLne env_ext (
+ coreToStgExpr body `thenLne` \ (body2, body_fvs, body_escs) ->
+ lookupLiveVarsForSet body_fvs `thenLne` \ body_lvs ->
+
+ returnLne (bind2, bind_fvs, bind_escs, bind_lvs,
+ body2, body_fvs, body_escs, body_lvs)
+
+ )) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs,
+ body2, body_fvs, body_escs, body_lvs) ->
+
+
+ -- Compute the new let-expression
+ let
+ new_let | let_no_escape = StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
+ | otherwise = StgLet bind2 body2
+
+ free_in_whole_let
+ = binders `minusFVBinders` (bind_fvs `unionFVInfo` body_fvs)
+
+ live_in_whole_let
+ = bind_lvs `unionVarSet` (body_lvs `minusVarSet` set_of_binders)
+
+ real_bind_escs = if let_no_escape then
+ bind_escs
+ else
+ getFVSet bind_fvs
+ -- Everything escapes which is free in the bindings
+
+ let_escs = (real_bind_escs `unionVarSet` body_escs) `minusVarSet` set_of_binders
+
+ all_escs = bind_escs `unionVarSet` body_escs -- Still includes binders of
+ -- this let(rec)
+
+ no_binder_escapes = isEmptyVarSet (set_of_binders `intersectVarSet` all_escs)
+
+#ifdef DEBUG
+ -- Debugging code as requested by Andrew Kennedy
+ checked_no_binder_escapes
+ | not no_binder_escapes && any is_join_var binders
+ = pprTrace "Interesting! A join var that isn't let-no-escaped" (ppr binders)
+ False
+ | otherwise = no_binder_escapes
+#else
+ checked_no_binder_escapes = no_binder_escapes
+#endif
+
+ -- Mustn't depend on the passed-in let_no_escape flag, since
+ -- no_binder_escapes is used by the caller to derive the flag!