Cleanup StgCmm pass

This cleanup includes:
  * removing dead code. This includes forkStatics function,
    which was in fact one big noop, and global bindings in
    CgInfoDownwards,
  * converting functions that used FCode monad only to
    access DynFlags into functions that take DynFlags
    as a parameter and don't work in a monad,
  * addBindC function is now smarter. It extracts Id from
    CgIdInfo passed to it in the same way addBindsC does.
    Previously this was done at every call site, which was
    redundant.

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)
 
 
 ------------------------------------------------------------------------