Generate one fewer temps per heap allocation

This saves compile time and can make a big difference in some
pathological cases (T4801)

compiler/codeGen/StgCmmBind.hs

@@ -104,7 +104,8 @@ cgBind :: StgBinding -> FCode ()
 cgBind (StgNonRec name rhs)
   = do	{ ((info, init), body) <- getCodeR $ cgRhs name rhs
         ; addBindC (cg_id info) info
-        ; emit (init <*> body) }
+        ; emit (body <*> init) }
+        -- init cannot be used in body, so slightly better to sink it eagerly
 
 cgBind (StgRec pairs)
   = do  { ((new_binds, inits), body) <- getCodeR $ fixC (\ new_binds_inits ->
@@ -311,11 +312,11 @@ mkRhsClosure _ bndr cc _ fvs upd_flag args body
         ; emit (mkComment $ mkFastString "calling allocDynClosure")
         ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
         ; let info_tbl = mkCmmInfo closure_info
-        ; (tmp, init) <- allocDynClosure info_tbl lf_info use_cc blame_cc
+        ; hp_plus_n <- allocDynClosure info_tbl lf_info use_cc blame_cc
                                          (map toVarArg fv_details)
 
 	-- RETURN
-	; regIdInfo bndr lf_info tmp init }
+        ; regIdInfo bndr lf_info hp_plus_n }
 
 -- Use with care; if used inappropriately, it could break invariants.
 stripNV :: NonVoid a -> a
@@ -349,11 +350,11 @@ cgStdThunk bndr _cc _bndr_info _body lf_info payload
 
 	-- BUILD THE OBJECT
   ; let info_tbl = mkCmmInfo closure_info
-  ; (tmp, init) <- allocDynClosure info_tbl lf_info
+  ; hp_plus_n <- allocDynClosure info_tbl lf_info
                                    use_cc blame_cc payload_w_offsets
 
 	-- RETURN
-  ; regIdInfo bndr lf_info tmp init }
+  ; regIdInfo bndr lf_info hp_plus_n }
 
 mkClosureLFInfo :: Id		-- The binder
 		-> TopLevelFlag	-- True of top level

compiler/codeGen/StgCmmCon.hs

@@ -210,9 +210,9 @@ buildDynCon' dflags _ binder ccs con args
                 -- No void args in args_w_offsets
               nonptr_wds = tot_wds - ptr_wds
               info_tbl = mkDataConInfoTable dflags con False ptr_wds nonptr_wds
-        ; (tmp, init) <- allocDynClosure info_tbl lf_info
+        ; hp_plus_n <- allocDynClosure info_tbl lf_info
                                          use_cc blame_cc args_w_offsets
-        ; regIdInfo binder lf_info tmp init }
+        ; regIdInfo binder lf_info hp_plus_n }
   where
     lf_info = mkConLFInfo con
 

compiler/codeGen/StgCmmEnv.hs

@@ -44,7 +44,7 @@ import CLabel
 import BlockId
 import CmmExpr
 import CmmUtils
-import MkGraph (CmmAGraph, mkAssign, (<*>))
+import MkGraph (CmmAGraph, mkAssign)
 import FastString
 import Id
 import VarEnv
@@ -103,13 +103,12 @@ lneIdInfo id regs
 -- register, and store a plain register in the CgIdInfo.  We allocate
 -- a new register in order to keep single-assignment and help out the
 -- inliner. -- EZY
-regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CmmAGraph -> FCode (CgIdInfo, CmmAGraph)
-regIdInfo id lf_info reg init 
-  = do { reg' <- newTemp (localRegType reg)
-       ; let init' = init <*> mkAssign (CmmLocal reg') 
-                                       (addDynTag (CmmReg (CmmLocal reg)) 
-                                                  (lfDynTag lf_info))
-       ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init') }
+regIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> FCode (CgIdInfo, CmmAGraph)
+regIdInfo id lf_info expr
+  = do { reg <- newTemp (cmmExprType expr)
+       ; let init = mkAssign (CmmLocal reg)
+                             (addDynTag expr (lfDynTag lf_info))
+       ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), init) }
 
 idInfoToAmode :: CgIdInfo -> CmmExpr
 -- Returns a CmmExpr for the *tagged* pointer

compiler/codeGen/StgCmmHeap.hs

@@ -15,7 +15,7 @@ module StgCmmHeap (
         mkVirtHeapOffsets, mkVirtConstrOffsets,
         mkStaticClosureFields, mkStaticClosure,
 
-        allocDynClosure, allocDynClosureReg, allocDynClosureCmm,
+        allocDynClosure, allocDynClosureCmm,
         emitSetDynHdr
     ) where
 
@@ -63,12 +63,7 @@ allocDynClosure
         -> [(NonVoid StgArg, VirtualHpOffset)]  -- Offsets from start of object
                                                 -- ie Info ptr has offset zero.
                                                 -- No void args in here
-        -> FCode (LocalReg, CmmAGraph)
-
-allocDynClosureReg
-        :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
-        -> [(CmmExpr, VirtualHpOffset)]
-        -> FCode (LocalReg, CmmAGraph)
+        -> FCode CmmExpr -- returns Hp+n
 
 allocDynClosureCmm
         :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
@@ -81,32 +76,25 @@ allocDynClosureCmm
 -- returned LocalReg, which should point to the closure after executing
 -- the graph.
 
--- Note [Return a LocalReg]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- allocDynClosure returns a LocalReg, not a (Hp+8) CmmExpr.
--- Reason:
---      ...allocate object...
---      obj = Hp + 8
---      y = f(z)
---      ...here obj is still valid,
---         but Hp+8 means something quite different...
+-- allocDynClosure returns an (Hp+8) CmmExpr, and hence the result is
+-- only valid until Hp is changed.  The caller should assign the
+-- result to a LocalReg if it is required to remain live.
+--
+-- The reason we don't assign it to a LocalReg here is that the caller
+-- is often about to call regIdInfo, which immediately assigns the
+-- result of allocDynClosure to a new temp in order to add the tag.
+-- So by not generating a LocalReg here we avoid a common source of
+-- new temporaries and save some compile time.  This can be quite
+-- significant - see test T4801.
 
 
 allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets
   = do  { let (args, offsets) = unzip args_w_offsets
         ; cmm_args <- mapM getArgAmode args     -- No void args
-        ; allocDynClosureReg info_tbl lf_info
+        ; allocDynClosureCmm info_tbl lf_info
                              use_cc _blame_cc (zip cmm_args offsets)
         }
 
-allocDynClosureReg  info_tbl lf_info use_cc _blame_cc amodes_w_offsets
-  = do  { hp_rel <- allocDynClosureCmm info_tbl lf_info
-                                       use_cc _blame_cc amodes_w_offsets
-
-        -- Note [Return a LocalReg]
-        ; getCodeR $ assignTemp hp_rel
-        }
-
 allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
   = do  { virt_hp <- getVirtHp