X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmBind.hs;h=379c4c42b4e734b50d0240e627d88ded72ce3a17;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hp=5decdebd7e1ed01e31e32a2ab198ad2dcff6d571;hpb=5dd61c6680eb9c2091048cacbfa53ab9e55ddcb6;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 5decdeb..379c4c4 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -36,7 +36,7 @@ import CLabel
 import StgSyn
 import CostCentre	
 import Id
-import Monad (foldM, liftM)
+import Control.Monad
 import Name
 import Module
 import ListSetOps
@@ -47,8 +47,6 @@ import Outputable
 import FastString
 import Maybes
 
-import Data.List
-
 ------------------------------------------------------------------------
 --		Top-level bindings
 ------------------------------------------------------------------------
@@ -403,7 +401,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                 ; granYield arg_regs node_points
 
                         -- Main payload
-                ; entryHeapCheck node arity arg_regs $ do
+                ; entryHeapCheck (if node_points then Just node else Nothing) arity arg_regs $ do
                 { enterCostCentre cl_info cc body
                 ; fv_bindings <- mapM bind_fv fv_details
                 -- Load free vars out of closure *after*
@@ -459,7 +457,7 @@ thunkCode cl_info fv_details cc node arity body
 	; granThunk node_points
 
         -- Heap overflow check
-	; entryHeapCheck node arity [] $ do
+	; entryHeapCheck (if node_points then Just node else Nothing) arity [] $ do
       	{	-- Overwrite with black hole if necessary
 		-- but *after* the heap-overflow check
 	  dflags <- getDynFlags