1 -----------------------------------------------------------------------------
2 -- $Id: InteractiveUI.hs,v 1.76 2001/06/15 11:40:29 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 \ :cd <dir> change directory to <dir>\n\
94 \ :def <cmd> <expr> define a command :<cmd>\n\
95 \ :help, :? display this list of commands\n\
96 \ :load <filename> load a module (and its dependents)\n\
97 \ :module <mod> set the context for expression evaluation to <mod>\n\
98 \ :reload reload the current module set\n\
99 \ :set <option> ... set options\n\
100 \ :undef <cmd> undefine user-defined command :<cmd>\n\
101 \ :type <expr> show the type of <expr>\n\
102 \ :unset <option> ... unset options\n\
104 \ :!<command> run the shell command <command>\n\
106 \ Options for `:set' and `:unset':\n\
108 \ +r revert top-level expressions after each evaluation\n\
109 \ +s print timing/memory stats after each evaluation\n\
110 \ +t print type after evaluation\n\
111 \ -<flags> most GHC command line flags can also be set here\n\
112 \ (eg. -v2, -fglasgow-exts, etc.)\n\
114 --ToDo :add <filename> add a module to the current set\n\
116 interactiveUI :: CmState -> Maybe FilePath -> [LibrarySpec] -> IO ()
117 interactiveUI cmstate mod 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 Nothing -> return (cmstate, True, [])
129 Just m -> cmLoadModule cmstate m
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{ target = mod,
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 ()
363 addModule _ = throwDyn (InstallationError ":add not implemented")
365 setContext :: String -> GHCi ()
367 = throwDyn (CmdLineError "syntax: `:m <module>'")
368 setContext m | not (isUpper (head m)) || not (all isAlphaNumEx (tail m))
369 = throwDyn (CmdLineError ("strange looking module name: `" ++ m ++ "'"))
371 isAlphaNumEx c = isAlphaNum c || c == '_'
373 = do st <- getGHCiState
374 new_cmstate <- io (cmSetContext (cmstate st) str)
375 setGHCiState st{cmstate=new_cmstate}
377 changeDirectory :: String -> GHCi ()
378 changeDirectory ('~':d) = do
379 tilde <- io (getEnv "HOME") -- will fail if HOME not defined
380 io (setCurrentDirectory (tilde ++ '/':d))
381 changeDirectory d = io (setCurrentDirectory d)
383 defineMacro :: String -> GHCi ()
385 let (macro_name, definition) = break isSpace s
386 cmds <- io (readIORef commands)
388 then throwDyn (CmdLineError "invalid macro name")
390 if (macro_name `elem` map fst cmds)
391 then throwDyn (CmdLineError
392 ("command `" ++ macro_name ++ "' is already defined"))
395 -- give the expression a type signature, so we can be sure we're getting
396 -- something of the right type.
397 let new_expr = '(' : definition ++ ") :: String -> IO String"
399 -- compile the expression
401 dflags <- io getDynFlags
402 (new_cmstate, maybe_hv) <- io (cmCompileExpr (cmstate st) dflags new_expr)
403 setGHCiState st{cmstate = new_cmstate}
406 Just hv -> io (writeIORef commands --
407 ((macro_name, keepGoing (runMacro hv)) : cmds))
409 runMacro :: HValue{-String -> IO String-} -> String -> GHCi ()
411 str <- io ((unsafeCoerce# fun :: String -> IO String) s)
412 stringLoop (lines str)
414 undefineMacro :: String -> GHCi ()
415 undefineMacro macro_name = do
416 cmds <- io (readIORef commands)
417 if (macro_name `elem` map fst builtin_commands)
418 then throwDyn (CmdLineError
419 ("command `" ++ macro_name ++ "' cannot be undefined"))
421 if (macro_name `notElem` map fst cmds)
422 then throwDyn (CmdLineError
423 ("command `" ++ macro_name ++ "' not defined"))
425 io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
427 loadModule :: String -> GHCi ()
428 loadModule path = timeIt (loadModule' path)
430 loadModule' path = do
431 state <- getGHCiState
432 dflags <- io getDynFlags
433 cmstate1 <- io (cmUnload (cmstate state) dflags)
434 setGHCiState state{ cmstate = cmstate1, target = Nothing }
435 io (revertCAFs) -- always revert CAFs on load.
436 (cmstate2, ok, mods) <- io (cmLoadModule cmstate1 path)
437 setGHCiState state{ cmstate = cmstate2, target = Just path }
438 modulesLoadedMsg ok mods
440 reloadModule :: String -> GHCi ()
442 state <- getGHCiState
444 Nothing -> io (putStr "no current target\n")
446 -> do io (revertCAFs) -- always revert CAFs on reload.
447 (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
448 setGHCiState state{ cmstate=new_cmstate }
449 modulesLoadedMsg ok mods
451 reloadModule _ = noArgs ":reload"
454 modulesLoadedMsg ok mods = do
456 | null mods = text "none."
458 punctuate comma (map text mods)) <> text "."
461 io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
463 io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
466 typeOfExpr :: String -> GHCi ()
468 = do st <- getGHCiState
469 dflags <- io getDynFlags
470 (new_cmstate, maybe_tystr) <- io (cmTypeOfExpr (cmstate st) dflags str)
471 setGHCiState st{cmstate = new_cmstate}
474 Just tystr -> io (putStrLn tystr)
476 quit :: String -> GHCi Bool
479 shellEscape :: String -> GHCi Bool
480 shellEscape str = io (system str >> return False)
482 ----------------------------------------------------------------------------
485 -- set options in the interpreter. Syntax is exactly the same as the
486 -- ghc command line, except that certain options aren't available (-C,
489 -- This is pretty fragile: most options won't work as expected. ToDo:
490 -- figure out which ones & disallow them.
492 setOptions :: String -> GHCi ()
494 = do st <- getGHCiState
495 let opts = options st
496 io $ putStrLn (showSDoc (
497 text "options currently set: " <>
500 else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
503 = do -- first, deal with the GHCi opts (+s, +t, etc.)
504 let (plus_opts, minus_opts) = partition isPlus (words str)
505 mapM setOpt plus_opts
507 -- now, the GHC flags
508 pkgs_before <- io (readIORef v_Packages)
509 leftovers <- io (processArgs static_flags minus_opts [])
510 pkgs_after <- io (readIORef v_Packages)
512 -- update things if the users wants more packages
513 when (pkgs_before /= pkgs_after) $
514 newPackages (pkgs_after \\ pkgs_before)
516 -- then, dynamic flags
519 leftovers <- processArgs dynamic_flags leftovers []
522 if (not (null leftovers))
523 then throwDyn (CmdLineError ("unrecognised flags: " ++
528 unsetOptions :: String -> GHCi ()
530 = do -- first, deal with the GHCi opts (+s, +t, etc.)
532 (minus_opts, rest1) = partition isMinus opts
533 (plus_opts, rest2) = partition isPlus rest1
535 if (not (null rest2))
536 then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
539 mapM unsetOpt plus_opts
541 -- can't do GHC flags for now
542 if (not (null minus_opts))
543 then throwDyn (CmdLineError "can't unset GHC command-line flags")
546 isMinus ('-':s) = True
549 isPlus ('+':s) = True
553 = case strToGHCiOpt str of
554 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
555 Just o -> setOption o
558 = case strToGHCiOpt str of
559 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
560 Just o -> unsetOption o
562 strToGHCiOpt :: String -> (Maybe GHCiOption)
563 strToGHCiOpt "s" = Just ShowTiming
564 strToGHCiOpt "t" = Just ShowType
565 strToGHCiOpt "r" = Just RevertCAFs
566 strToGHCiOpt _ = Nothing
568 optToStr :: GHCiOption -> String
569 optToStr ShowTiming = "s"
570 optToStr ShowType = "t"
571 optToStr RevertCAFs = "r"
573 newPackages new_pkgs = do
574 state <- getGHCiState
575 dflags <- io getDynFlags
576 cmstate1 <- io (cmUnload (cmstate state) dflags)
577 setGHCiState state{ cmstate = cmstate1, target = Nothing }
580 pkgs <- getPackageInfo
581 flushPackageCache pkgs
583 new_pkg_info <- getPackageDetails new_pkgs
584 mapM_ (linkPackage False) (reverse new_pkg_info)
586 -----------------------------------------------------------------------------
589 data GHCiState = GHCiState
591 target :: Maybe FilePath,
593 options :: [GHCiOption]
597 = ShowTiming -- show time/allocs after evaluation
598 | ShowType -- show the type of expressions
599 | RevertCAFs -- revert CAFs after every evaluation
602 GLOBAL_VAR(flush_stdout, error "no flush_stdout", IO ())
603 GLOBAL_VAR(flush_stderr, error "no flush_stdout", IO ())
605 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
607 startGHCi :: GHCi a -> GHCiState -> IO a
608 startGHCi g state = do ref <- newIORef state; unGHCi g ref
610 instance Monad GHCi where
611 (GHCi m) >>= k = GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
612 return a = GHCi $ \s -> return a
614 getGHCiState = GHCi $ \r -> readIORef r
615 setGHCiState s = GHCi $ \r -> writeIORef r s
617 isOptionSet :: GHCiOption -> GHCi Bool
619 = do st <- getGHCiState
620 return (opt `elem` options st)
622 setOption :: GHCiOption -> GHCi ()
624 = do st <- getGHCiState
625 setGHCiState (st{ options = opt : filter (/= opt) (options st) })
627 unsetOption :: GHCiOption -> GHCi ()
629 = do st <- getGHCiState
630 setGHCiState (st{ options = filter (/= opt) (options st) })
632 io m = GHCi $ \s -> m >>= \a -> return a
634 -----------------------------------------------------------------------------
635 -- recursive exception handlers
637 -- Don't forget to unblock async exceptions in the handler, or if we're
638 -- in an exception loop (eg. let a = error a in a) the ^C exception
639 -- may never be delivered. Thanks to Marcin for pointing out the bug.
641 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
642 ghciHandle h (GHCi m) = GHCi $ \s ->
643 Exception.catch (m s)
644 (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
646 ghciUnblock :: GHCi a -> GHCi a
647 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
649 -----------------------------------------------------------------------------
652 -- Left: full path name of a .o file, including trailing .o
653 -- Right: "unadorned" name of a .DLL/.so
654 -- e.g. On unix "qt" denotes "libqt.so"
655 -- On WinDoze "burble" denotes "burble.DLL"
656 -- addDLL is platform-specific and adds the lib/.so/.DLL
657 -- suffixes platform-dependently; we don't do that here.
659 -- For dynamic objects only, try to find the object file in all the
660 -- directories specified in v_Library_Paths before giving up.
663 = Either FilePath String
665 showLS (Left nm) = "(static) " ++ nm
666 showLS (Right nm) = "(dynamic) " ++ nm
668 linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
669 linkPackages cmdline_lib_specs pkgs
670 = do sequence_ [ linkPackage (name p `elem` loaded) p | p <- reverse pkgs ]
671 lib_paths <- readIORef v_Library_paths
672 mapM_ (preloadLib lib_paths) cmdline_lib_specs
674 -- packages that are already linked into GHCi
675 loaded = [ "concurrent", "posix", "text", "util" ]
677 preloadLib :: [String] -> LibrarySpec -> IO ()
678 preloadLib lib_paths lib_spec
679 = do putStr ("Loading object " ++ showLS lib_spec ++ " ... ")
682 -> do b <- preload_static lib_paths static_ish
683 putStrLn (if b then "done" else "not found")
685 -> -- We add "" to the set of paths to try, so that
686 -- if none of the real paths match, we force addDLL
687 -- to look in the default dynamic-link search paths.
688 do b <- preload_dynamic (lib_paths++[""]) dll_unadorned
689 when (not b) (cantFind lib_paths lib_spec)
692 cantFind :: [String] -> LibrarySpec -> IO ()
694 = do putStr ("failed.\nCan't find " ++ showLS spec
695 ++ " in directories:\n"
696 ++ unlines (map (" "++) paths) )
699 -- not interested in the paths in the static case.
700 preload_static paths name
701 = do b <- doesFileExist name
702 if not b then return False
703 else loadObj name >> return True
705 preload_dynamic [] name
707 preload_dynamic (path:paths) rootname
708 = do maybe_errmsg <- addDLL path rootname
709 if maybe_errmsg /= nullPtr
710 then preload_dynamic paths rootname
714 = (throwDyn . CmdLineError)
715 "user specified .o/.so/.DLL could not be loaded."
718 linkPackage :: Bool -> PackageConfig -> IO ()
719 -- ignore rts and gmp for now (ToDo; better?)
720 linkPackage loaded_in_ghci pkg
721 | name pkg `elem` ["rts", "gmp"]
724 = do putStr ("Loading package " ++ name pkg ++ " ... ")
725 -- For each obj, try obj.o and if that fails, obj.so.
726 -- Complication: all the .so's must be loaded before any of the .o's.
727 let dirs = library_dirs pkg
728 let objs = hs_libraries pkg ++ extra_libraries pkg
729 classifieds <- mapM (locateOneObj dirs) objs
731 -- Don't load the .so libs if this is a package GHCi is already
732 -- linked against, because we'll already have the .so linked in.
733 let (so_libs, obj_libs) = partition isRight classifieds
734 let sos_first | loaded_in_ghci = obj_libs
735 | otherwise = so_libs ++ obj_libs
737 mapM loadClassified sos_first
738 putStr "linking ... "
742 isRight (Right _) = True
743 isRight (Left _) = False
745 loadClassified :: LibrarySpec -> IO ()
746 loadClassified (Left obj_absolute_filename)
747 = do loadObj obj_absolute_filename
748 loadClassified (Right dll_unadorned)
749 = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
750 if maybe_errmsg == nullPtr
752 else do str <- peekCString maybe_errmsg
753 throwDyn (CmdLineError ("can't find .o or .so/.DLL for: "
754 ++ dll_unadorned ++ " (" ++ str ++ ")" ))
756 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
758 = return (Right obj) -- we assume
759 locateOneObj (d:ds) obj
760 = do let path = d ++ '/':obj ++ ".o"
761 b <- doesFileExist path
762 if b then return (Left path) else locateOneObj ds obj
764 -----------------------------------------------------------------------------
765 -- timing & statistics
767 timeIt :: GHCi a -> GHCi a
769 = do b <- isOptionSet ShowTiming
772 else do allocs1 <- io $ getAllocations
773 time1 <- io $ getCPUTime
775 allocs2 <- io $ getAllocations
776 time2 <- io $ getCPUTime
777 io $ printTimes (allocs2 - allocs1) (time2 - time1)
780 foreign import "getAllocations" getAllocations :: IO Int
782 printTimes :: Int -> Integer -> IO ()
783 printTimes allocs psecs
784 = do let secs = (fromIntegral psecs / (10^12)) :: Float
785 secs_str = showFFloat (Just 2) secs
787 parens (text (secs_str "") <+> text "secs" <> comma <+>
788 int allocs <+> text "bytes")))
790 -----------------------------------------------------------------------------
793 foreign import revertCAFs :: IO () -- make it "safe", just in case