Commit 5df0278b authored by Michael Hanus 's avatar Michael Hanus

Profile removed

parent 4c302e57
------------------------------------------------------------------------------
--- Preliminary library to support profiling.
---
--- @author Michael Hanus
--- @version November 2015
--- @category general
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Profile
( ProcessInfo(..), getProcessInfos, showMemInfo, printMemInfo
, garbageCollectorOff, garbageCollectorOn, garbageCollect
, profileTime, profileTimeNF, profileSpace, profileSpaceNF
#ifdef __PAKCS__
, evalTime, evalSpace
#endif
)
where
import List(intersperse)
--- The data type for representing information about the state
--- of a Curry process.
--- @cons RunTime - the run time in milliseconds
--- @cons ElapsedTime - the elapsed time in milliseconds
--- @cons Memory - the total memory in bytes
--- @cons Code - the size of the code area in bytes
--- @cons Stack - the size of the local stack for recursive functions in bytes
--- @cons Heap - the size of the heap to store term structures in bytes
--- @cons Choices - the size of the choicepoint stack
--- @cons GarbageCollections - the number of garbage collections performed
data ProcessInfo = RunTime | ElapsedTime | Memory | Code
| Stack | Heap | Choices | GarbageCollections
deriving Eq
--- Returns various informations about the current state of the Curry process.
--- Note that the returned values are implementation dependent
--- so that one should interpret them with care!
---
--- Note for KiCS2 users:
--- Since GHC version 7.x, one has to set the run-time option `-T`
--- when this operation is used. This can be done by the kics2 command
---
--- :set rts -T
---
getProcessInfos :: IO [(ProcessInfo,Int)]
getProcessInfos external
--- Turns off the garbage collector of the run-time system (if possible).
--- This could be useful to get more precise data of memory usage.
garbageCollectorOff :: IO ()
garbageCollectorOff external
--- Turns on the garbage collector of the run-time system (if possible).
garbageCollectorOn :: IO ()
garbageCollectorOn external
--- Invoke the garbage collector (if possible).
--- This could be useful before run-time critical operations.
garbageCollect :: IO ()
garbageCollect external
--- Get a human readable version of the memory situation from the
--- process infos.
showMemInfo :: [(ProcessInfo,Int)] -> String
showMemInfo infos = concat $ intersperse ", " $
formatItem Memory "Memory: " ++
formatItem Code "Code: " ++
formatItem Stack "Stack: " ++
formatItem Choices"Choices: " ++
formatItem Heap "Heap: "
where
formatItem i s = maybe [] (\v -> [s ++ showBytes v]) (lookup i infos)
showBytes b = if b<10000 then show b
else show (b `div` 1000) ++ " kb"
--- Print a human readable version of the current memory situation
--- of the Curry process.
printMemInfo :: IO ()
printMemInfo = getProcessInfos >>= putStrLn . showMemInfo
--- Print the time needed to execute a given IO action.
profileTime :: IO a -> IO a
profileTime action = do
garbageCollect
pi1 <- getProcessInfos
result <- action
pi2 <- getProcessInfos
putStrLn $ "Run time: "
++ (showInfoDiff pi1 pi2 RunTime) ++ " msec."
putStrLn $ "Elapsed time: "
++ (showInfoDiff pi1 pi2 ElapsedTime) ++ " msec."
putStrLn $ "Garbage collections: "
++ (showInfoDiff pi1 pi2 GarbageCollections)
return result
--- Evaluates the argument to normal form
--- and print the time needed for this evaluation.
profileTimeNF :: a -> IO ()
profileTimeNF exp = profileTime (seq (id $!! exp) done)
--- Print the time and space needed to execute a given IO action.
--- During the executation, the garbage collector is turned off to get the
--- total space usage.
profileSpace :: IO a -> IO a
profileSpace action = do
garbageCollect
garbageCollectorOff
pi1 <- getProcessInfos
result <- action
pi2 <- getProcessInfos
garbageCollectorOn
putStrLn $ "Run time: "
++ (showInfoDiff pi1 pi2 RunTime) ++ " msec."
putStrLn $ "Elapsed time: "
++ (showInfoDiff pi1 pi2 ElapsedTime) ++ " msec."
putStrLn $ "Garbage collections: "
++ (showInfoDiff pi1 pi2 GarbageCollections)
putStrLn $ "Heap usage: "
++ (showInfoDiff pi1 pi2 Heap) ++ " bytes"
putStrLn $ "Stack usage: "
++ (showInfoDiff pi1 pi2 Stack) ++ " bytes"
return result
--- Evaluates the argument to normal form
--- and print the time and space needed for this evaluation.
--- During the evaluation, the garbage collector is turned off to get the
--- total space usage.
profileSpaceNF :: a -> IO ()
profileSpaceNF exp = profileSpace (seq (id $!! exp) done)
showInfoDiff :: [(ProcessInfo, Int)] -> [(ProcessInfo, Int)] -> ProcessInfo
-> String
showInfoDiff infos1 infos2 item =
show (maybe 0 id (lookup item infos2) - maybe 0 id (lookup item infos1))
#ifdef __PAKCS__
--- Evaluates the argument to normal form (and return the normal form)
--- and print the time needed for this evaluation on standard error.
--- Included for backward compatibility only, use profileTime!
evalTime :: a -> a
evalTime external
--- Evaluates the argument to normal form (and return the normal form)
--- and print the time and space needed for this evaluation on standard error.
--- During the evaluation, the garbage collector is turned off.
--- Included for backward compatibility only, use profileSpace!
evalSpace :: a -> a
evalSpace external
#endif
{-# LANGUAGE CPP, MultiParamTypeClasses #-}
import System.CPUTime
import System.Mem (performGC)
#if __GLASGOW_HASKELL__ > 702
import GHC.Stats
#endif
-- #endimport - do not remove this line!
instance ConvertCurryHaskell C_ProcessInfo C_ProcessInfo where
toCurry = id
fromCurry = id
getProcessInfos :: IO [(C_ProcessInfo, Int)]
#if __GLASGOW_HASKELL__ > 802
getProcessInfos = do
stats <- getRTSStats
return [ (C_RunTime , fromIntegral (mutator_cpu_ns stats * 1000))
, (C_ElapsedTime , fromIntegral (mutator_elapsed_ns stats * 1000))
, (C_Heap , fromIntegral (max_live_bytes stats))
, (C_Memory , fromIntegral (max_live_bytes stats))
, (C_GarbageCollections, fromIntegral (gcs stats))
]
#elif __GLASGOW_HASKELL__ > 702
getProcessInfos = do
stats <- getGCStats
return [ (C_RunTime , floor (mutatorCpuSeconds stats * 1000))
, (C_ElapsedTime , floor (mutatorWallSeconds stats * 1000))
, (C_Heap , fromIntegral (maxBytesUsed stats))
, (C_Memory , fromIntegral (maxBytesUsed stats))
, (C_GarbageCollections, fromIntegral (numGcs stats))
]
#else
getProcessInfos = do
t <- getCPUTime
return [(C_RunTime, t `div` (10^9)]
#endif
external_d_C_getProcessInfos :: Cover -> ConstStore ->
Curry_Prelude.C_IO (Curry_Prelude.OP_List (Curry_Prelude.OP_Tuple2 C_ProcessInfo Curry_Prelude.C_Int))
external_d_C_getProcessInfos _ _ = toCurry getProcessInfos
external_d_C_garbageCollectorOff :: Cover -> ConstStore -> Curry_Prelude.C_IO Curry_Prelude.OP_Unit
external_d_C_garbageCollectorOff _ _ = toCurry (return () :: IO ()) -- not supported
external_d_C_garbageCollectorOn :: Cover -> ConstStore -> Curry_Prelude.C_IO Curry_Prelude.OP_Unit
external_d_C_garbageCollectorOn _ _ = toCurry (return () :: IO ()) -- not supported
external_d_C_garbageCollect :: Cover -> ConstStore -> Curry_Prelude.C_IO Curry_Prelude.OP_Unit
external_d_C_garbageCollect _ _ = toCurry performGC
<?xml version="1.0" standalone="no"?>
<!DOCTYPE primitives SYSTEM "http://www.informatik.uni-kiel.de/~pakcs/primitives.dtd">
<primitives>
<primitive name="getProcessInfos" arity="0">
<library>prim_profile</library>
<entry>prim_getProcessInfos</entry>
</primitive>
<primitive name="garbageCollectorOn" arity="0">
<library>prim_profile</library>
<entry>prim_garbageCollectorOn</entry>
</primitive>
<primitive name="garbageCollectorOff" arity="0">
<library>prim_profile</library>
<entry>prim_garbageCollectorOff</entry>
</primitive>
<primitive name="garbageCollect" arity="0">
<library>prim_profile</library>
<entry>prim_garbageCollect</entry>
</primitive>
<primitive name="evalTime" arity="1">
<library>prim_profile</library>
<entry>prim_evalTime[raw]</entry>
</primitive>
<primitive name="evalSpace" arity="1">
<library>prim_profile</library>
<entry>prim_evalSpace[raw]</entry>
</primitive>
</primitives>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment