:step does not delete the :history anymore, and now it logs like :trace

[ghc-hetmet.git] / compiler / main / InteractiveEval.hs

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 3de25ce..1859582 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -358,7 +358,7 @@ resume (Session ref) step
         when (isStep step) $ setStepFlag
         case r of 
           Resume expr tid breakMVar statusMVar bindings 
-              final_ids apStack info _ _ _ -> do
+              final_ids apStack info _ hist _ -> do
                 withBreakAction (isStep step) (hsc_dflags hsc_env) 
                                         breakMVar statusMVar $ do
                 status <- withInterruptsSentTo
@@ -366,14 +366,18 @@ resume (Session ref) step
                                       -- this awakens the stopped thread...
                                  return tid)
                              (takeMVar statusMVar)
-                                      -- and wait for the result
+                                      -- and wait for the result 
+                let hist' = case info of 
+                              Nothing -> fromListBL 50 hist
+                              Just i -> History apStack i `consBL` 
+                                                     fromListBL 50 hist
                 case step of
                   RunAndLogSteps -> 
                         traceRunStatus expr ref bindings final_ids
-                                       breakMVar statusMVar status emptyHistory
+                                       breakMVar statusMVar status hist'
                   _other ->
                         handleRunStatus expr ref bindings final_ids
-                                        breakMVar statusMVar status emptyHistory
+                                        breakMVar statusMVar status hist'
 
 
 back :: Session -> IO ([Name], Int, SrcSpan)
@@ -632,6 +636,8 @@ consBL a (BL len bound left right)
 
 toListBL (BL _ _ left right) = left ++ reverse right
 
+fromListBL bound l = BL (length l) bound l []
+
 -- lenBL (BL len _ _ _) = len
 
 -- -----------------------------------------------------------------------------
@@ -711,8 +717,29 @@ moduleIsInterpreted s modl = withSession s $ \h ->
                 _not_a_home_module -> return False
 
 -- | Looks up an identifier in the current interactive context (for :info)
+-- Filter the instances by the ones whose tycons (or clases resp) 
+-- are in scope (qualified or otherwise).  Otherwise we list a whole lot too many!
+-- The exact choice of which ones to show, and which to hide, is a judgement call.
+--     (see Trac #1581)
 getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
-getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
+getInfo s name 
+  = withSession s $ \hsc_env -> 
+    do { mb_stuff <- tcRnGetInfo hsc_env name
+       ; case mb_stuff of
+           Nothing -> return Nothing
+           Just (thing, fixity, ispecs) -> do
+       { let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)
+       ; return (Just (thing, fixity, filter (plausible rdr_env) ispecs)) } }
+  where
+    plausible rdr_env ispec    -- Dfun involving only names that are in ic_rn_glb_env
+       = all ok $ nameSetToList $ tyClsNamesOfType $ idType $ instanceDFunId ispec
+       where   -- A name is ok if it's in the rdr_env, 
+               -- whether qualified or not
+         ok n | n == name         = True       -- The one we looked for in the first place!
+              | isBuiltInSyntax n = True
+              | isExternalName n  = any ((== n) . gre_name)
+                                        (lookupGRE_Name rdr_env n)
+              | otherwise         = True
 
 -- | Returns all names in scope in the current interactive context
 getNamesInScope :: Session -> IO [Name]