diff options
Diffstat (limited to 'compiler/codeGen/StgCmmBind.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 38 |
1 files changed, 19 insertions, 19 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 7cac6ad263..ba1e0597ba 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -58,22 +58,21 @@ import Control.Monad -- For closures bound at top level, allocate in static space. -- They should have no free variables. -cgTopRhsClosure :: RecFlag -- member of a recursive group? +cgTopRhsClosure :: DynFlags + -> RecFlag -- member of a recursive group? -> Id -> CostCentreStack -- Optional cost centre annotation -> StgBinderInfo -> UpdateFlag -> [Id] -- Args -> StgExpr - -> FCode (CgIdInfo, FCode ()) - -cgTopRhsClosure rec id ccs _ upd_flag args body - = do { dflags <- getDynFlags - ; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args - ; let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id) - cg_id_info = litIdInfo dflags id lf_info (CmmLabel closure_label) - ; return (cg_id_info, gen_code dflags lf_info closure_label) - } + -> (CgIdInfo, FCode ()) + +cgTopRhsClosure dflags rec id ccs _ upd_flag args body = + let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id) + cg_id_info = litIdInfo dflags id lf_info (CmmLabel closure_label) + lf_info = mkClosureLFInfo dflags id TopLevel [] upd_flag args + in (cg_id_info, gen_code dflags lf_info closure_label) where -- special case for a indirection (f = g). We create an IND_STATIC -- closure pointing directly to the indirectee. This is exactly @@ -128,7 +127,7 @@ cgTopRhsClosure rec id ccs _ upd_flag args body cgBind :: StgBinding -> FCode () cgBind (StgNonRec name rhs) = do { (info, fcode) <- cgRhs name rhs - ; addBindC (cg_id info) info + ; addBindC info ; init <- fcode ; emit init } -- init cannot be used in body, so slightly better to sink it eagerly @@ -316,8 +315,8 @@ mkRhsClosure dflags bndr _cc _bi arity = length fvs ---------- Default case ------------------ -mkRhsClosure _ bndr cc _ fvs upd_flag args body - = do { lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args +mkRhsClosure dflags bndr cc _ fvs upd_flag args body + = do { let lf_info = mkClosureLFInfo dflags bndr NotTopLevel fvs upd_flag args ; (id_info, reg) <- rhsIdInfo bndr lf_info ; return (id_info, gen_code lf_info reg) } where @@ -410,17 +409,18 @@ cgRhsStdThunk bndr lf_info payload ; return (mkRhsInit dflags reg lf_info hp_plus_n) } -mkClosureLFInfo :: Id -- The binder +mkClosureLFInfo :: DynFlags + -> Id -- The binder -> TopLevelFlag -- True of top level -> [NonVoid Id] -- Free vars -> UpdateFlag -- Update flag -> [Id] -- Args - -> FCode LambdaFormInfo -mkClosureLFInfo bndr top fvs upd_flag args - | null args = return (mkLFThunk (idType bndr) top (map unsafe_stripNV fvs) upd_flag) + -> LambdaFormInfo +mkClosureLFInfo dflags bndr top fvs upd_flag args + | null args = + mkLFThunk (idType bndr) top (map unsafe_stripNV fvs) upd_flag | otherwise = - do { arg_descr <- mkArgDescr (idName bndr) args - ; return (mkLFReEntrant top (map unsafe_stripNV fvs) args arg_descr) } + mkLFReEntrant top (map unsafe_stripNV fvs) args (mkArgDescr dflags args) ------------------------------------------------------------------------ |