Store a SrcSpan instead of a SrcLoc inside a Name

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 33030bc..bc0b3bc 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -136,8 +136,7 @@ builtin_commands = [
   ("type",     keepGoing typeOfExpr,           False, completeIdentifier),
   ("trace",     keepGoing traceCmd,             False, completeIdentifier), 
   ("undef",     keepGoing undefineMacro,       False, completeMacro),
-  ("unset",    keepGoing unsetOptions,         True,  completeSetOptions),
-  ("where",    keepGoing whereCmd,             True,  completeNone)
+  ("unset",    keepGoing unsetOptions,         True,  completeSetOptions)
   ]
 
 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
@@ -553,53 +552,34 @@ runStmt stmt step
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt step
       afterRunStmt result
-      return (isRunResultOk result)
 
 
-afterRunStmt :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+afterRunStmt :: GHC.RunResult -> GHCi Bool
+                                 -- False <=> the statement failed to compile
+afterRunStmt (GHC.RunException e) = throw e
 afterRunStmt run_result = do
-  mb_result <- switchOnRunResult run_result
-  -- possibly print the type and revert CAFs after evaluating an expression
-  show_types <- isOptionSet ShowType
   session <- getSession
-  case mb_result of
-    Nothing    -> return ()      
-    Just (is_break,names) -> 
-            when (is_break || show_types) $
-                  mapM_ (showTypeOfName session) names
-  
+  case run_result of
+     GHC.RunOk names -> do
+        show_types <- isOptionSet ShowType
+        when show_types $ mapM_ (showTypeOfName session) names
+     GHC.RunBreak _ names _ -> do
+        resumes <- io $ GHC.getResumeContext session
+        printForUser $ ptext SLIT("Stopped at") <+> 
+                       ppr (GHC.resumeSpan (head resumes))
+        mapM_ (showTypeOfName session) names
+        -- run the command set with ":set stop <cmd>"
+        st <- getGHCiState
+        runCommand (stop st)
+        return ()
+     _ -> return ()
+
   flushInterpBuffers
   io installSignalHandlers
   b <- isOptionSet RevertCAFs
   io (when b revertCAFs)
 
-  return mb_result
-
-
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
-switchOnRunResult GHC.RunFailed = return Nothing
-switchOnRunResult (GHC.RunException e) = throw e
-switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info) = do
-   session <- getSession
-   Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
-   let modBreaks  = GHC.modInfoModBreaks mod_info
-   let ticks      = GHC.modBreaks_locs modBreaks
-
-   -- display information about the breakpoint
-   let location = ticks ! GHC.breakInfo_number info
-   printForUser $ ptext SLIT("Stopped at") <+> ppr location
-
-   -- run the command set with ":set stop <cmd>"
-   st <- getGHCiState
-   runCommand (stop st)
-
-   return (Just (True,names))
-
-
-isRunResultOk :: GHC.RunResult -> Bool
-isRunResultOk (GHC.RunOk _) = True
-isRunResultOk _             = False
+  return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
 
 showTypeOfName :: Session -> Name -> GHCi ()
@@ -1576,7 +1556,7 @@ breakSwitch session args@(arg1:rest)
               io $ putStrLn "Perhaps no modules are loaded for debugging?"
    | otherwise = do -- try parsing it as an identifier
         wantNameFromInterpretedModule noCanDo arg1 $ \name -> do
-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule name) $ 
                          findBreakByCoord (Just (GHC.srcLocFile loc))
@@ -1698,7 +1678,7 @@ list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do
         listModuleLine mod (read arg2)
 list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
-        let loc = GHC.nameSrcLoc name
+        let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         if GHC.isGoodSrcLoc loc
                then do
                   tickArray <- getTickArray (GHC.nameModule name)