[project @ 2001-01-10 17:19:01 by sewardj]

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

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 863176b..e699088 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.15 2000/11/24 17:09:52 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.25 2001/01/10 17:19:01 sewardj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -20,9 +20,13 @@ import Linker
 import Module
 import Outputable
 import Util
+import PprType {- instance Outputable Type; do not delete -}
+import Panic   ( GhcException(..) )
 
 import Exception
+#ifndef NO_READLINE
 import Readline
+#endif
 import IOExts
 
 import Numeric
@@ -33,6 +37,7 @@ import Directory
 import IO
 import Char
 
+
 -----------------------------------------------------------------------------
 
 ghciWelcomeMsg = "\ 
@@ -43,21 +48,24 @@ ghciWelcomeMsg = "\
 \||   || ||   || ||     (|     Bug reports to: glasgow-haskell-bugs@haskell.org \n\ 
 \(|___|| ||   || (|__|) \\\\______________________________________________________\n"
 
-commands :: [(String, String -> GHCi ())]
+commands :: [(String, String -> GHCi Bool)]
 commands = [
-  ("add",      addModule),
-  ("cd",       changeDirectory),
-  ("help",     help),
-  ("?",                help),
-  ("load",     loadModule),
-  ("module",   setContext),
-  ("reload",   reloadModule),
-  ("set",      setOptions),
-  ("type",     typeOfExpr),
-  ("unset",    unsetOptions),
+  ("add",      keepGoing addModule),
+  ("cd",       keepGoing changeDirectory),
+  ("help",     keepGoing help),
+  ("?",                keepGoing help),
+  ("load",     keepGoing loadModule),
+  ("module",   keepGoing setContext),
+  ("reload",   keepGoing reloadModule),
+  ("set",      keepGoing setOptions),
+  ("type",     keepGoing typeOfExpr),
+  ("unset",    keepGoing unsetOptions),
   ("quit",     quit)
   ]
 
+keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
+keepGoing a str = a str >> return False
+
 shortHelpText = "use :? for help.\n"
 
 helpText = "\ 
@@ -108,7 +116,7 @@ interactiveUI cmstate mod = do
 
    (unGHCi uiLoop) GHCiState{ modules = mods,
                              current_module = this_mod,
-                             target = Nothing,
+                             target = mod,
                              cmstate = cmstate',
                              options = [ShowTiming]}
    return ()
@@ -119,7 +127,8 @@ uiLoop = do
 #ifndef NO_READLINE
   l <- io (readline (moduleNameUserString (current_module st) ++ "> "))
 #else
-  l <- io (hGetLine stdin)
+  l_ok <- io (hGetLine stdin)
+  let l = Just l_ok
 #endif
   case l of
     Nothing -> exitGHCi
@@ -128,27 +137,34 @@ uiLoop = do
 #ifndef NO_READLINE
           io (addHistory l)
 #endif
-         runCommand l
-         uiLoop  
+         quit <- runCommand l
+          if quit then exitGHCi else uiLoop
 
-exitGHCi = io $ do putStrLn "Leaving GHCi."; exitWith ExitSuccess
+exitGHCi = io $ do putStrLn "Leaving GHCi." 
 
 -- Top level exception handler, just prints out the exception 
 -- and carries on.
+runCommand :: String -> GHCi Bool
 runCommand c = 
-  ghciHandle ( \other_exception ->io (putStrLn (show other_exception) )) $
+  ghciHandle ( 
+     \other_exception 
+        -> io (putStrLn (show other_exception)) >> return False
+  ) $
   ghciHandleDyn
     (\dyn -> case dyn of
                PhaseFailed phase code ->
                        io ( putStrLn ("Phase " ++ phase ++ " failed (code "
                                        ++ show code ++ ")"))
                Interrupted -> io (putStrLn "Interrupted.")
-               _ -> io (putStrLn (show (dyn :: BarfKind)))
+               _ -> io (putStrLn (show (dyn :: GhcException)))
+             >> return False
     ) $
    doCommand c
 
 doCommand (':' : command) = specialCommand command
-doCommand expr            = timeIt (evalExpr expr)
+doCommand expr            = do timeIt (evalExpr expr
+                                       >> evalExpr "Prelude.putStr \"\n\"")
+                               return False
 
 evalExpr expr
  = do st <- getGHCiState
@@ -172,17 +188,18 @@ evalExpr expr
   return ()
 -}
 
-specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
+specialCommand :: String -> GHCi Bool
+specialCommand ('!':str) = shellEscape (dropWhile isSpace str) 
 specialCommand str = do
   let (cmd,rest) = break isSpace str
   case [ (s,f) | (s,f) <- commands, prefixMatch cmd s ] of
-     []      -> io $ hPutStr stdout ("unknown command `:" ++ cmd ++ "'\n" 
-                                   ++ shortHelpText)
+     []      -> io (hPutStr stdout ("unknown command `:" ++ cmd ++ "'\n" 
+                                   ++ shortHelpText) >> return False)
      [(_,f)] -> f (dropWhile isSpace rest)
-     cs      -> io $ hPutStrLn stdout ("prefix " ++ cmd ++ 
-                                      " matches multiple commands (" ++ 
+     cs      -> io (hPutStrLn stdout ("prefix " ++ cmd ++ 
+                                     " matches multiple commands (" ++ 
                                       foldr1 (\a b -> a ++ ',':b) (map fst cs)
-                                        ++ ")")
+                                        ++ ")") >> return False)
 
 noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
 
@@ -205,7 +222,7 @@ setContext m
        setGHCiState st{current_module = mkModuleName m}
 
 changeDirectory :: String -> GHCi ()
-changeDirectory = io . setCurrentDirectory
+changeDirectory d = io (setCurrentDirectory d)
 
 loadModule :: String -> GHCi ()
 loadModule path = timeIt (loadModule' path)
@@ -220,7 +237,7 @@ loadModule' path = do
                        modules = mods,
                        current_module = case mods of 
                                           [] -> defaultCurrentModule
-                                          xs -> last xs,
+                                          xs -> head xs,
                        target = Just path
                   }
   setGHCiState new_state
@@ -241,8 +258,16 @@ reloadModule "" = do
   case target state of
    Nothing -> io (putStr "no current target\n")
    Just path
-      -> do (new_cmstate, ok, mod) <- io (cmLoadModule (cmstate state) path)
-            setGHCiState state{cmstate=new_cmstate}  
+      -> do (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
+            setGHCiState 
+               state{cmstate=new_cmstate,
+                     modules = mods,
+                     current_module = case mods of 
+                                         [] -> defaultCurrentModule
+                                         xs -> head xs
+                    }
+
+
 reloadModule _ = noArgs ":reload"
 
 typeOfExpr :: String -> GHCi ()
@@ -253,13 +278,13 @@ typeOfExpr str
                                (current_module st) str)
        case maybe_ty of
         Nothing -> return ()
-        Just (_, unqual, ty) -> io (printForUser stdout unqual (ppr ty))
+        Just (_, unqual, ty) -> io (printForUser stdout unqual (ppr ty)) 
 
-quit :: String -> GHCi ()
-quit _ = exitGHCi
+quit :: String -> GHCi Bool
+quit _ = return True
 
-shellEscape :: String -> GHCi ()
-shellEscape str = io (system str >> return ())
+shellEscape :: String -> GHCi Bool
+shellEscape str = io (system str >> return False)
 
 ----------------------------------------------------------------------------
 -- Code for `:set'