1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

------------------------------------------------------------------------------
--- 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

  , evalTime, evalSpace

  )
 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))


--- 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