[commit: ghc] supercompiler: Only abstract over RealWorld# conditionally (89be615)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/89be6152f0f9035ec98f62ec00c70159bc323091

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

commit 89be6152f0f9035ec98f62ec00c70159bc323091
Author: Max Bolingbroke <[email protected]>
Date:   Thu Mar 1 13:55:13 2012 +0000

    Only abstract over RealWorld# conditionally

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

 .../supercompile/Supercompile/Drive/Process.hs     |   15 +++++++++------
 1 files changed, 9 insertions(+), 6 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Process.hs b/compiler/supercompile/Supercompile/Drive/Process.hs
index 9811617..f7c7668 100644
--- a/compiler/supercompile/Supercompile/Drive/Process.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process.hs
@@ -793,16 +793,19 @@ applyAbsVars x xs = snd (foldl go (unitVarSet x, var x) xs)
                -- NB: make sure we zap the "fragile" info because the FVs of the unfolding are
                -- not necessarily in scope.
 
--- NB: we abstract over RealWorld# as well (cf WwLib). Two reasons:
+-- NB: if there are no arguments, we abstract over RealWorld# as well (cf WwLib). Two reasons:
 --  1. If the h-function is unlifted, this delays its evaluation (so its effects, if any, do not happen too early).
 --     This is also necessary since h-functions will be bound in one letrec after supercompilation is complete.
---  2. This expresses to GHC that we don't necessarily want the work in h-functions to be shared.
+--  2. In other cases, this expresses to GHC that we don't necessarily want the work in h-functions to be shared.
 stateAbsVars :: Maybe FreeVars -> State -> ([AbsVar], Type)
-stateAbsVars mb_lvs state = (abstracted, realWorldStatePrimTy `mkFunTy` (vs_list `mkPiTypes` state_ty))
+stateAbsVars mb_lvs state
+  | any (isId . absVarVar) abstracted
+  = (abstracted,                                                       ty)
+  | otherwise
+  = (AbsVar { absVarDead = True, absVarVar = voidArgId } : abstracted, realWorldStatePrimTy `mkFunTy` ty)
   where vs_list = sortQuantVars (varSetElems (stateLambdaBounders state))
-        state_ty = stateType state
-        abstracted = AbsVar { absVarDead = True, absVarVar = voidArgId } :
-                     map (\v -> AbsVar { absVarDead = maybe False (not . (v `elemVarSet`)) mb_lvs, absVarVar = v }) vs_list
+        ty = vs_list `mkPiTypes` stateType state
+        abstracted = map (\v -> AbsVar { absVarDead = maybe False (not . (v `elemVarSet`)) mb_lvs, absVarVar = v }) vs_list
 
 
 -- | Free variables that are allowed to be in the output term even though they weren't in the input (in addition to h-function names)