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.

diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index e8bae70..521c162 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 */