[project @ 2000-11-22 17:51:16 by simonmar]

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

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 39bbe01..b6c3829 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.8 2000/11/21 14:32:44 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.14 2000/11/22 17:51:16 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -19,7 +19,6 @@ import DriverState
 import Linker
 import Module
 import Outputable
-import Panic
 import Util
 
 import Exception
@@ -43,10 +42,12 @@ ghciWelcomeMsg = "\
 
 commands :: [(String, String -> GHCi ())]
 commands = [
+  ("add",      addModule),
   ("cd",       changeDirectory),
   ("help",     help),
   ("?",                help),
   ("load",     loadModule),
+  ("module",   setContext),
   ("reload",   reloadModule),
   ("set",      setOptions),
   ("type",     typeOfExpr),
@@ -57,19 +58,20 @@ shortHelpText = "use :? for help.\n"
 
 helpText = "\ 
 \   <expr>             evaluate <expr>\n\ 
+\   :add <filename>     add a module to the current set\n\ 
 \   :cd <dir>          change directory to <dir>\n\ 
-\   :help              display this list of commands\n\ 
-\   :?                 display this list of commands\n\ 
+\   :help, :?          display this list of commands\n\ 
 \   :load <filename>    load a module (and it dependents)\n\ 
-\   :reload            reload the current program\n\ 
-\   :set <opetion> ... set options\n\ 
+\   :module <mod>      set the context for expression evaluation to <mod>\n\ 
+\   :reload            reload the current module set\n\ 
+\   :set <option> ...  set options\n\ 
 \   :type <expr>       show the type of <expr>\n\ 
 \   :quit              exit GHCi\n\ 
 \   :!<command>                run the shell command <command>\n\ 
 \"
 
-interactiveUI :: CmState -> IO ()
-interactiveUI st = do
+interactiveUI :: CmState -> [ModuleName] -> IO ()
+interactiveUI st mods = do
    hPutStrLn stdout ghciWelcomeMsg
    hFlush stdout
    hSetBuffering stdout NoBuffering
@@ -81,10 +83,14 @@ interactiveUI st = do
 #ifndef NO_READLINE
    Readline.initialize
 #endif
-   _ <- (unGHCi uiLoop) GHCiState{ modules = [],
-                                  current_module = defaultCurrentModule,
-                                  target = Nothing,
-                                  cmstate = st }
+   let this_mod = case mods of 
+                       [] -> defaultCurrentModule
+                       m:ms -> m
+
+   (unGHCi uiLoop) GHCiState{ modules = mods,
+                             current_module = this_mod,
+                             target = Nothing,
+                             cmstate = st }
    return ()
 
 uiLoop :: GHCi ()
@@ -96,7 +102,7 @@ uiLoop = do
   l <- io (hGetLine stdin)
 #endif
   case l of
-    Nothing -> return ()
+    Nothing -> exitGHCi
     Just "" -> uiLoop
     Just l  -> do
 #ifndef NO_READLINE
@@ -105,6 +111,8 @@ uiLoop = do
          runCommand l
          uiLoop  
 
+exitGHCi = io $ do putStrLn "Leaving GHCi."; exitWith ExitSuccess
+
 -- Top level exception handler, just prints out the exception 
 -- and carries on.
 runCommand c = 
@@ -122,7 +130,7 @@ runCommand c =
 doCommand (':' : command) = specialCommand command
 doCommand expr
  = do st <- getGHCiState
-      dflags <- io (readIORef v_DynFlags)
+      dflags <- io (getDynFlags)
       (new_cmstate, maybe_hvalue) <- 
         io (cmGetExpr (cmstate st) dflags (current_module st) expr)
       setGHCiState st{cmstate = new_cmstate}
@@ -141,7 +149,7 @@ 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 ("uknown command `:" ++ cmd ++ "'\n" 
+     []      -> io $ hPutStr stdout ("unknown command `:" ++ cmd ++ "'\n" 
                                    ++ shortHelpText)
      [(_,f)] -> f (dropWhile isSpace rest)
      cs      -> io $ hPutStrLn stdout ("prefix " ++ cmd ++ 
@@ -157,16 +165,29 @@ noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
+addModule :: String -> GHCi ()
+addModule _ = throwDyn (OtherError ":add not implemented")
+
+setContext :: String -> GHCi ()
+setContext ""
+  = throwDyn (OtherError "syntax: `:m <module>'")
+setContext m | not (isUpper (head m)) || not (all isAlphaNum (tail m))
+  = throwDyn (OtherError ("strange looking module name: `" ++ m ++ "'"))
+setContext m
+  = do st <- getGHCiState
+       setGHCiState st{current_module = mkModuleName m}
+
 changeDirectory :: String -> GHCi ()
 changeDirectory = io . setCurrentDirectory
 
 loadModule :: String -> GHCi ()
 loadModule path = do
   state <- getGHCiState
-  (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
+  cmstate1 <- io (cmUnload (cmstate state))
+  (cmstate2, ok, mods) <- io (cmLoadModule cmstate1 path)
 
   let new_state = GHCiState {
-                       cmstate = new_cmstate,
+                       cmstate = cmstate2,
                        modules = mods,
                        current_module = case mods of 
                                           [] -> defaultCurrentModule
@@ -190,9 +211,9 @@ reloadModule "" = do
   state <- getGHCiState
   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}  
+   Just path
+      -> do (new_cmstate, ok, mod) <- io (cmLoadModule (cmstate state) path)
+            setGHCiState state{cmstate=new_cmstate}  
 reloadModule _ = noArgs ":reload"
 
 -- set options in the interpreter.  Syntax is exactly the same as the
@@ -216,10 +237,17 @@ setOptions str =
    )
 
 typeOfExpr :: String -> GHCi ()
-typeOfExpr = panic "typeOfExpr"
+typeOfExpr str 
+  = do st <- getGHCiState
+       dflags <- io (getDynFlags)
+       (st, maybe_ty) <- io (cmTypeExpr (cmstate st) dflags 
+                               (current_module st) str)
+       case maybe_ty of
+        Nothing -> return ()
+        Just (unqual, ty) -> io (printForUser stdout unqual (ppr ty))
 
 quit :: String -> GHCi ()
-quit _ = return ()
+quit _ = exitGHCi
 
 shellEscape :: String -> GHCi ()
 shellEscape str = io (system str >> return ())