Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
curry-libs
Commits
12314598
Commit
12314598
authored
Jan 04, 2019
by
Michael Hanus
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Profile removed (now in package profiling)
parent
3c76cb3a
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
0 additions
and
231 deletions
+0
-231
Profile.curry
Profile.curry
+0
-151
Profile.kics2
Profile.kics2
+0
-52
Profile.pakcs
Profile.pakcs
+0
-28
No files found.
Profile.curry
deleted
100644 → 0
View file @
3c76cb3a
------------------------------------------------------------------------------
--- 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
Profile.kics2
deleted
100644 → 0
View file @
3c76cb3a
{-# 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
Profile.pakcs
deleted
100644 → 0
View file @
3c76cb3a
<?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>
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment