1 -----------------------------------------------------------------------------
2 -- $Id: InteractiveUI.hs,v 1.74 2001/06/14 12:50:06 simonpj 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"
23 import Finder ( flushPackageCache )
27 import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
28 import Panic ( GhcException(..) )
31 #ifndef mingw32_TARGET_OS
37 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
51 import PrelGHC ( unsafeCoerce# )
52 import Foreign ( nullPtr )
53 import CString ( peekCString )
55 -----------------------------------------------------------------------------
59 \ / _ \\ /\\ /\\/ __(_)\n\
60 \ / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n\
61 \/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n\
62 \\\____/\\/ /_/\\____/|_| Type :? for help.\n"
64 GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
66 builtin_commands :: [(String, String -> GHCi Bool)]
68 ("add", keepGoing addModule),
69 ("cd", keepGoing changeDirectory),
70 ("def", keepGoing defineMacro),
71 ("help", keepGoing help),
72 ("?", keepGoing help),
73 ("load", keepGoing loadModule),
74 ("module", keepGoing setContext),
75 ("reload", keepGoing reloadModule),
76 ("set", keepGoing setOptions),
77 ("type", keepGoing typeOfExpr),
78 ("unset", keepGoing unsetOptions),
79 ("undef", keepGoing undefineMacro),
83 keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
84 keepGoing a str = a str >> return False
86 shortHelpText = "use :? for help.\n"
89 \ Commands available from the prompt:\n\
91 \ <stmt> evaluate/run <stmt>\n\
92 \ :cd <dir> change directory to <dir>\n\
93 \ :def <cmd> <expr> define a command :<cmd>\n\
94 \ :help, :? display this list of commands\n\
95 \ :load <filename> load a module (and its dependents)\n\
96 \ :module <mod> set the context for expression evaluation to <mod>\n\
97 \ :reload reload the current module set\n\
98 \ :set <option> ... set options\n\
99 \ :undef <cmd> undefine user-defined command :<cmd>\n\
100 \ :type <expr> show the type of <expr>\n\
101 \ :unset <option> ... unset options\n\
103 \ :!<command> run the shell command <command>\n\
105 \ Options for `:set' and `:unset':\n\
107 \ +r revert top-level expressions after each evaluation\n\
108 \ +s print timing/memory stats after each evaluation\n\
109 \ +t print type after evaluation\n\
110 \ -<flags> most GHC command line flags can also be set here\n\
111 \ (eg. -v2, -fglasgow-exts, etc.)\n\
113 --ToDo :add <filename> add a module to the current set\n\
115 interactiveUI :: CmState -> Maybe FilePath -> [LibrarySpec] -> IO ()
116 interactiveUI cmstate mod cmdline_libs = do
118 hSetBuffering stdout NoBuffering
120 -- link in the available packages
121 pkgs <- getPackageInfo
123 linkPackages cmdline_libs pkgs
125 (cmstate, ok, mods) <-
127 Nothing -> return (cmstate, True, [])
128 Just m -> cmLoadModule cmstate m
130 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
134 dflags <- getDynFlags
136 (cmstate, maybe_hval)
137 <- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stderr"
139 Just hval -> writeIORef flush_stderr (unsafeCoerce# hval :: IO ())
140 _ -> panic "interactiveUI:stderr"
142 (cmstate, maybe_hval)
143 <- cmCompileExpr cmstate dflags "IO.hFlush PrelHandle.stdout"
145 Just hval -> writeIORef flush_stdout (unsafeCoerce# hval :: IO ())
146 _ -> panic "interactiveUI:stdout"
148 startGHCi runGHCi GHCiState{ target = mod,
158 exists <- io (doesFileExist file)
160 dir_ok <- io (checkPerms ".")
161 file_ok <- io (checkPerms file)
162 when (dir_ok && file_ok) $ do
163 either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
166 Right hdl -> fileLoop hdl False
168 -- Read in $HOME/.ghci
169 either_dir <- io (IO.try (getEnv "HOME"))
173 cwd <- io (getCurrentDirectory)
174 when (dir /= cwd) $ do
175 let file = dir ++ "/.ghci"
176 ok <- io (checkPerms file)
177 either_hdl <- io (IO.try (openFile file ReadMode))
180 Right hdl -> fileLoop hdl False
182 -- read commands from stdin
183 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
190 io $ do putStrLn "Leaving GHCi."
193 -- NOTE: We only read .ghci files if they are owned by the current user,
194 -- and aren't world writable. Otherwise, we could be accidentally
195 -- running code planted by a malicious third party.
197 -- Furthermore, We only read ./.ghci if both . and ./.ghci are
198 -- owned by the current user and aren't writable by anyone else. I
199 -- think this is sufficient: we don't need to check .. and
200 -- ../.. etc. because "." always refers to the same directory while a
201 -- process is running.
203 checkPerms :: String -> IO Bool
205 handle (\_ -> return False) $ do
206 #ifdef mingw32_TARGET_OS
209 st <- getFileStatus name
211 if fileOwner st /= me then do
212 putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
215 let mode = fileMode st
216 if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
217 || (otherWriteMode == (mode `intersectFileModes` otherWriteMode))
219 putStrLn $ "*** WARNING: " ++ name ++
220 " is writable by someone else, IGNORING!"
225 fileLoop :: Handle -> Bool -> GHCi ()
226 fileLoop hdl prompt = do
228 mod <- io (cmGetContext (cmstate st))
229 when prompt (io (putStr (mod ++ "> ")))
230 l <- io (IO.try (hGetLine hdl))
232 Left e | isEOFError e -> return ()
233 | otherwise -> throw e
235 case remove_spaces l of
236 "" -> fileLoop hdl prompt
237 l -> do quit <- runCommand l
238 if quit then return () else fileLoop hdl prompt
240 stringLoop :: [String] -> GHCi ()
241 stringLoop [] = return ()
242 stringLoop (s:ss) = do
244 case remove_spaces s of
246 l -> do quit <- runCommand l
247 if quit then return () else stringLoop ss
249 #if HAVE_READLINE_HEADERS && HAVE_READLINE_LIBS
250 readlineLoop :: GHCi ()
253 mod <- io (cmGetContext (cmstate st))
254 l <- io (readline (mod ++ "> "))
258 case remove_spaces l of
263 if quit then return () else readlineLoop
266 -- Top level exception handler, just prints out the exception
268 runCommand :: String -> GHCi Bool
270 ghciHandle ( \exception ->
273 case fromDynamic dyn of
274 Nothing -> io (putStrLn ("*** Exception: (unknown)"))
277 PhaseFailed phase code ->
278 io ( putStrLn ("Phase " ++ phase ++ " failed (code "
279 ++ show code ++ ")"))
280 Interrupted -> io (putStrLn "Interrupted.")
281 -- omit the location for CmdLineError
282 CmdLineError s -> io (putStrLn s)
283 other -> io (putStrLn (show (ghc_ex :: GhcException)))
285 other -> io (putStrLn ("*** Exception: " ++ show exception))
292 doCommand (':' : command) = specialCommand command
294 = do timeIt (do stuff <- runStmt stmt; finishEvalExpr stuff)
297 -- Returns True if the expr was successfully parsed, renamed and
299 runStmt :: String -> GHCi (Maybe [Name])
301 | null (filter (not.isSpace) stmt)
304 = do st <- getGHCiState
305 dflags <- io getDynFlags
306 let dflags' = dopt_unset dflags Opt_WarnUnusedBinds
307 (new_cmstate, names) <- io (cmRunStmt (cmstate st) dflags' stmt)
308 setGHCiState st{cmstate = new_cmstate}
311 -- possibly print the type and revert CAFs after evaluating an expression
312 finishEvalExpr Nothing = return False
313 finishEvalExpr (Just names)
314 = do b <- isOptionSet ShowType
316 when b (mapM_ (showTypeOfName (cmstate st)) names)
318 b <- isOptionSet RevertCAFs
319 io (when b revertCAFs)
323 showTypeOfName :: CmState -> Name -> GHCi ()
324 showTypeOfName cmstate n
325 = do maybe_str <- io (cmTypeOfName cmstate n)
328 Just str -> io (putStrLn (showSDoc (ppr n) ++ " :: " ++ str))
330 flushEverything :: GHCi ()
332 = io $ do flush_so <- readIORef flush_stdout
334 flush_se <- readIORef flush_stdout
338 specialCommand :: String -> GHCi Bool
339 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
340 specialCommand str = do
341 let (cmd,rest) = break isSpace str
342 cmds <- io (readIORef commands)
343 case [ (s,f) | (s,f) <- cmds, prefixMatch cmd s ] of
344 [] -> io (hPutStr stdout ("unknown command `:" ++ cmd ++ "'\n"
345 ++ shortHelpText) >> return False)
346 [(_,f)] -> f (dropWhile isSpace rest)
347 cs -> io (hPutStrLn stdout ("prefix " ++ cmd ++
348 " matches multiple commands (" ++
349 foldr1 (\a b -> a ++ ',':b) (map fst cs)
350 ++ ")") >> return False)
352 noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
354 -----------------------------------------------------------------------------
357 help :: String -> GHCi ()
358 help _ = io (putStr helpText)
360 addModule :: String -> GHCi ()
361 addModule _ = throwDyn (InstallationError ":add not implemented")
363 setContext :: String -> GHCi ()
365 = throwDyn (CmdLineError "syntax: `:m <module>'")
366 setContext m | not (isUpper (head m)) || not (all isAlphaNumEx (tail m))
367 = throwDyn (CmdLineError ("strange looking module name: `" ++ m ++ "'"))
369 isAlphaNumEx c = isAlphaNum c || c == '_'
371 = do st <- getGHCiState
372 new_cmstate <- io (cmSetContext (cmstate st) str)
373 setGHCiState st{cmstate=new_cmstate}
375 changeDirectory :: String -> GHCi ()
376 changeDirectory ('~':d) = do
377 tilde <- io (getEnv "HOME") -- will fail if HOME not defined
378 io (setCurrentDirectory (tilde ++ '/':d))
379 changeDirectory d = io (setCurrentDirectory d)
381 defineMacro :: String -> GHCi ()
383 let (macro_name, definition) = break isSpace s
384 cmds <- io (readIORef commands)
386 then throwDyn (CmdLineError "invalid macro name")
388 if (macro_name `elem` map fst cmds)
389 then throwDyn (CmdLineError
390 ("command `" ++ macro_name ++ "' is already defined"))
393 -- give the expression a type signature, so we can be sure we're getting
394 -- something of the right type.
395 let new_expr = '(' : definition ++ ") :: String -> IO String"
397 -- compile the expression
399 dflags <- io getDynFlags
400 (new_cmstate, maybe_hv) <- io (cmCompileExpr (cmstate st) dflags new_expr)
401 setGHCiState st{cmstate = new_cmstate}
404 Just hv -> io (writeIORef commands --
405 ((macro_name, keepGoing (runMacro hv)) : cmds))
407 runMacro :: HValue{-String -> IO String-} -> String -> GHCi ()
409 str <- io ((unsafeCoerce# fun :: String -> IO String) s)
410 stringLoop (lines str)
412 undefineMacro :: String -> GHCi ()
413 undefineMacro macro_name = do
414 cmds <- io (readIORef commands)
415 if (macro_name `elem` map fst builtin_commands)
416 then throwDyn (CmdLineError
417 ("command `" ++ macro_name ++ "' cannot be undefined"))
419 if (macro_name `notElem` map fst cmds)
420 then throwDyn (CmdLineError
421 ("command `" ++ macro_name ++ "' not defined"))
423 io (writeIORef commands (filter ((/= macro_name) . fst) cmds))
425 loadModule :: String -> GHCi ()
426 loadModule path = timeIt (loadModule' path)
428 loadModule' path = do
429 state <- getGHCiState
430 dflags <- io getDynFlags
431 cmstate1 <- io (cmUnload (cmstate state) dflags)
432 setGHCiState state{ cmstate = cmstate1, target = Nothing }
433 io (revertCAFs) -- always revert CAFs on load.
434 (cmstate2, ok, mods) <- io (cmLoadModule cmstate1 path)
435 setGHCiState state{ cmstate = cmstate2, target = Just path }
436 modulesLoadedMsg ok mods
438 reloadModule :: String -> GHCi ()
440 state <- getGHCiState
442 Nothing -> io (putStr "no current target\n")
444 -> do io (revertCAFs) -- always revert CAFs on reload.
445 (new_cmstate, ok, mods) <- io (cmLoadModule (cmstate state) path)
446 setGHCiState state{ cmstate=new_cmstate }
447 modulesLoadedMsg ok mods
449 reloadModule _ = noArgs ":reload"
452 modulesLoadedMsg ok mods = do
454 | null mods = text "none."
456 punctuate comma (map text mods)) <> text "."
459 io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
461 io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
464 typeOfExpr :: String -> GHCi ()
466 = do st <- getGHCiState
467 dflags <- io getDynFlags
468 (new_cmstate, maybe_tystr) <- io (cmTypeOfExpr (cmstate st) dflags str)
469 setGHCiState st{cmstate = new_cmstate}
472 Just tystr -> io (putStrLn tystr)
474 quit :: String -> GHCi Bool
477 shellEscape :: String -> GHCi Bool
478 shellEscape str = io (system str >> return False)
480 ----------------------------------------------------------------------------
483 -- set options in the interpreter. Syntax is exactly the same as the
484 -- ghc command line, except that certain options aren't available (-C,
487 -- This is pretty fragile: most options won't work as expected. ToDo:
488 -- figure out which ones & disallow them.
490 setOptions :: String -> GHCi ()
492 = do st <- getGHCiState
493 let opts = options st
494 io $ putStrLn (showSDoc (
495 text "options currently set: " <>
498 else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
501 = do -- first, deal with the GHCi opts (+s, +t, etc.)
502 let (plus_opts, minus_opts) = partition isPlus (words str)
503 mapM setOpt plus_opts
505 -- now, the GHC flags
506 pkgs_before <- io (readIORef v_Packages)
507 leftovers <- io (processArgs static_flags minus_opts [])
508 pkgs_after <- io (readIORef v_Packages)
510 -- update things if the users wants more packages
511 when (pkgs_before /= pkgs_after) $
512 newPackages (pkgs_after \\ pkgs_before)
514 -- then, dynamic flags
517 leftovers <- processArgs dynamic_flags leftovers []
520 if (not (null leftovers))
521 then throwDyn (CmdLineError ("unrecognised flags: " ++
526 unsetOptions :: String -> GHCi ()
528 = do -- first, deal with the GHCi opts (+s, +t, etc.)
530 (minus_opts, rest1) = partition isMinus opts
531 (plus_opts, rest2) = partition isPlus rest1
533 if (not (null rest2))
534 then io (putStrLn ("unknown option: `" ++ head rest2 ++ "'"))
537 mapM unsetOpt plus_opts
539 -- can't do GHC flags for now
540 if (not (null minus_opts))
541 then throwDyn (CmdLineError "can't unset GHC command-line flags")
544 isMinus ('-':s) = True
547 isPlus ('+':s) = True
551 = case strToGHCiOpt str of
552 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
553 Just o -> setOption o
556 = case strToGHCiOpt str of
557 Nothing -> io (putStrLn ("unknown option: `" ++ str ++ "'"))
558 Just o -> unsetOption o
560 strToGHCiOpt :: String -> (Maybe GHCiOption)
561 strToGHCiOpt "s" = Just ShowTiming
562 strToGHCiOpt "t" = Just ShowType
563 strToGHCiOpt "r" = Just RevertCAFs
564 strToGHCiOpt _ = Nothing
566 optToStr :: GHCiOption -> String
567 optToStr ShowTiming = "s"
568 optToStr ShowType = "t"
569 optToStr RevertCAFs = "r"
571 newPackages new_pkgs = do
572 state <- getGHCiState
573 dflags <- io getDynFlags
574 cmstate1 <- io (cmUnload (cmstate state) dflags)
575 setGHCiState state{ cmstate = cmstate1, target = Nothing }
578 pkgs <- getPackageInfo
579 flushPackageCache pkgs
581 new_pkg_info <- getPackageDetails new_pkgs
582 mapM_ (linkPackage False) (reverse new_pkg_info)
584 -----------------------------------------------------------------------------
587 data GHCiState = GHCiState
589 target :: Maybe FilePath,
591 options :: [GHCiOption]
595 = ShowTiming -- show time/allocs after evaluation
596 | ShowType -- show the type of expressions
597 | RevertCAFs -- revert CAFs after every evaluation
600 GLOBAL_VAR(flush_stdout, error "no flush_stdout", IO ())
601 GLOBAL_VAR(flush_stderr, error "no flush_stdout", IO ())
603 newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
605 startGHCi :: GHCi a -> GHCiState -> IO a
606 startGHCi g state = do ref <- newIORef state; unGHCi g ref
608 instance Monad GHCi where
609 (GHCi m) >>= k = GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
610 return a = GHCi $ \s -> return a
612 getGHCiState = GHCi $ \r -> readIORef r
613 setGHCiState s = GHCi $ \r -> writeIORef r s
615 isOptionSet :: GHCiOption -> GHCi Bool
617 = do st <- getGHCiState
618 return (opt `elem` options st)
620 setOption :: GHCiOption -> GHCi ()
622 = do st <- getGHCiState
623 setGHCiState (st{ options = opt : filter (/= opt) (options st) })
625 unsetOption :: GHCiOption -> GHCi ()
627 = do st <- getGHCiState
628 setGHCiState (st{ options = filter (/= opt) (options st) })
630 io m = GHCi $ \s -> m >>= \a -> return a
632 -----------------------------------------------------------------------------
633 -- recursive exception handlers
635 -- Don't forget to unblock async exceptions in the handler, or if we're
636 -- in an exception loop (eg. let a = error a in a) the ^C exception
637 -- may never be delivered. Thanks to Marcin for pointing out the bug.
639 ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
640 ghciHandle h (GHCi m) = GHCi $ \s ->
641 Exception.catch (m s)
642 (\e -> unGHCi (ghciHandle h (ghciUnblock (h e))) s)
644 ghciUnblock :: GHCi a -> GHCi a
645 ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
647 -----------------------------------------------------------------------------
650 -- Left: full path name of a .o file, including trailing .o
651 -- Right: "unadorned" name of a .DLL/.so
652 -- e.g. On unix "qt" denotes "libqt.so"
653 -- On WinDoze "burble" denotes "burble.DLL"
654 -- addDLL is platform-specific and adds the lib/.so/.DLL
655 -- suffixes platform-dependently; we don't do that here.
657 -- For dynamic objects only, try to find the object file in all the
658 -- directories specified in v_Library_Paths before giving up.
661 = Either FilePath String
663 showLS (Left nm) = "(static) " ++ nm
664 showLS (Right nm) = "(dynamic) " ++ nm
666 linkPackages :: [LibrarySpec] -> [PackageConfig] -> IO ()
667 linkPackages cmdline_lib_specs pkgs
668 = do sequence_ [ linkPackage (name p `elem` loaded) p | p <- reverse pkgs ]
669 lib_paths <- readIORef v_Library_paths
670 mapM_ (preloadLib lib_paths) cmdline_lib_specs
672 -- packages that are already linked into GHCi
673 loaded = [ "concurrent", "posix", "text", "util" ]
675 preloadLib :: [String] -> LibrarySpec -> IO ()
676 preloadLib lib_paths lib_spec
677 = do putStr ("Loading object " ++ showLS lib_spec ++ " ... ")
680 -> do b <- preload_static lib_paths static_ish
681 putStrLn (if b then "done" else "not found")
683 -> -- We add "" to the set of paths to try, so that
684 -- if none of the real paths match, we force addDLL
685 -- to look in the default dynamic-link search paths.
686 do b <- preload_dynamic (lib_paths++[""]) dll_unadorned
687 when (not b) (cantFind lib_paths lib_spec)
690 cantFind :: [String] -> LibrarySpec -> IO ()
692 = do putStr ("failed.\nCan't find " ++ showLS spec
693 ++ " in directories:\n"
694 ++ unlines (map (" "++) paths) )
697 -- not interested in the paths in the static case.
698 preload_static paths name
699 = do b <- doesFileExist name
700 if not b then return False
701 else loadObj name >> return True
703 preload_dynamic [] name
705 preload_dynamic (path:paths) rootname
706 = do maybe_errmsg <- addDLL path rootname
707 if maybe_errmsg /= nullPtr
708 then preload_dynamic paths rootname
712 = (throwDyn . CmdLineError)
713 "user specified .o/.so/.DLL could not be loaded."
716 linkPackage :: Bool -> PackageConfig -> IO ()
717 -- ignore rts and gmp for now (ToDo; better?)
718 linkPackage loaded_in_ghci pkg
719 | name pkg `elem` ["rts", "gmp"]
722 = do putStr ("Loading package " ++ name pkg ++ " ... ")
723 -- For each obj, try obj.o and if that fails, obj.so.
724 -- Complication: all the .so's must be loaded before any of the .o's.
725 let dirs = library_dirs pkg
726 let objs = hs_libraries pkg ++ extra_libraries pkg
727 classifieds <- mapM (locateOneObj dirs) objs
729 -- Don't load the .so libs if this is a package GHCi is already
730 -- linked against, because we'll already have the .so linked in.
731 let (so_libs, obj_libs) = partition isRight classifieds
732 let sos_first | loaded_in_ghci = obj_libs
733 | otherwise = so_libs ++ obj_libs
735 mapM loadClassified sos_first
736 putStr "linking ... "
740 isRight (Right _) = True
741 isRight (Left _) = False
743 loadClassified :: LibrarySpec -> IO ()
744 loadClassified (Left obj_absolute_filename)
745 = do loadObj obj_absolute_filename
746 loadClassified (Right dll_unadorned)
747 = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me
748 if maybe_errmsg == nullPtr
750 else do str <- peekCString maybe_errmsg
751 throwDyn (CmdLineError ("can't find .o or .so/.DLL for: "
752 ++ dll_unadorned ++ " (" ++ str ++ ")" ))
754 locateOneObj :: [FilePath] -> String -> IO LibrarySpec
756 = return (Right obj) -- we assume
757 locateOneObj (d:ds) obj
758 = do let path = d ++ '/':obj ++ ".o"
759 b <- doesFileExist path
760 if b then return (Left path) else locateOneObj ds obj
762 -----------------------------------------------------------------------------
763 -- timing & statistics
765 timeIt :: GHCi a -> GHCi a
767 = do b <- isOptionSet ShowTiming
770 else do allocs1 <- io $ getAllocations
771 time1 <- io $ getCPUTime
773 allocs2 <- io $ getAllocations
774 time2 <- io $ getCPUTime
775 io $ printTimes (allocs2 - allocs1) (time2 - time1)
778 foreign import "getAllocations" getAllocations :: IO Int
780 printTimes :: Int -> Integer -> IO ()
781 printTimes allocs psecs
782 = do let secs = (fromIntegral psecs / (10^12)) :: Float
783 secs_str = showFFloat (Just 2) secs
785 parens (text (secs_str "") <+> text "secs" <> comma <+>
786 int allocs <+> text "bytes")))
788 -----------------------------------------------------------------------------
791 foreign import revertCAFs :: IO () -- make it "safe", just in case