X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FstgSyn%2FCoreToStg.lhs;h=2059937e0b5ab080b571a7f49dd434d839245533;hb=841e81e28f8cc711f624fdca122219a5bbde2fae;hp=54895aa027de22992fd83443218e4a5bc026ad26;hpb=a76b8e2794e1721793e641408d04c2349cc974a7;p=ghc-hetmet.git

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 54895aa..2059937 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -544,13 +544,17 @@ coreToStgApp _ f args = do
 
                 TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,args')
                 _other           -> StgApp f args'
-
-    return (
-        app,
-        fun_fvs  `unionFVInfo` args_fvs,
-        fun_escs `unionVarSet` (getFVSet args_fvs)
+        fvs = fun_fvs  `unionFVInfo` args_fvs
+        vars = fun_escs `unionVarSet` (getFVSet args_fvs)
                                 -- All the free vars of the args are disqualified
                                 -- from being let-no-escaped.
+
+    -- Forcing these fixes a leak in the code generator, noticed while
+    -- profiling for trac #4367
+    app `seq` fvs `seq` seqVarSet vars `seq` return (
+        app,
+        fvs,
+        vars
      )
 
 
@@ -770,7 +774,7 @@ mkStgRhs rhs_fvs srt binder_info rhs
     assumptions (namely that they will be entered only once).
 
     upd_flag | isPAP env rhs  = ReEntrant
-             | otherwise      = Updatable
+	     | otherwise      = Updatable
   -}
 
 {- ToDo: