ghc/compiler/ghci/InteractiveUI.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: InteractiveUI.hs,v 1.3 2000/11/16 16:54:36 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 DriverUtil
  17 import DriverState
  18 import Linker
  19 import Module
  20 import RdrName                          -- tmp
  21 import OccName                          -- tmp
  22 import Panic
  23 import Util
  24
  25 import Exception
  26 import Readline
  27 import IOExts
  28
  29 import System
  30 import Directory
  31 import IO
  32 import Char
  33
  34 import PrelGHC  ( unsafeCoerce# )
  35
  36 -----------------------------------------------------------------------------
  37
  38 ghciWelcomeMsg = "\
  39 \ _____  __   __  ____         _________________________________________________\n\
  40 \(|      ||   || (|  |)        GHC Interactive, version 5.00                    \n\
  41 \||  __  ||___|| ||     ()     For Haskell 98.                                  \n\
  42 \||   |) ||---|| ||     ||     http://www.haskell.org/ghc                       \n\
  43 \||   || ||   || ||     (|     Bug reports to: glasgow-haskell-bugs@haskell.org \n\
  44 \(|___|| ||   || (|__|) \\\\______________________________________________________\n"
  45
  46 commands :: [(String, String -> GHCi ())]
  47 commands = [
  48   ("cd",        changeDirectory),
  49   ("help",      help),
  50   ("?",         help),
  51   ("load",      loadModule),
  52   ("reload",    reloadModule),
  53   ("set",       setOptions),
  54   ("type",      typeOfExpr),
  55   ("quit",      quit),
  56   ("!",         shellEscape)
  57   ]
  58
  59 shortHelpText = "use :? for help.\n"
  60
  61 helpText = "\
  62 \   <expr>              evaluate <expr>\n\
  63 \   :cd <dir>           change directory to <dir>\n\
  64 \   :help               display this list of commands\n\
  65 \   :?                  display this list of commands\n\
  66 \   :load <filename>    load a module (and it dependents)\n\
  67 \   :reload             reload the current program\n\
  68 \   :set <opetion> ...  set options\n\
  69 \   :type <expr>        show the type of <expr>\n\
  70 \   :quit               exit GHCi\n\
  71 \   :!<command>         run the shell command <command>\n\
  72 \"
  73
  74 interactiveUI :: CmState -> IO ()
  75 interactiveUI st = do
  76    hPutStrLn stdout ghciWelcomeMsg
  77    hFlush stdout
  78    hSetBuffering stdout NoBuffering
  79
  80    -- link in the available packages
  81    pkgs <- getPackageInfo
  82    linkPackages (reverse pkgs)
  83
  84 #ifndef NO_READLINE
  85    Readline.initialize
  86 #endif
  87    _ <- (unGHCi uiLoop) GHCiState{ current_module = mkModuleName "Prelude",
  88                                    target = Nothing,
  89                                    cmstate = st }
  90    return ()
  91
  92 uiLoop :: GHCi ()
  93 uiLoop = do
  94   st <- getGHCiState
  95 #ifndef NO_READLINE
  96   l <- io (readline (moduleNameUserString (current_module st)  ++ "> "))
  97 #else
  98   l <- io (hGetLine stdin)
  99 #endif
 100   case l of
 101     Nothing -> return ()
 102     Just "" -> uiLoop
 103     Just l  -> do
 104 #ifndef NO_READLINE
 105           io (addHistory l)
 106 #endif
 107           runCommand l
 108           uiLoop
 109
 110 runCommand c =
 111   myCatchDyn (doCommand c)
 112     (\dyn -> case dyn of
 113                 PhaseFailed phase code ->
 114                         io ( putStrLn ("Phase " ++ phase ++ " failed (code "
 115                                         ++ show code ++ ")"))
 116                 Interrupted -> io (putStrLn "Interrupted.")
 117                 _ -> io (putStrLn (show (dyn :: BarfKind)))
 118     )
 119
 120 doCommand (':' : command) = specialCommand command
 121 doCommand expr = do
 122   st <- getGHCiState
 123   io (hPutStrLn stdout ("Run expression: " ++ expr))
 124   let (mod,'.':str) = break (=='.') expr
 125   case cmLookupSymbol (mkOrig varName (mkModuleName mod) (_PK_ str)) (cmstate st) of
 126         Nothing -> io (putStrLn "nothing.")
 127         Just e  -> io (do unsafeCoerce# e :: IO ()
 128                           putStrLn "done.")
 129   return ()
 130
 131 specialCommand str = do
 132   let (cmd,rest) = break isSpace str
 133   case [ (s,f) | (s,f) <- commands, prefixMatch cmd s ] of
 134      []      -> io $ hPutStr stdout ("uknown command `:" ++ cmd ++ "'\n"
 135                                     ++ shortHelpText)
 136      [(_,f)] -> f (dropWhile isSpace rest)
 137      cs      -> io $ hPutStrLn stdout ("prefix " ++ cmd ++
 138                                        " matches multiple commands (" ++
 139                                        foldr1 (\a b -> a ++ ',':b) (map fst cs)
 140                                          ++ ")")
 141
 142 noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
 143
 144 -----------------------------------------------------------------------------
 145 -- Commands
 146
 147 -- ToDo: don't forget to catch errors
 148
 149 help :: String -> GHCi ()
 150 help _ = io (putStr helpText)
 151
 152 changeDirectory :: String -> GHCi ()
 153 changeDirectory = io . setCurrentDirectory
 154
 155 loadModule :: String -> GHCi ()
 156 loadModule path = do
 157   state <- getGHCiState
 158   (new_cmstate, mod) <- io (cmLoadModule (cmstate state) ({-ToDo!!-}mkModuleName path))
 159   setGHCiState state{cmstate=new_cmstate, target=Just path}
 160
 161 reloadModule :: String -> GHCi ()
 162 reloadModule "" = do
 163   state <- getGHCiState
 164   case target state of
 165         Nothing -> io (putStr "no current target\n")
 166         Just path -> do (new_cmstate, mod) <- io (cmLoadModule (cmstate state) (mkModuleName path))
 167                         setGHCiState state{cmstate=new_cmstate}
 168 reloadModule _ = noArgs ":reload"
 169
 170 setOptions :: String -> GHCi ()
 171 setOptions = panic "setOptions"
 172
 173 typeOfExpr :: String -> GHCi ()
 174 typeOfExpr = panic "typeOfExpr"
 175
 176 quit :: String -> GHCi ()
 177 quit _ = return ()
 178
 179 shellEscape :: String -> GHCi ()
 180 shellEscape str = io (system str >> return ())
 181
 182 -----------------------------------------------------------------------------
 183 -- GHCi monad
 184
 185 data GHCiState = GHCiState
 186      {
 187         current_module :: ModuleName,
 188         target         :: Maybe FilePath,
 189         cmstate        :: CmState
 190      }
 191
 192 newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
 193
 194 instance Monad GHCi where
 195   (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \(s,a) -> unGHCi (k a) s
 196   return a  = GHCi $ \s -> return (s,a)
 197
 198 getGHCiState   = GHCi $ \s -> return (s,s)
 199 setGHCiState s = GHCi $ \_ -> return (s,())
 200
 201 io m = GHCi $ \s -> m >>= \a -> return (s,a)
 202
 203 myCatch (GHCi m) h = GHCi $ \s ->
 204    Exception.catch (m s) (\e -> unGHCi (h e) s)
 205 myCatchDyn (GHCi m) h = GHCi $ \s ->
 206    Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
 207
 208 -----------------------------------------------------------------------------
 209 -- package loader
 210
 211 linkPackages :: [Package] -> IO ()
 212 linkPackages pkgs = mapM_ linkPackage pkgs
 213
 214 linkPackage :: Package -> IO ()
 215 -- ignore rts and gmp for now (ToDo; better?)
 216 linkPackage pkg | name pkg `elem` ["rts", "gmp"] = return ()
 217 linkPackage pkg = do
 218   putStr ("Loading package " ++ name pkg ++ " ... ")
 219   let dirs = library_dirs pkg
 220   let objs = map (++".o") (hs_libraries pkg ++ extra_libraries pkg)
 221   mapM (linkOneObj dirs) objs
 222   putStr "resolving ... "
 223   resolveObjs
 224   putStrLn "done."
 225
 226 linkOneObj dirs obj = do
 227   filename <- findFile dirs obj
 228   loadObj filename
 229
 230 findFile [] obj = throwDyn (OtherError ("can't find " ++ obj))
 231 findFile (d:ds) obj = do
 232   let path = d ++ '/':obj
 233   b <- doesFileExist path
 234   if b then return path else findFile ds obj
 235
 236