ghc/compiler/ghci/InteractiveUI.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: InteractiveUI.hs,v 1.4 2000/11/17 16:53:27 simonmar Exp $
   3 --
   4 -- GHC Interactive User Interface
   5 --
   6 -- (c) The GHC Team 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module InteractiveUI (interactiveUI) where
  11
  12 #include "HsVersions.h"
  13
  14 import CompManager
  15 import CmStaticInfo
  16 import DriverFlags
  17 import DriverUtil
  18 import DriverState
  19 import Linker
  20 import Module
  21 import Panic
  22 import Util
  23
  24 import Exception
  25 import Readline
  26 import IOExts
  27
  28 import System
  29 import Directory
  30 import IO
  31 import Char
  32
  33 -----------------------------------------------------------------------------
  34
  35 ghciWelcomeMsg = "\
  36 \ _____  __   __  ____         _________________________________________________\n\
  37 \(|      ||   || (|  |)        GHC Interactive, version 5.00                    \n\
  38 \||  __  ||___|| ||     ()     For Haskell 98.                                  \n\
  39 \||   |) ||---|| ||     ||     http://www.haskell.org/ghc                       \n\
  40 \||   || ||   || ||     (|     Bug reports to: glasgow-haskell-bugs@haskell.org \n\
  41 \(|___|| ||   || (|__|) \\\\______________________________________________________\n"
  42
  43 commands :: [(String, String -> GHCi ())]
  44 commands = [
  45   ("cd",        changeDirectory),
  46   ("help",      help),
  47   ("?",         help),
  48   ("load",      loadModule),
  49   ("reload",    reloadModule),
  50   ("set",       setOptions),
  51   ("type",      typeOfExpr),
  52   ("quit",      quit),
  53   ("!",         shellEscape)
  54   ]
  55
  56 shortHelpText = "use :? for help.\n"
  57
  58 helpText = "\
  59 \   <expr>              evaluate <expr>\n\
  60 \   :cd <dir>           change directory to <dir>\n\
  61 \   :help               display this list of commands\n\
  62 \   :?                  display this list of commands\n\
  63 \   :load <filename>    load a module (and it dependents)\n\
  64 \   :reload             reload the current program\n\
  65 \   :set <opetion> ...  set options\n\
  66 \   :type <expr>        show the type of <expr>\n\
  67 \   :quit               exit GHCi\n\
  68 \   :!<command>         run the shell command <command>\n\
  69 \"
  70
  71 interactiveUI :: CmState -> IO ()
  72 interactiveUI st = do
  73    hPutStrLn stdout ghciWelcomeMsg
  74    hFlush stdout
  75    hSetBuffering stdout NoBuffering
  76
  77    -- link in the available packages
  78    pkgs <- getPackageInfo
  79    linkPackages (reverse pkgs)
  80
  81 #ifndef NO_READLINE
  82    Readline.initialize
  83 #endif
  84    _ <- (unGHCi uiLoop) GHCiState{ current_module = mkModuleName "Main",
  85                                    target = Nothing,
  86                                    cmstate = st }
  87    return ()
  88
  89 uiLoop :: GHCi ()
  90 uiLoop = do
  91   st <- getGHCiState
  92 #ifndef NO_READLINE
  93   l <- io (readline (moduleNameUserString (current_module st)  ++ "> "))
  94 #else
  95   l <- io (hGetLine stdin)
  96 #endif
  97   case l of
  98     Nothing -> return ()
  99     Just "" -> uiLoop
 100     Just l  -> do
 101 #ifndef NO_READLINE
 102           io (addHistory l)
 103 #endif
 104           runCommand l
 105           uiLoop
 106
 107 -- Top level exception handler, just prints out the exception and carries on.
 108 runCommand c =
 109   ghciHandle ( \other_exception ->io (putStrLn (show other_exception) )) $
 110   ghciHandleDyn
 111     (\dyn -> case dyn of
 112                 PhaseFailed phase code ->
 113                         io ( putStrLn ("Phase " ++ phase ++ " failed (code "
 114                                         ++ show code ++ ")"))
 115                 Interrupted -> io (putStrLn "Interrupted.")
 116                 _ -> io (putStrLn (show (dyn :: BarfKind)))
 117     ) $
 118    doCommand c
 119
 120 doCommand (':' : command) = specialCommand command
 121 doCommand expr = do
 122   st <- getGHCiState
 123   dflags <- io (readIORef v_DynFlags)
 124   (st, maybe_hvalue) <-
 125         io (cmGetExpr (cmstate st) dflags (current_module st) expr)
 126   case maybe_hvalue of
 127         Nothing -> return ()
 128         Just hv -> io (cmRunExpr hv)
 129 {-
 130   let (mod,'.':str) = break (=='.') expr
 131   case cmLookupSymbol (mkOrig varName (mkModuleName mod) (_PK_ str)) (cmstate st) of
 132         Nothing -> io (putStrLn "nothing.")
 133         Just e  -> io (
 134   return ()
 135 -}
 136
 137 specialCommand str = do
 138   let (cmd,rest) = break isSpace str
 139   case [ (s,f) | (s,f) <- commands, prefixMatch cmd s ] of
 140      []      -> io $ hPutStr stdout ("uknown command `:" ++ cmd ++ "'\n"
 141                                     ++ shortHelpText)
 142      [(_,f)] -> f (dropWhile isSpace rest)
 143      cs      -> io $ hPutStrLn stdout ("prefix " ++ cmd ++
 144                                        " matches multiple commands (" ++
 145                                        foldr1 (\a b -> a ++ ',':b) (map fst cs)
 146                                          ++ ")")
 147
 148 noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
 149
 150 -----------------------------------------------------------------------------
 151 -- Commands
 152
 153 help :: String -> GHCi ()
 154 help _ = io (putStr helpText)
 155
 156 changeDirectory :: String -> GHCi ()
 157 changeDirectory = io . setCurrentDirectory
 158
 159 loadModule :: String -> GHCi ()
 160 loadModule path = do
 161   state <- getGHCiState
 162   (new_cmstate, mod) <- io (cmLoadModule (cmstate state)
 163                                 ({-ToDo!!-}mkModuleName path))
 164   let new_state = GHCiState {
 165                         cmstate = new_cmstate,
 166                         current_module = case mod of
 167                                            Nothing -> current_module state
 168                                            Just m  -> m,
 169                         target = Just path
 170                    }
 171   setGHCiState new_state
 172
 173 reloadModule :: String -> GHCi ()
 174 reloadModule "" = do
 175   state <- getGHCiState
 176   case target state of
 177         Nothing -> io (putStr "no current target\n")
 178         Just path -> do (new_cmstate, mod) <- io (cmLoadModule (cmstate state) (mkModuleName path))
 179                         setGHCiState state{cmstate=new_cmstate}
 180 reloadModule _ = noArgs ":reload"
 181
 182 -- set options in the interpreter.  Syntax is exactly the same as the
 183 -- ghc command line, except that certain options aren't available (-C,
 184 -- -E etc.)
 185 --
 186 -- This is pretty fragile: most options won't work as expected.  ToDo:
 187 -- figure out which ones & disallow them.
 188 setOptions :: String -> GHCi ()
 189 setOptions str =
 190    io (do leftovers <- processArgs static_flags (words str) []
 191           dyn_flags <- readIORef v_InitDynFlags
 192           writeIORef v_DynFlags dyn_flags
 193           leftovers <- processArgs dynamic_flags leftovers []
 194           dyn_flags <- readIORef v_DynFlags
 195           writeIORef v_InitDynFlags dyn_flags
 196           if (not (null leftovers))
 197                 then throwDyn (OtherError ("unrecognised flags: " ++
 198                                                 unwords leftovers))
 199                 else return ()
 200    )
 201
 202 typeOfExpr :: String -> GHCi ()
 203 typeOfExpr = panic "typeOfExpr"
 204
 205 quit :: String -> GHCi ()
 206 quit _ = return ()
 207
 208 shellEscape :: String -> GHCi ()
 209 shellEscape str = io (system str >> return ())
 210
 211 -----------------------------------------------------------------------------
 212 -- GHCi monad
 213
 214 data GHCiState = GHCiState
 215      {
 216         current_module :: ModuleName,
 217         target         :: Maybe FilePath,
 218         cmstate        :: CmState
 219      }
 220
 221 newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
 222
 223 instance Monad GHCi where
 224   (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \(s,a) -> unGHCi (k a) s
 225   return a  = GHCi $ \s -> return (s,a)
 226
 227 getGHCiState   = GHCi $ \s -> return (s,s)
 228 setGHCiState s = GHCi $ \_ -> return (s,())
 229
 230 io m = GHCi $ \s -> m >>= \a -> return (s,a)
 231
 232 ghciHandle h (GHCi m) = GHCi $ \s ->
 233    Exception.catch (m s) (\e -> unGHCi (h e) s)
 234 ghciHandleDyn h (GHCi m) = GHCi $ \s ->
 235    Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
 236
 237 -----------------------------------------------------------------------------
 238 -- package loader
 239
 240 linkPackages :: [Package] -> IO ()
 241 linkPackages pkgs = mapM_ linkPackage pkgs
 242
 243 linkPackage :: Package -> IO ()
 244 -- ignore rts and gmp for now (ToDo; better?)
 245 linkPackage pkg | name pkg `elem` ["rts", "gmp"] = return ()
 246 linkPackage pkg = do
 247   putStr ("Loading package " ++ name pkg ++ " ... ")
 248   let dirs = library_dirs pkg
 249   let objs = map (++".o") (hs_libraries pkg ++ extra_libraries pkg)
 250   mapM (linkOneObj dirs) objs
 251   putStr "resolving ... "
 252   resolveObjs
 253   putStrLn "done."
 254
 255 linkOneObj dirs obj = do
 256   filename <- findFile dirs obj
 257   loadObj filename
 258
 259 findFile [] obj = throwDyn (OtherError ("can't find " ++ obj))
 260 findFile (d:ds) obj = do
 261   let path = d ++ '/':obj
 262   b <- doesFileExist path
 263   if b then return path else findFile ds obj