[commit: ghc] : Only bind exported things into the big tuple (6f6463a)

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

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/6f6463a2c34435ab8a5630a19381555bade10c9e

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

commit 6f6463a2c34435ab8a5630a19381555bade10c9e
Author: Max Bolingbroke <[email protected]>
Date:   Mon Jun 27 14:54:53 2011 +0100

    Only bind exported things into the big tuple

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

 compiler/supercompile/Supercompile.hs |   10 +++++++---
 1 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/supercompile/Supercompile.hs b/compiler/supercompile/Supercompile.hs
index a4fa494..d40b412 100644
--- a/compiler/supercompile/Supercompile.hs
+++ b/compiler/supercompile/Supercompile.hs
@@ -12,7 +12,7 @@ import DataCon    (dataConWorkId, dataConAllTyVars, dataConRepArgTys)
 import VarSet
 import Name       (localiseName)
 import Var        (Var, isTyVar, varName, setVarName)
-import Id         (mkSysLocal, mkSysLocalM, realIdUnfolding, isPrimOpId_maybe, isDataConWorkId_maybe, setIdNotExported)
+import Id         (mkSysLocal, mkSysLocalM, realIdUnfolding, isPrimOpId_maybe, isDataConWorkId_maybe, setIdNotExported, isExportedId)
 import MkId       (mkPrimOpId)
 import MkCore     (mkBigCoreVarTup, mkTupleSelector, mkWildValBinder)
 import FastString (mkFastString, fsLit)
@@ -144,7 +144,7 @@ termToCoreExpr = term
 coreBindsToCoreTerm :: [CoreBind] -> (CoreExpr, CoreExpr -> [CoreBind])
 coreBindsToCoreTerm binds
   = (mkLets internal_binds (mkBigCoreVarTup internal_xs),
-     \e -> let wild_id = mkWildValBinder (exprType e) in [NonRec x (mkTupleSelector internal_xs internal_x wild_id e) | (x, internal_x) <- xs `zip` internal_xs])
+     \e -> let wild_id = mkWildValBinder (exprType e) in [NonRec x (mkTupleSelector internal_xs internal_x wild_id e) | (x, internal_x) <- xs_internal_xs])
   where
     -- This is a sweet hack. Most of the top-level binders will be External names. It is a Bad Idea to locally-bind
     -- an External name, because several Externals with the same name but different uniques will generate clashing
@@ -154,11 +154,15 @@ coreBindsToCoreTerm binds
     -- Note that we leave the *use sites* totally intact: we rely on the fact that a) variables are compared only by
     -- unique and b) the internality of these names will be carried down on the next simplifier run, so this works.
     -- The ice is thin, though!
+    --
+    -- As an added twist, we only need to put *exported* Ids into the tuple we construct/deconstruct as part of this
+    -- transformation. This allows the supercompiler to determine that more things are used linearly.
     xs = bindersOfBinds binds
     internal_binds = [case bind of NonRec x e -> NonRec (localiseVar x) e
                                    Rec xes    -> Rec (map (first localiseVar) xes)
                      | bind <- binds]
-    internal_xs = bindersOfBinds internal_binds
+    xs_internal_xs = filter (\(x, _) -> isExportedId x) (xs `zip` bindersOfBinds internal_binds)
+    internal_xs = map snd xs_internal_xs
     localiseVar x = setIdNotExported (x `setVarName` localiseName (varName x))
      -- If we don't mark these Ids as not exported then we get lots of residual top-level bindings of the form x = y