add final newlines

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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 4741a61..9feae0e 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -143,7 +143,7 @@ builtin_commands = [
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
   ("run",      keepGoing runRun,               Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),
   ("reload",   keepGoing reloadModule,         Nothing, completeNone),
   ("run",      keepGoing runRun,               Nothing, completeIdentifier),
   ("set",      keepGoing setCmd,               Just flagWordBreakChars, completeSetOptions),

-  ("show",     keepGoing showCmd,              Nothing, completeNone),
+  ("show",     keepGoing showCmd,              Nothing, completeShowOptions),

   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
   ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
   ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 
   ("sprint",    keepGoing sprintCmd,            Nothing, completeIdentifier),
   ("step",      keepGoing stepCmd,              Nothing, completeIdentifier), 
   ("steplocal", keepGoing stepLocalCmd,         Nothing, completeIdentifier), 

@@ -340,8 +340,6 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do
 
    default_editor <- liftIO $ findEditor
 
 
    default_editor <- liftIO $ findEditor
 

-   cwd <- liftIO $ getCurrentDirectory
-

    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
                    args = [],
    startGHCi (runGHCi srcs maybe_exprs)
         GHCiState{ progname = "<interactive>",
                    args = [],

@@ -357,7 +355,6 @@ interactiveUI srcs maybe_exprs = withTerminalReset $ do
                    last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = [],
                    last_command = Nothing,
                    cmdqueue = [],
                    remembered_ctx = [],

-                   virtual_path   = cwd,

                    ghc_e = isJust maybe_exprs
                  }
 
                    ghc_e = isJust maybe_exprs
                  }
 

@@ -733,23 +730,19 @@ afterRunStmt step_here run_result = do
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
         when show_types $ printTypeOfNames names
      GHC.RunOk names -> do
         show_types <- isOptionSet ShowType
         when show_types $ printTypeOfNames names

-     GHC.RunBreak _ names mb_info 
-         | isNothing  mb_info || 
+     GHC.RunBreak _ names mb_info
+         | isNothing  mb_info ||

            step_here (GHC.resumeSpan $ head resumes) -> do
            step_here (GHC.resumeSpan $ head resumes) -> do

-               printForUser $ ptext (sLit "Stopped at") <+> 
-                       ppr (GHC.resumeSpan $ head resumes)
---               printTypeOfNames session names
-               let namesSorted = sortBy compareNames names
-               tythings <- catMaybes `liftM` 
-                              mapM GHC.lookupName namesSorted
-               docs <- pprTypeAndContents [id | AnId id <- tythings]
-               printForUserPartWay docs
-               maybe (return ()) runBreakCmd mb_info
+               mb_id_loc <- toBreakIdAndLocation mb_info
+               let breakCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
+               if (null breakCmd)
+                 then printStoppedAtBreakInfo (head resumes) names
+                 else enqueueCommands [breakCmd]

                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
                enqueueCommands [stop st]
                return ()

-         | otherwise -> resume GHC.SingleStep >>=
+         | otherwise -> resume step_here GHC.SingleStep >>=

                         afterRunStmt step_here >> return ()
      _ -> return ()
 
                         afterRunStmt step_here >> return ()
      _ -> return ()
 

@@ -760,17 +753,26 @@ afterRunStmt step_here run_result = do
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 

-runBreakCmd :: GHC.BreakInfo -> GHCi ()
-runBreakCmd info = do
+toBreakIdAndLocation ::
+  Maybe GHC.BreakInfo -> GHCi (Maybe (Int, BreakLocation))
+toBreakIdAndLocation Nothing = return Nothing
+toBreakIdAndLocation (Just info) = do

   let mod = GHC.breakInfo_module info
       nm  = GHC.breakInfo_number info
   st <- getGHCiState
   let mod = GHC.breakInfo_module info
       nm  = GHC.breakInfo_number info
   st <- getGHCiState

-  case  [ loc | (_,loc) <- breaks st,
-                breakModule loc == mod, breakTick loc == nm ] of
-        []  -> return ()
-        loc:_ | null cmd  -> return ()
-              | otherwise -> do enqueueCommands [cmd]; return ()
-              where cmd = onBreakCmd loc
+  return $ listToMaybe [ id_loc | id_loc@(_,loc) <- breaks st,
+                                  breakModule loc == mod,
+                                  breakTick loc == nm ]
+
+printStoppedAtBreakInfo :: Resume -> [Name] -> GHCi ()
+printStoppedAtBreakInfo resume names = do
+  printForUser $ ptext (sLit "Stopped at") <+>
+    ppr (GHC.resumeSpan resume)
+  --  printTypeOfNames session names
+  let namesSorted = sortBy compareNames names
+  tythings <- catMaybes `liftM` mapM GHC.lookupName namesSorted
+  docs <- pprTypeAndContents [id | AnId id <- tythings]
+  printForUserPartWay docs

 
 printTypeOfNames :: [Name] -> GHCi ()
 printTypeOfNames names
 
 printTypeOfNames :: [Name] -> GHCi ()
 printTypeOfNames names

@@ -1033,6 +1035,9 @@ defineMacro overwrite s = do
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
 runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)

+  -- make sure we force any exceptions in the result, while we are still
+  -- inside the exception handler for commands:
+  seqList str (return ())

   enqueueCommands (lines str)
   return False
 
   enqueueCommands (lines str)
   return False
 

@@ -1210,8 +1215,7 @@ typeOfExpr str
        ty <- GHC.exprType str
        dflags <- getDynFlags
        let pefas = dopt Opt_PrintExplicitForalls dflags
        ty <- GHC.exprType str
        dflags <- getDynFlags
        let pefas = dopt Opt_PrintExplicitForalls dflags

-       printForUser $ text str <+> dcolon
-                       <+> pprTypeForUser pefas ty
+       printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]

 
 kindOfType :: String -> GHCi ()
 kindOfType str 
 
 kindOfType :: String -> GHCi ()
 kindOfType str 

@@ -1675,8 +1679,8 @@ completeNone :: String -> IO [String]
 completeNone _w = return []
 
 completeMacro, completeIdentifier, completeModule,
 completeNone _w = return []
 
 completeMacro, completeIdentifier, completeModule,

-    completeHomeModule, completeSetOptions, completeFilename,
-    completeHomeModuleOrFile 
+    completeHomeModule, completeSetOptions, completeShowOptions,
+    completeFilename, completeHomeModuleOrFile

     :: String -> IO [String]
 
 #ifdef USE_EDITLINE
     :: String -> IO [String]
 
 #ifdef USE_EDITLINE

@@ -1750,9 +1754,15 @@ completeHomeModule w = do
 
 completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
 
 completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)

-    where options = "args":"prog":flagList
+    where options = "args":"prog":"prompt":"editor":"stop":flagList

           flagList = map head $ group $ sort allFlags
 
           flagList = map head $ group $ sort allFlags
 

+completeShowOptions w = do
+  return (filter (w `isPrefixOf`) options)
+    where options = ["args", "prog", "prompt", "editor", "stop",
+                     "modules", "bindings", "linker", "breaks",
+                     "context", "packages", "languages"]
+

 completeFilename w = do
     ws <- Readline.filenameCompletionFunction w
     case ws of
 completeFilename w = do
     ws <- Readline.filenameCompletionFunction w
     case ws of

@@ -1801,12 +1811,13 @@ allExposedModules dflags
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else
  where
   pkg_db = pkgIdMap (pkgState dflags)
 #else

-completeMacro      = completeNone
-completeIdentifier = completeNone
-completeModule     = completeNone
-completeHomeModule = completeNone
-completeSetOptions = completeNone
-completeFilename   = completeNone
+completeMacro       = completeNone
+completeIdentifier  = completeNone
+completeModule      = completeNone
+completeHomeModule  = completeNone
+completeSetOptions  = completeNone
+completeShowOptions = completeNone
+completeFilename    = completeNone

 completeHomeModuleOrFile=completeNone
 #endif
 
 completeHomeModuleOrFile=completeNone
 #endif
 

@@ -1967,7 +1978,7 @@ continueCmd = noArgs $ doContinue (const True) GHC.RunToCompletion
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 
 -- doContinue :: SingleStep -> GHCi ()
 doContinue :: (SrcSpan -> Bool) -> SingleStep -> GHCi ()
 doContinue pred step = do 

-  runResult <- resume step
+  runResult <- resume pred step

   afterRunStmt pred runResult
   return ()
 
   afterRunStmt pred runResult
   return ()