From: sewardj <unknown>
Date: Tue, 6 Feb 2001 10:37:23 +0000 (+0000)
Subject: [project @ 2001-02-06 10:37:23 by sewardj]
X-Git-Tag: Approximately_9120_patches~2741
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6ef1f78988f2026f30115138bf8bb52abf70894e;p=ghc-hetmet.git

[project @ 2001-02-06 10:37:23 by sewardj]
When linking a bytecode module, only add top-level (isGlobalName)
bindings into the returned augmented closure env.
---

diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
index e0359d7..554692c 100644
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ b/ghc/compiler/ghci/ByteCodeGen.lhs
@@ -129,15 +129,15 @@ linkIModules gie gce mods
    = do let (bcoss, ies) = unzip mods
             bcos = concat bcoss
             final_gie = foldr plusFM gie ies
-        (final_gce, linked_bcos) <- linkSomeBCOs final_gie gce bcos
+        (final_gce, linked_bcos) <- linkSomeBCOs True final_gie gce bcos
         return (linked_bcos, final_gie, final_gce)
 
 
 linkIExpr :: ItblEnv -> ClosureEnv -> UnlinkedBCOExpr
           -> IO HValue 	  -- IO BCO# really
 linkIExpr ie ce (root_ul_bco, aux_ul_bcos)
-   = do (aux_ce, _) <- linkSomeBCOs ie ce aux_ul_bcos
-        (_, [root_bco]) <- linkSomeBCOs ie aux_ce [root_ul_bco]
+   = do (aux_ce, _) <- linkSomeBCOs False ie ce aux_ul_bcos
+        (_, [root_bco]) <- linkSomeBCOs False ie aux_ce [root_ul_bco]
         return root_bco
 \end{code}
 
diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs
index 8942a4c..22a083e 100644
--- a/ghc/compiler/ghci/ByteCodeLink.lhs
+++ b/ghc/compiler/ghci/ByteCodeLink.lhs
@@ -11,7 +11,7 @@ module ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
 #include "HsVersions.h"
 
 import Outputable
-import Name		( Name, getName, nameModule, toRdrName )
+import Name		( Name, getName, nameModule, toRdrName, isGlobalName )
 import RdrName		( rdrNameOcc, rdrNameModule )
 import OccName		( occNameString )
 import FiniteMap	( FiniteMap, addListToFM, filterFM,
@@ -57,14 +57,23 @@ import PrelIOBase	( IO(..) )
 \begin{code}
 
 -- Link a bunch of BCOs and return them + updated closure env.
-linkSomeBCOs :: ItblEnv -> ClosureEnv -> [UnlinkedBCO]
-                -> IO (ClosureEnv, [HValue])
-linkSomeBCOs ie ce_in ul_bcos
+linkSomeBCOs :: Bool 	-- False <=> add _all_ BCOs to returned closure env
+                        -- True  <=> add only toplevel BCOs to closure env
+             -> ItblEnv 
+             -> ClosureEnv 
+             -> [UnlinkedBCO]
+             -> IO (ClosureEnv, [HValue])
+linkSomeBCOs toplevs_only ie ce_in ul_bcos
    = do let nms = map nameOfUnlinkedBCO ul_bcos
         hvals <- fixIO 
                     ( \ hvs -> let ce_out = addListToFM ce_in (zipLazily nms hvs)
                                in  mapM (linkBCO ie ce_out) ul_bcos )
-        let ce_out = addListToFM ce_in (zip nms hvals)
+
+        let ce_all_additions = zip nms hvals
+            ce_top_additions = filter (isGlobalName.fst) ce_all_additions
+            ce_additions     = if toplevs_only then ce_top_additions 
+                                               else ce_all_additions
+            ce_out = addListToFM ce_in ce_additions
         return (ce_out, hvals)
      where
         -- A lazier zip, in which no demand is propagated to the second