From ab13303c49618c6224d7c5b5397ac9a98d2e5b6f Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 9 May 2007 10:37:12 +0000
Subject: [PATCH] FIX: Linker.getHValue should be linking in any dependencies
 it requires Otherwise :print only works for local
 identifiers, not global ones. In fact it was silently
 failing, so I fixed that too.

---
 compiler/ghci/ByteCodeLink.lhs   |    2 +-
 compiler/ghci/Debugger.hs        |    3 +--
 compiler/ghci/Linker.lhs         |   48 ++++++++++++++++++++++----------------
 compiler/main/InteractiveEval.hs |    8 +++----
 4 files changed, 33 insertions(+), 28 deletions(-)

diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index e8bae70..521c162 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -9,7 +9,7 @@ ByteCodeLink: Bytecode assembler and linker
 module ByteCodeLink ( 
 	HValue, 
 	ClosureEnv, emptyClosureEnv, extendClosureEnv,
-	linkBCO, lookupStaticPtr
+	linkBCO, lookupStaticPtr, lookupName
        ,lookupIE
   ) where
 
diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 33fcf61..138992f 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -63,8 +63,7 @@ pprintClosureCommand session bindThings force str = do
    -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
    go :: Session -> Id -> IO (Maybe TvSubst)
    go cms id = do 
-     mb_term <- obtainTerm cms force id 
-     maybe (return Nothing) `flip` mb_term $ \term_ -> do
+       term_ <- obtainTerm cms force id 
        term      <- tidyTermTyVars cms term_
        term'     <- if not bindThings then return term 
                      else bindSuspensions cms term                         
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 220ac3b..afbd3b5 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -247,12 +247,33 @@ dataConInfoPtrToName x = do
               (top, '.':bot) -> parseModOcc (top : acc) bot
        
 
-getHValue :: Name -> IO (Maybe HValue)
-getHValue name = do
-    pls <- readIORef v_PersistentLinkerState
-    case lookupNameEnv (closure_env pls) name of
-      Just (_,x) -> return$ Just x
-      _          -> return Nothing
+getHValue :: HscEnv -> Name -> IO HValue
+getHValue hsc_env name = do
+   when (isExternalName name) $ do
+        ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
+        when (failed ok) $ throwDyn (ProgramError "")
+   pls <- readIORef v_PersistentLinkerState
+   lookupName (closure_env pls) name
+        
+linkDependencies :: HscEnv -> SrcSpan -> [Module] -> IO SuccessFlag
+linkDependencies hsc_env span needed_mods = do
+   let hpt = hsc_HPT hsc_env
+       dflags = hsc_dflags hsc_env
+	-- The interpreter and dynamic linker can only handle object code built
+	-- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
+	-- So here we check the build tag: if we're building a non-standard way
+	-- then we need to find & link object files built the "normal" way.
+   maybe_normal_osuf <- checkNonStdWay dflags span
+
+	-- Find what packages and linkables are required
+   eps <- readIORef (hsc_EPS hsc_env)
+   (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps) 
+				maybe_normal_osuf span needed_mods
+
+	-- Link the packages and modules required
+   linkPackages dflags pkgs
+   linkModules dflags lnks
+
 
 withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
 withExtendedLinkEnv new_env action
@@ -449,20 +470,8 @@ linkExpr hsc_env span root_ul_bco
      let dflags = hsc_dflags hsc_env
    ; initDynLinker dflags
 
-	-- The interpreter and dynamic linker can only handle object code built
-	-- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
-	-- So here we check the build tag: if we're building a non-standard way
-	-- then we need to find & link object files built the "normal" way.
-   ; maybe_normal_osuf <- checkNonStdWay dflags span
-
-	-- Find what packages and linkables are required
-   ; eps <- readIORef (hsc_EPS hsc_env)
-   ; (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps) 
-				maybe_normal_osuf span needed_mods
-
 	-- Link the packages and modules required
-   ; linkPackages dflags pkgs
-   ; ok <- linkModules dflags lnks
+   ; ok <- linkDependencies hsc_env span needed_mods
    ; if failed ok then
 	throwDyn (ProgramError "")
      else do {
@@ -477,7 +486,6 @@ linkExpr hsc_env span root_ul_bco
    ; return root_hval
    }}
    where
-     hpt    = hsc_HPT hsc_env
      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 
      needed_mods :: [Module]
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index b53e015..26d251d 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -768,11 +768,9 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
 
-obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
+obtainTerm :: Session -> Bool -> Id -> IO Term
 obtainTerm sess force id = withSession sess $ \hsc_env -> do
-              mb_v <- Linker.getHValue (varName id) 
-              case mb_v of
-                Just v  -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
-                Nothing -> return Nothing
+              hv <- Linker.getHValue hsc_env (varName id) 
+              cvObtainTerm hsc_env force (Just$ idType id) hv
 
 #endif /* GHCI */
-- 
1.7.10.4