1 -----------------------------------------------------------------------------
2 -- $Id: InteractiveUI.hs,v 1.8 2000/11/21 14:32:44 simonmar Exp $
4 -- GHC Interactive User Interface
6 -- (c) The GHC Team 2000
8 -----------------------------------------------------------------------------
10 module InteractiveUI (interactiveUI) where
12 #include "HsVersions.h"
34 -----------------------------------------------------------------------------
37 \ _____ __ __ ____ _________________________________________________\n\
38 \(| || || (| |) GHC Interactive, version 5.00 \n\
39 \|| __ ||___|| || () For Haskell 98. \n\
40 \|| |) ||---|| || || http://www.haskell.org/ghc \n\
41 \|| || || || || (| Bug reports to: glasgow-haskell-bugs@haskell.org \n\
42 \(|___|| || || (|__|) \\\\______________________________________________________\n"
44 commands :: [(String, String -> GHCi ())]
46 ("cd", changeDirectory),
50 ("reload", reloadModule),
56 shortHelpText = "use :? for help.\n"
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\
68 \ :!<command> run the shell command <command>\n\
71 interactiveUI :: CmState -> IO ()
73 hPutStrLn stdout ghciWelcomeMsg
75 hSetBuffering stdout NoBuffering
77 -- link in the available packages
78 pkgs <- getPackageInfo
79 linkPackages (reverse pkgs)
84 _ <- (unGHCi uiLoop) GHCiState{ modules = [],
85 current_module = defaultCurrentModule,
94 l <- io (readline (moduleNameUserString (current_module st) ++ "> "))
96 l <- io (hGetLine stdin)
108 -- Top level exception handler, just prints out the exception
111 ghciHandle ( \other_exception ->io (putStrLn (show other_exception) )) $
114 PhaseFailed phase code ->
115 io ( putStrLn ("Phase " ++ phase ++ " failed (code "
116 ++ show code ++ ")"))
117 Interrupted -> io (putStrLn "Interrupted.")
118 _ -> io (putStrLn (show (dyn :: BarfKind)))
122 doCommand (':' : command) = specialCommand command
124 = do st <- getGHCiState
125 dflags <- io (readIORef v_DynFlags)
126 (new_cmstate, maybe_hvalue) <-
127 io (cmGetExpr (cmstate st) dflags (current_module st) expr)
128 setGHCiState st{cmstate = new_cmstate}
131 Just hv -> io (cmRunExpr hv)
133 let (mod,'.':str) = break (=='.') expr
134 case cmLookupSymbol (mkOrig varName (mkModuleName mod) (_PK_ str)) (cmstate st) of
135 Nothing -> io (putStrLn "nothing.")
140 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
141 specialCommand str = do
142 let (cmd,rest) = break isSpace str
143 case [ (s,f) | (s,f) <- commands, prefixMatch cmd s ] of
144 [] -> io $ hPutStr stdout ("uknown command `:" ++ cmd ++ "'\n"
146 [(_,f)] -> f (dropWhile isSpace rest)
147 cs -> io $ hPutStrLn stdout ("prefix " ++ cmd ++
148 " matches multiple commands (" ++
149 foldr1 (\a b -> a ++ ',':b) (map fst cs)
152 noArgs c = io (hPutStrLn stdout ("command `:" ++ c ++ "' takes no arguments"))
154 -----------------------------------------------------------------------------
157 help :: String -> GHCi ()
158 help _ = io (putStr helpText)
160 changeDirectory :: String -> GHCi ()
161 changeDirectory = io . setCurrentDirectory
163 loadModule :: String -> GHCi ()
165 state <- getGHCiState
166 (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
168 let new_state = GHCiState {
169 cmstate = new_cmstate,
171 current_module = case mods of
172 [] -> defaultCurrentModule
176 setGHCiState new_state
179 | null mods = text "none."
181 punctuate comma (map (text.moduleNameUserString) mods)) <> text "."
184 io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
186 io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
188 reloadModule :: String -> GHCi ()
190 state <- getGHCiState
192 Nothing -> io (putStr "no current target\n")
193 Just path -> do (new_cmstate, ok, mod)
194 <- io (cmLoadModule (cmstate state) path)
195 setGHCiState state{cmstate=new_cmstate}
196 reloadModule _ = noArgs ":reload"
198 -- set options in the interpreter. Syntax is exactly the same as the
199 -- ghc command line, except that certain options aren't available (-C,
202 -- This is pretty fragile: most options won't work as expected. ToDo:
203 -- figure out which ones & disallow them.
204 setOptions :: String -> GHCi ()
206 io (do leftovers <- processArgs static_flags (words str) []
207 dyn_flags <- readIORef v_InitDynFlags
208 writeIORef v_DynFlags dyn_flags
209 leftovers <- processArgs dynamic_flags leftovers []
210 dyn_flags <- readIORef v_DynFlags
211 writeIORef v_InitDynFlags dyn_flags
212 if (not (null leftovers))
213 then throwDyn (OtherError ("unrecognised flags: " ++
218 typeOfExpr :: String -> GHCi ()
219 typeOfExpr = panic "typeOfExpr"
221 quit :: String -> GHCi ()
224 shellEscape :: String -> GHCi ()
225 shellEscape str = io (system str >> return ())
227 -----------------------------------------------------------------------------
230 data GHCiState = GHCiState
232 modules :: [ModuleName],
233 current_module :: ModuleName,
234 target :: Maybe FilePath,
238 defaultCurrentModule = mkModuleName "Prelude"
240 newtype GHCi a = GHCi { unGHCi :: GHCiState -> IO (GHCiState, a) }
242 instance Monad GHCi where
243 (GHCi m) >>= k = GHCi $ \s -> m s >>= \(s,a) -> unGHCi (k a) s
244 return a = GHCi $ \s -> return (s,a)
246 getGHCiState = GHCi $ \s -> return (s,s)
247 setGHCiState s = GHCi $ \_ -> return (s,())
249 io m = GHCi $ \s -> m >>= \a -> return (s,a)
251 ghciHandle h (GHCi m) = GHCi $ \s ->
252 Exception.catch (m s) (\e -> unGHCi (h e) s)
253 ghciHandleDyn h (GHCi m) = GHCi $ \s ->
254 Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
256 -----------------------------------------------------------------------------
259 linkPackages :: [Package] -> IO ()
260 linkPackages pkgs = mapM_ linkPackage pkgs
262 linkPackage :: Package -> IO ()
263 -- ignore rts and gmp for now (ToDo; better?)
264 linkPackage pkg | name pkg `elem` ["rts", "gmp"] = return ()
266 putStr ("Loading package " ++ name pkg ++ " ... ")
267 let dirs = library_dirs pkg
268 let objs = map (++".o") (hs_libraries pkg ++ extra_libraries pkg)
269 mapM (linkOneObj dirs) objs
270 putStr "resolving ... "
274 linkOneObj dirs obj = do
275 filename <- findFile dirs obj
278 findFile [] obj = throwDyn (OtherError ("can't find " ++ obj))
279 findFile (d:ds) obj = do
280 let path = d ++ '/':obj
281 b <- doesFileExist path
282 if b then return path else findFile ds obj