1 -----------------------------------------------------------------------------
2 -- $Id: InteractiveUI.hs,v 1.80 2001/06/28 11:29:26 simonmar Exp $
4 -- GHC Interactive User Interface
6 -- (c) The GHC Team 2000
8 -----------------------------------------------------------------------------
10 {-# OPTIONS -#include "Linker.h" #-}
11 module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
13 #include "../includes/config.h"
14 #include "HsVersions.h"
18 import HscTypes ( GhciMode(..) )
24 import Finder ( flushPackageCache )
28 import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
29 import Panic ( GhcException(..) )
32 #ifndef mingw32_TARGET_OS
38 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
52 import PrelGHC ( unsafeCoerce# )
53 import Foreign ( nullPtr )
54 import CString ( peekCString )
56 -----------------------------------------------------------------------------
60 \ / _ \\ /\\ /\\/ __(_)\n\
61 \ / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n\
62 \/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n\
63 \\\____/\\/ /_/\\____/|_| Type :? for help.\n"
65 GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
67 builtin_commands :: [(String, String -> GHCi Bool)]
69 ("add", keepGoing addModule),
70 ("cd", keepGoing changeDirectory),
71 ("def", keepGoing defineMacro),
72 ("help", keepGoing help),
73 ("?", keepGoing help),
74 ("load", keepGoing loadModule),
75 ("module", keepGoing setContext),
76 ("reload", keepGoing reloadModule),
77 ("set", keepGoing setOptions),
78 ("type", keepGoing typeOfExpr),
79 ("unset", keepGoing unsetOptions),
80 ("undef", keepGoing undefineMacro),
84 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
85 keepGoing a str = a str >> return False
87 shortHelpText = "use :? for help.\n"
90 \ Commands available from the prompt:\n\
92 \ <stmt> evaluate/run <stmt>\n\
93 \ :add <filename> ... add module(s) to the current target set\n\
94 \ :cd <dir> change directory to <dir>\n\
95 \ :def <cmd> <expr> define a command :<cmd>\n\
96 \ :help, :? display this list of commands\n\
97 \ :load <filename> ... load module(s) and their dependents\n\
98 \ :module <mod> set the context for expression evaluation to <mod>\n\
99 \ :reload reload the current module set\n\
100 \ :set <option> ... set options\n\
101 \ :undef <cmd> undefine user-defined command :<cmd>\n\
102 \ :type <expr> show the type of <expr>\n\
103 \ :unset <option> ... unset options\n\
105 \ :!<command> run the shell command <command>\n\
107 \ Options for `:set' and `:unset':\n\
109 \ +r revert top-level expressions after each evaluation\n\
110 \ +s print timing/memory stats after each evaluation\n\
111 \ +t print type after evaluation\n\
112 \ -<flags> most GHC command line flags can also be set here\n\
113 \ (eg. -v2, -fglasgow-exts, etc.)\n\
116 interactiveUI :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
117 interactiveUI cmstate paths cmdline_libs = do
119 hSetBuffering stdout NoBuffering
121 -- link in the available packages
122 pkgs <- getPackageInfo
124 linkPackages cmdline_libs pkgs
126 (cmstate, ok, mods) <-
128 [] -> return (cmstate, True, [])
129 _ -> cmLoadModule cmstate paths
131 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
135 dflags <- getDynFlags
137 (cmstate, maybe_hval)
138 <- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stderr"
140 Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
141 _ -> panic "interactiveUI:stderr"
143 (cmstate, maybe_hval)
144 <- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stdout"
146 Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
147 _ -> panic "interactiveUI:stdout"
149 startGHCi runGHCi GHCiState{ targets = paths,
159 exists <- io (doesFileExist file)
161 dir_ok <- io (checkPerms ".")
162 file_ok <- io (checkPerms file)
163 when (dir_ok && file_ok) $ do
164 either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
167 Right hdl -> fileLoop hdl False
169 -- Read in $HOME/.ghci
170 either_dir <- io (IO.try (getEnv "HOME"))
174 cwd <- io (getCurrentDirectory)
175 when (dir /= cwd) $ do
176 let file = dir ++ "/.ghci"
177 ok <- io (checkPerms file)
178 either_hdl <- io (IO.try (openFile file ReadMode))
181 Right hdl -> fileLoop hdl False
183 -- read commands from stdin
184 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
191 io $ do putStrLn "Leaving GHCi."
194 -- NOTE: We only read .ghci files if they are owned by the current user,
195 -- and aren't world writable. Otherwise, we could be accidentally
196 -- running code planted by a malicious third party.
198 -- Furthermore, We only read ./.ghci if both . and ./.ghci are
199 -- owned by the current user and aren't writable by anyone else. I
200 -- think this is sufficient: we don't need to check .. and
201 -- ../.. etc. because "." always refers to the same directory while a
202 -- process is running.
204 checkPerms :: String -> IO Bool
206 handle (\_ -> return False) $ do
207 #ifdef mingw32_TARGET_OS
210 st <- getFileStatus name
212 if fileOwner st /= me then do
213 putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
216 let mode = fileMode st
217 if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
218 || (otherWriteMode == (mode `intersectFileModes` otherWriteMode))
220 putStrLn $ "*** WARNING: " ++ name ++
221 " is writable by someone else, IGNORING!"
226 fileLoop :: Handle -> Bool -> GHCi ()
227 fileLoop hdl prompt = do
229 mod <- io (cmGetContext (cmstate st))
230 when prompt (io (putStr (mod ++ "> ")))
231 l <- io (IO.try (hGetLine hdl))
233 Left e | isEOFError e -> return ()
234 | otherwise -> throw e
236 case remove_spaces l of
237 "" -> fileLoop hdl prompt
238 l -> do quit <- runCommand l
239 if quit then return () else fileLoop hdl prompt
241 stringLoop :: [String] -> GHCi ()
242 stringLoop [] = return ()
243 stringLoop (s:ss) = do
245 case remove_spaces s of
247 l -> do quit <- runCommand l
248 if quit then return () else stringLoop ss
250 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
251 readlineLoop :: GHCi ()
254 mod <- io (cmGetContext (cmstate st))
255 l <- io (readline (mod ++ "> "))
259 case remove_spaces l of
264 if quit then return () else readlineLoop
267 -- Top level exception handler, just prints out the exception
269 runCommand :: String -> GHCi Bool
271 ghciHandle ( \exception -> do
273 showException exception
278 showException (DynException dyn) =
279 case fromDynamic dyn of
281 io (putStrLn ("*** Exception: (unknown)"))
282 Just (PhaseFailed phase code) ->
283 io (putStrLn ("Phase " ++ phase ++ " failed (code "
284 ++ show code ++ ")"))
286 io (putStrLn "Interrupted.")
287 Just (CmdLineError s) ->
288 io (putStrLn s) -- omit the location for CmdLineError
290 io (putStrLn (show other_ghc_ex))
291 showException other_exception
292 = io (putStrLn ("*** Exception: " ++ show other_exception))
294 doCommand (':' : command) = specialCommand command
296 = do timeIt (do stuff <- runStmt stmt; finishEvalExpr stuff)
299 -- Returns True if the expr was successfully parsed, renamed and
301 runStmt :: String -> GHCi (Maybe [Name])
303 | null (filter (not.isSpace) stmt)
306 = do st <- getGHCiState
307 dflags <- io getDynFlags
308 let dflags' = dopt_unset dflags Opt_WarnUnusedBinds
309 (new_cmstate, names) <- io (cmRunStmt (cmstate st) dflags' stmt)
310 setGHCiState st{cmstate = new_cmstate}
313 -- possibly print the type and revert CAFs after evaluating an expression
314 finishEvalExpr Nothing = return False
315 finishEvalExpr (Just names)
316 = do b <- isOptionSet ShowType
318 when b (mapM_ (showTypeOfName (cmstate st)) names)
320 b <- isOptionSet RevertCAFs
321 io (when b revertCAFs)
325 showTypeOfName :: CmState -> Name -> GHCi ()
326 showTypeOfName cmstate n
327 = do maybe_str <- io (cmTypeOfName cmstate n)
330 Just str -> io (putStrLn (showSDoc (ppr n) ++ " :: " ++ str))
332 flushEverything :: GHCi ()
334 = io $ do flush_so <- readIORef flush_stdout
336 flush_se <- readIORef flush_stdout
340 specialCommand :: String -> GHCi Bool
341 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
342 specialCommand str = do
343 let (cmd,rest) = break isSpace str
344 cmds <- io (readIORef commands)
345 case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
346 [] -> io (hPutStr stdout ("unknown command `:" ++ cmd ++ "'\n"
347 ++ shortHelpText) >> return False)
348 [(_,f)] -> f (dropWhile isSpace rest)
349 cs -> io (hPutStrLn stdout ("prefix " ++ cmd ++
350 " matches multiple commands (" ++
351 foldr1 (\a b -> a ++ ',':b) (map fst cs)
352 ++ ")") >> return False)
354 noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
356 -----------------------------------------------------------------------------
359 help :: String -> GHCi ()
360 help _ = io (putStr helpText)
362 addModule :: String -> GHCi ()
364 let files = words str
365 state <- getGHCiState
366 dflags <- io (getDynFlags)
367 io (revertCAFs) -- always revert CAFs on load/add.
368 let new_targets = files ++ targets state
369 (cmstate1, ok, mods) <- io (cmLoadModule (cmstate state) new_targets)
370 setGHCiState state{ cmstate = cmstate1, targets = new_targets }
371 modulesLoadedMsg ok mods
373 setContext :: String -> GHCi ()
375 = throwDyn (CmdLineError "syntax: `:m <module>'")
376 setContext m | not (isUpper (head m)) || not (all isAlphaNumEx (tail m))
377 = throwDyn (CmdLineError ("strange looking module name: `" ++ m ++ "'"))
379 isAlphaNumEx c = isAlphaNum c || c == '_'
381 = do st <- getGHCiState
382 new_cmstate <- io (cmSetContext (cmstate st) str)
383 setGHCiState st{cmstate=new_cmstate}
385 changeDirectory :: String -> GHCi ()
386 changeDirectory ('~':d) = do
387 tilde <- io (getEnv "HOME") -- will fail if HOME not defined
388 io (setCurrentDirectory (tilde ++ '/':d))
389 changeDirectory d = io (setCurrentDirectory d)
391 defineMacro :: String -> GHCi ()
393 let (macro_name, definition) = break isSpace s
394 cmds <- io (readIORef commands)
396 then throwDyn (CmdLineError "invalid macro name")
398 if (macro_name `elem` map fst cmds)
399 then throwDyn (CmdLineError
400 ("command `" ++ macro_name ++ "' is already defined"))
403 -- give the expression a type signature, so we can be sure we're getting
404 -- something of the right type.
405 let new_expr = '(' : definition ++ ") :: String -> IO String"
407 -- compile the expression
409 dflags <- io getDynFlags
410 (new_cmstate, maybe_hv) <- io (cmCompileExpr (cmstate st) dflags new_expr)
411 setGHCiState st{cmstate = new_cmstate}
414 Just hv -> io (writeIORef commands --
415 ((macro_name, keepGoing (runMacro hv)) : cmds))
417 runMacro :: HValue{-String -> IO String-} -> String -> GHCi ()
419 str <- io ((unsafeCoerce# fun :: String -> IO String) s)
420 stringLoop (lines str)
422 undefineMacro :: String -> GHCi ()
423 undefineMacro macro_name = do
424 cmds <- io (readIORef commands)
425 if (macro_name `elem` map fst builtin_commands)
426 then throwDyn (CmdLineError
427 ("command `" ++ macro_name ++ "' cannot be undefined"))
429 if (macro_name `notElem` map fst cmds)
430 then throwDyn (CmdLineError
431 ("command `" ++ macro_name ++ "' not defined"))
433 io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
435 loadModule :: String -> GHCi ()
436 loadModule str = timeIt (loadModule' str)
439 let files = words str
440 state <- getGHCiState
441 dflags <- io getDynFlags
442 cmstate1 <- io (cmUnload (cmstate state) dflags)
443 setGHCiState state{ cmstate = cmstate1, targets = [] }
444 io (revertCAFs) -- always revert CAFs on load.
445 (cmstate2, ok, mods) <- io (cmLoadModule cmstate1 files)
446 setGHCiState state{ cmstate = cmstate2, targets = files }
447 modulesLoadedMsg ok mods
449 reloadModule :: String -> GHCi ()
451 state <- getGHCiState
452 case targets state of
453 [] -> io (putStr "no current target\n")
455 -> do io (revertCAFs) -- always revert CAFs on reload.
456 (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) paths)
457 setGHCiState state{ cmstate=new_cmstate }
458 modulesLoadedMsg ok mods
460 reloadModule _ = noArgs ":reload"
463 modulesLoadedMsg ok mods = do
465 | null mods = text "none."
467 punctuate comma (map text mods)) <> text "."
470 io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
472 io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
475 typeOfExpr :: String -> GHCi ()
477 = do st <- getGHCiState
478 dflags <- io getDynFlags
479 (new_cmstate, maybe_tystr) <- io (cmTypeOfExpr (cmstate st) dflags str)
480 setGHCiState st{cmstate = new_cmstate}
483 Just tystr -> io (putStrLn tystr)
485 quit :: String -> GHCi Bool
488 shellEscape :: String -> GHCi Bool
489 shellEscape str = io (system str >> return False)
491 ----------------------------------------------------------------------------
494 -- set options in the interpreter. Syntax is exactly the same as the
495 -- ghc command line, except that certain options aren't available (-C,
498 -- This is pretty fragile: most options won't work as expected. ToDo:
499 -- figure out which ones & disallow them.
501 setOptions :: String -> GHCi ()
503 = do st <- getGHCiState
504 let opts = options st
505 io $ putStrLn (showSDoc (
506 text "options currently set: " <>
509 else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
512 = do -- first, deal with the GHCi opts (+s, +t, etc.)
513 let (plus_opts, minus_opts) = partition isPlus (words str)
514 mapM setOpt plus_opts
516 -- now, the GHC flags
517 pkgs_before <- io (readIORef v_Packages)
518 leftovers <- io (processArgs static_flags minus_opts [])
519 pkgs_after <- io (readIORef v_Packages)
521 -- update things if the users wants more packages
522 when (pkgs_before /= pkgs_after) $
523 newPackages (pkgs_after \\ pkgs_before)
525 -- then, dynamic flags
528 leftovers <- processArgs dynamic_flags leftovers []
531 if (not (null leftovers))
532 then throwDyn (CmdLineError ("unrecognised flags: " ++
537 unsetOptions :: String -> GHCi ()
539 = do -- first, deal with the GHCi opts (+s, +t, etc.)
541 (minus_opts, rest1) = partition isMinus opts
542 (plus_opts, rest2) = partition isPlus rest1
544 if (not (null rest2))
545 then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
548 mapM unsetOpt plus_opts
550 -- can't do GHC flags for now
551 if (not (null minus_opts))
552 then throwDyn (CmdLineError "can't unset GHC command-line flags")
555 isMinus ('-':s) = True
558 isPlus ('+':s) = True
562 = case strToGHCiOpt str of
563 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
564 Just o -> setOption o
567 = case strToGHCiOpt str of
568 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
569 Just o -> unsetOption o
571 strToGHCiOpt :: String -> (Maybe GHCiOption)
572 strToGHCiOpt "s" = Just ShowTiming
573 strToGHCiOpt "t" = Just ShowType
574 strToGHCiOpt "r" = Just RevertCAFs
575 strToGHCiOpt _ = Nothing
577 optToStr :: GHCiOption -> String
578 optToStr ShowTiming = "s"
579 optToStr ShowType = "t"
580 optToStr RevertCAFs = "r"
582 newPackages new_pkgs = do
583 state <- getGHCiState
584 dflags <- io getDynFlags
585 cmstate1 <- io (cmUnload (cmstate state) dflags)
586 setGHCiState state{ cmstate = cmstate1, targets = [] }
589 pkgs <- getPackageInfo
590 flushPackageCache pkgs
592 new_pkg_info <- getPackageDetails new_pkgs
593 mapM_ (linkPackage False) (reverse new_pkg_info)
595 -----------------------------------------------------------------------------
598 data GHCiState = GHCiState
600 targets :: [FilePath],
602 options :: [GHCiOption]
606 = ShowTiming -- show time/allocs after evaluation
607 | ShowType -- show the type of expressions
608 | RevertCAFs -- revert CAFs after every evaluation
611 GLOBAL_VAR(flush_stdout, error "no flush_stdout", IO ())
612 GLOBAL_VAR(flush_stderr, error "no flush_stdout", IO ())
614 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
616 startGHCi :: GHCi a -> GHCiState -> IO a
617 startGHCi g state = do ref <- newIORef state; unGHCi g ref
619 instance Monad GHCi where
620 (GHCi m) >>= k = GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
621 return a = GHCi $ \s -> return a
623 getGHCiState = GHCi $ \r -> readIORef r
624 setGHCiState s = GHCi $ \r -> writeIORef r s
626 isOptionSet :: GHCiOption -> GHCi Bool
628 = do st <- getGHCiState
629 return (opt `elem` options st)
631 setOption :: GHCiOption -> GHCi ()
633 = do st <- getGHCiState
634 setGHCiState (st{ options = opt : filter (/= opt) (options st) })
636 unsetOption :: GHCiOption -> GHCi ()
638 = do st <- getGHCiState
639 setGHCiState (st{ options = filter (/= opt) (options st) })
641 io m = GHCi $ \s -> m >>= \a -> return a
643 -----------------------------------------------------------------------------
644 -- recursive exception handlers
646 -- Don't forget to unblock async exceptions in the handler, or if we're
647 -- in an exception loop (eg. let a = error a in a) the ^C exception
648 -- may never be delivered. Thanks to Marcin for pointing out the bug.
650 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
651 ghciHandle h (GHCi m) = GHCi $ \s ->
652 Exception.catch (m s)
653 (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
655 ghciUnblock :: GHCi a -> GHCi a
656 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
658 -----------------------------------------------------------------------------
661 -- Left: full path name of a .o file, including trailing .o
662 -- Right: "unadorned" name of a .DLL/.so
663 -- e.g. On unix "qt" denotes "libqt.so"
664 -- On WinDoze "burble" denotes "burble.DLL"
665 -- addDLL is platform-specific and adds the lib/.so/.DLL
666 -- suffixes platform-dependently; we don't do that here.
668 -- For dynamic objects only, try to find the object file in all the
669 -- directories specified in v_Library_Paths before giving up.
672 = Either FilePath String
674 showLS (Left nm) = "(static) " ++ nm
675 showLS (Right nm) = "(dynamic) " ++ nm
677 linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
678 linkPackages cmdline_lib_specs pkgs
679 = do sequence_ [ linkPackage (name p `elem` loaded) p | p <- reverse pkgs ]
680 lib_paths <- readIORef v_Library_paths
681 mapM_ (preloadLib lib_paths) cmdline_lib_specs
683 -- Packages that are already linked into GHCi. For mingw32, we only
684 -- skip gmp and rts, since std and after need to load the msvcrt.dll
685 -- library which std depends on.
687 # ifndef mingw32_TARGET_OS
688 = [ "gmp", "rts", "std", "concurrent", "posix", "text", "util" ]
693 preloadLib :: [String] -> LibrarySpec -> IO ()
694 preloadLib lib_paths lib_spec
695 = do putStr ("Loading object " ++ showLS lib_spec ++ " ... ")
698 -> do b <- preload_static lib_paths static_ish
699 putStrLn (if b then "done" else "not found")
701 -> -- We add "" to the set of paths to try, so that
702 -- if none of the real paths match, we force addDLL
703 -- to look in the default dynamic-link search paths.
704 do b <- preload_dynamic (lib_paths++[""]) dll_unadorned
705 when (not b) (cantFind lib_paths lib_spec)
708 cantFind :: [String] -> LibrarySpec -> IO ()
710 = do putStr ("failed.\nCan't find " ++ showLS spec
711 ++ " in directories:\n"
712 ++ unlines (map (" "++) paths) )
715 -- not interested in the paths in the static case.
716 preload_static paths name
717 = do b <- doesFileExist name
718 if not b then return False
719 else loadObj name >> return True
721 preload_dynamic [] name
723 preload_dynamic (path:paths) rootname
724 = do maybe_errmsg <- addDLL path rootname
725 if maybe_errmsg /= nullPtr
726 then preload_dynamic paths rootname
730 = (throwDyn . CmdLineError)
731 "user specified .o/.so/.DLL could not be loaded."
734 linkPackage :: Bool -> PackageConfig -> IO ()
735 -- ignore rts and gmp for now (ToDo; better?)
736 linkPackage loaded_in_ghci pkg
737 | name pkg `elem` ["rts", "gmp"]
740 = do putStr ("Loading package " ++ name pkg ++ " ... ")
741 -- For each obj, try obj.o and if that fails, obj.so.
742 -- Complication: all the .so's must be loaded before any of the .o's.
743 let dirs = library_dirs pkg
744 let objs = hs_libraries pkg ++ extra_libraries pkg
745 classifieds <- mapM (locateOneObj dirs) objs
747 -- Don't load the .so libs if this is a package GHCi is already
748 -- linked against, because we'll already have the .so linked in.
749 let (so_libs, obj_libs) = partition isRight classifieds
750 let sos_first | loaded_in_ghci = obj_libs
751 | otherwise = so_libs ++ obj_libs
753 mapM loadClassified sos_first
754 putStr "linking ... "
758 isRight (Right _) = True
759 isRight (Left _) = False
761 loadClassified :: LibrarySpec -> IO ()
762 loadClassified (Left obj_absolute_filename)
763 = do loadObj obj_absolute_filename
764 loadClassified (Right dll_unadorned)
765 = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
766 if maybe_errmsg == nullPtr
768 else do str <- peekCString maybe_errmsg
769 throwDyn (CmdLineError ("can't load .so/.DLL for: "
770 ++ dll_unadorned ++ " (" ++ str ++ ")" ))
772 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
774 = return (Right obj) -- we assume
775 locateOneObj (d:ds) obj
776 = do let path = d ++ '/':obj ++ ".o"
777 b <- doesFileExist path
778 if b then return (Left path) else locateOneObj ds obj
780 -----------------------------------------------------------------------------
781 -- timing & statistics
783 timeIt :: GHCi a -> GHCi a
785 = do b <- isOptionSet ShowTiming
788 else do allocs1 <- io $ getAllocations
789 time1 <- io $ getCPUTime
791 allocs2 <- io $ getAllocations
792 time2 <- io $ getCPUTime
793 io $ printTimes (allocs2 - allocs1) (time2 - time1)
796 foreign import "getAllocations" getAllocations :: IO Int
798 printTimes :: Int -> Integer -> IO ()
799 printTimes allocs psecs
800 = do let secs = (fromIntegral psecs / (10^12)) :: Float
801 secs_str = showFFloat (Just 2) secs
803 parens (text (secs_str "") <+> text "secs" <> comma <+>
804 int allocs <+> text "bytes")))
806 -----------------------------------------------------------------------------
809 foreign import revertCAFs :: IO () -- make it "safe", just in case