[commit: ghc] cardinality: Generate static code for nested no-free-variable thunks (ebdc6e5)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : cardinality

http://hackage.haskell.org/trac/ghc/changeset/ebdc6e5637643820292568d27fb93b3bc96703c3

>---------------------------------------------------------------

commit ebdc6e5637643820292568d27fb93b3bc96703c3
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Mar 14 13:38:09 2013 +0000

    Generate static code for nested no-free-variable thunks
    
    You might wonder why such things can happen, or (if they do)
    why we should generate static code, but see
    Note [Nested constant closures] in StgCmmBind.
    
    I'm not quite sure why this problem has only just popped up now.

>---------------------------------------------------------------

 compiler/codeGen/StgCmmBind.hs | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index c98bebf..d023bcd 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -130,8 +130,7 @@ cgBind (StgNonRec name rhs)
   = do  { (info, fcode) <- cgRhs name rhs
         ; addBindC (cg_id info) info
         ; init <- fcode
-        ; emit init
-        }
+        ; emit init }
         -- init cannot be used in body, so slightly better to sink it eagerly
 
 cgBind (StgRec pairs)
@@ -208,9 +207,34 @@ cgRhs name (StgRhsCon cc con args)
   = buildDynCon name cc con args
 
 cgRhs name (StgRhsClosure cc bi fvs upd_flag _srt args body)
+  | null fvs   -- See Note [Nested constant closures]
+  = do { (info, fcode) <- cgTopRhsClosure Recursive name cc bi upd_flag args body 
+       ; return (info, fcode >> return mkNop) }
+  | otherwise 
   = do dflags <- getDynFlags
        mkRhsClosure dflags name cc bi (nonVoidIds fvs) upd_flag args body
 
+{- Note [Nested constant closures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have
+  f x = let funny = not True 
+        in ...
+then 'funny' is a nested closure (compiled with cgRhs) that has no free vars.
+This does not happen often, because let-floating takes them all to top 
+level; but it CAN happen.  (Reason: let-floating may make a function f smaller
+so it can be inlined, so now (f True) may generate a local no-fv closure.
+This actually happened during bootsrapping GHC itself, with f=mkRdrFunBind 
+in TcGenDeriv.)
+
+If we have one of these things, AND they allocate, the heap check will
+refer to the static funny_closure; but there isn't one! (Why does the
+heap check refer to the static closure? Becuase nodeMustPointToIt is
+False, which is fair enough.)
+
+Simple solution: compile the RHS as if it was top level.  Then
+everything works.  A minor benefit is eliminating the allocation code
+too.  -}
+
 ------------------------------------------------------------------------
 --              Non-constructor right hand sides
 ------------------------------------------------------------------------