{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe            #-}

-- |
-- Module      :  RTS.Stats
-- Copyright   :  (c) The University of Glasgow, 1994-2000
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  ghc-devs@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC extensions)
--
-- This module provides access to internal garbage collection and
-- memory usage statistics.  These statistics are not available unless
-- a program is run with the @-T@ RTS flag.
--
-- /The API of this module is unstable and is tightly coupled to GHC's internals./
-- If depend on it, make sure to use a tight upper bound, e.g., @base < 4.X@ rather
-- than @base < 5@, because the interface can change rapidly without much warning.
--
-- @since 4.5.0.0
--
-- This module is a compatibility layer. It is meant to be temporary to allow
-- for the eventual deprecation of these declarations as described in [CLC
-- proposal
-- #289](https://github.com/haskell/core-libraries-committee/issues/289). These
-- declarations are now instead available from the @ghc-experimental@ package.

module GHC.Stats
    ( -- * Runtime statistics
      RTSStats(..), GCDetails(..), RtsTime
    , getRTSStats
    , getRTSStatsEnabled
    ) where


import Prelude (Bool,IO,Read,Show,(<$>))

import qualified GHC.Internal.Stats as Internal
import GHC.Generics (Generic)
import Data.Word (Word64,Word32)
import Data.Int (Int64)

-- | Time values from the RTS, using a fixed resolution of nanoseconds.
type RtsTime = Int64

--
-- | Statistics about runtime activity since the start of the
-- program.  This is a mirror of the C @struct RTSStats@ in @RtsAPI.h@
--
-- @since base-4.10.0.0
--
data RTSStats = RTSStats {
  -- -----------------------------------
  -- Cumulative stats about memory use

    -- | Total number of GCs
    RTSStats -> Word32
gcs :: Word32
    -- | Total number of major (oldest generation) GCs
  , RTSStats -> Word32
major_gcs :: Word32
    -- | Total bytes allocated
  , RTSStats -> Word64
allocated_bytes :: Word64
    -- | Maximum live data (including large objects + compact regions) in the
    -- heap. Updated after a major GC.
  , RTSStats -> Word64
max_live_bytes :: Word64
    -- | Maximum live data in large objects
  , RTSStats -> Word64
max_large_objects_bytes :: Word64
    -- | Maximum live data in compact regions
  , RTSStats -> Word64
max_compact_bytes :: Word64
    -- | Maximum slop
  , RTSStats -> Word64
max_slop_bytes :: Word64
    -- | Maximum memory in use by the RTS
  , RTSStats -> Word64
max_mem_in_use_bytes :: Word64
    -- | Sum of live bytes across all major GCs.  Divided by major_gcs
    -- gives the average live data over the lifetime of the program.
  , RTSStats -> Word64
cumulative_live_bytes :: Word64
    -- | Sum of copied_bytes across all GCs
  , RTSStats -> Word64
copied_bytes :: Word64
    -- | Sum of copied_bytes across all parallel GCs
  , RTSStats -> Word64
par_copied_bytes :: Word64
    -- | Sum of par_max_copied_bytes across all parallel GCs. Deprecated.
  , RTSStats -> Word64
cumulative_par_max_copied_bytes :: Word64
    -- | Sum of par_balanced_copied bytes across all parallel GCs
  , RTSStats -> Word64
cumulative_par_balanced_copied_bytes :: Word64

  -- -----------------------------------
  -- Cumulative stats about time use
  -- (we use signed values here because due to inaccuracies in timers
  -- the values can occasionally go slightly negative)

    -- | Total CPU time used by the init phase
    -- @since base-4.12.0.0
  , RTSStats -> RtsTime
init_cpu_ns :: RtsTime
    -- | Total elapsed time used by the init phase
    -- @since base-4.12.0.0
  , RTSStats -> RtsTime
init_elapsed_ns :: RtsTime
    -- | Total CPU time used by the mutator
  , RTSStats -> RtsTime
mutator_cpu_ns :: RtsTime
    -- | Total elapsed time used by the mutator
  , RTSStats -> RtsTime
mutator_elapsed_ns :: RtsTime
    -- | Total CPU time used by the GC
  , RTSStats -> RtsTime
gc_cpu_ns :: RtsTime
    -- | Total elapsed time used by the GC
  , RTSStats -> RtsTime
gc_elapsed_ns :: RtsTime
    -- | Total CPU time (at the previous GC)
  , RTSStats -> RtsTime
cpu_ns :: RtsTime
    -- | Total elapsed time (at the previous GC)
  , RTSStats -> RtsTime
elapsed_ns :: RtsTime

    -- | The total CPU time used during the post-mark pause phase of the
    -- concurrent nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
    -- | The total time elapsed during the post-mark pause phase of the
    -- concurrent nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
    -- | The maximum elapsed length of any post-mark pause phase of the
    -- concurrent nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
    -- | The total CPU time used by the nonmoving GC.
  , RTSStats -> RtsTime
nonmoving_gc_cpu_ns :: RtsTime
    -- | The total time elapsed during which there is a nonmoving GC active.
  , RTSStats -> RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
    -- | The maximum time elapsed during any nonmoving GC cycle.
  , RTSStats -> RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime

    -- | Details about the most recent GC
  , RTSStats -> GCDetails
gc :: GCDetails
  } deriving ( ReadPrec [RTSStats]
ReadPrec RTSStats
Int -> ReadS RTSStats
ReadS [RTSStats]
(Int -> ReadS RTSStats)
-> ReadS [RTSStats]
-> ReadPrec RTSStats
-> ReadPrec [RTSStats]
-> Read RTSStats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RTSStats
readsPrec :: Int -> ReadS RTSStats
$creadList :: ReadS [RTSStats]
readList :: ReadS [RTSStats]
$creadPrec :: ReadPrec RTSStats
readPrec :: ReadPrec RTSStats
$creadListPrec :: ReadPrec [RTSStats]
readListPrec :: ReadPrec [RTSStats]
Read -- ^ @since base-4.10.0.0
             , Int -> RTSStats -> ShowS
[RTSStats] -> ShowS
RTSStats -> String
(Int -> RTSStats -> ShowS)
-> (RTSStats -> String) -> ([RTSStats] -> ShowS) -> Show RTSStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RTSStats -> ShowS
showsPrec :: Int -> RTSStats -> ShowS
$cshow :: RTSStats -> String
show :: RTSStats -> String
$cshowList :: [RTSStats] -> ShowS
showList :: [RTSStats] -> ShowS
Show -- ^ @since base-4.10.0.0
             , (forall x. RTSStats -> Rep RTSStats x)
-> (forall x. Rep RTSStats x -> RTSStats) -> Generic RTSStats
forall x. Rep RTSStats x -> RTSStats
forall x. RTSStats -> Rep RTSStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RTSStats -> Rep RTSStats x
from :: forall x. RTSStats -> Rep RTSStats x
$cto :: forall x. Rep RTSStats x -> RTSStats
to :: forall x. Rep RTSStats x -> RTSStats
Generic -- ^ @since base-4.15.0.0
             )

--
-- | Statistics about a single GC.  This is a mirror of the C @struct
--   GCDetails@ in @RtsAPI.h@, with the field prefixed with @gc_@ to
--   avoid collisions with 'RTSStats'.
--
data GCDetails = GCDetails {
    -- | The generation number of this GC
    GCDetails -> Word32
gcdetails_gen :: Word32
    -- | Number of threads used in this GC
  , GCDetails -> Word32
gcdetails_threads :: Word32
    -- | Number of bytes allocated since the previous GC
  , GCDetails -> Word64
gcdetails_allocated_bytes :: Word64
    -- | Total amount of live data in the heap (includes large + compact data).
    -- Updated after every GC. Data in uncollected generations (in minor GCs)
    -- are considered live.
  , GCDetails -> Word64
gcdetails_live_bytes :: Word64
    -- | Total amount of live data in large objects
  , GCDetails -> Word64
gcdetails_large_objects_bytes :: Word64
    -- | Total amount of live data in compact regions
  , GCDetails -> Word64
gcdetails_compact_bytes :: Word64
    -- | Total amount of slop (wasted memory)
  , GCDetails -> Word64
gcdetails_slop_bytes :: Word64
    -- | Total amount of memory in use by the RTS
  , GCDetails -> Word64
gcdetails_mem_in_use_bytes :: Word64
    -- | Total amount of data copied during this GC
  , GCDetails -> Word64
gcdetails_copied_bytes :: Word64
    -- | In parallel GC, the max amount of data copied by any one thread.
    -- Deprecated.
  , GCDetails -> Word64
gcdetails_par_max_copied_bytes :: Word64
    -- | In parallel GC, the amount of balanced data copied by all threads
  , GCDetails -> Word64
gcdetails_par_balanced_copied_bytes :: Word64
    -- | The amount of memory lost due to block fragmentation in bytes.
    -- Block fragmentation is the difference between the amount of blocks retained by the RTS and the blocks that are in use.
    -- This occurs when megablocks are only sparsely used, eg, when data that cannot be moved retains a megablock.
    --
    -- @since base-4.18.0.0
  , GCDetails -> Word64
gcdetails_block_fragmentation_bytes :: Word64
    -- | The time elapsed during synchronisation before GC
  , GCDetails -> RtsTime
gcdetails_sync_elapsed_ns :: RtsTime
    -- | The CPU time used during GC itself
  , GCDetails -> RtsTime
gcdetails_cpu_ns :: RtsTime
    -- | The time elapsed during GC itself
  , GCDetails -> RtsTime
gcdetails_elapsed_ns :: RtsTime

    -- | The CPU time used during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , GCDetails -> RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
    -- | The time elapsed during the post-mark pause phase of the concurrent
    -- nonmoving GC.
  , GCDetails -> RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
  } deriving ( ReadPrec [GCDetails]
ReadPrec GCDetails
Int -> ReadS GCDetails
ReadS [GCDetails]
(Int -> ReadS GCDetails)
-> ReadS [GCDetails]
-> ReadPrec GCDetails
-> ReadPrec [GCDetails]
-> Read GCDetails
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GCDetails
readsPrec :: Int -> ReadS GCDetails
$creadList :: ReadS [GCDetails]
readList :: ReadS [GCDetails]
$creadPrec :: ReadPrec GCDetails
readPrec :: ReadPrec GCDetails
$creadListPrec :: ReadPrec [GCDetails]
readListPrec :: ReadPrec [GCDetails]
Read -- ^ @since base-4.10.0.0
             , Int -> GCDetails -> ShowS
[GCDetails] -> ShowS
GCDetails -> String
(Int -> GCDetails -> ShowS)
-> (GCDetails -> String)
-> ([GCDetails] -> ShowS)
-> Show GCDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GCDetails -> ShowS
showsPrec :: Int -> GCDetails -> ShowS
$cshow :: GCDetails -> String
show :: GCDetails -> String
$cshowList :: [GCDetails] -> ShowS
showList :: [GCDetails] -> ShowS
Show -- ^ @since base-4.10.0.0
             , (forall x. GCDetails -> Rep GCDetails x)
-> (forall x. Rep GCDetails x -> GCDetails) -> Generic GCDetails
forall x. Rep GCDetails x -> GCDetails
forall x. GCDetails -> Rep GCDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GCDetails -> Rep GCDetails x
from :: forall x. GCDetails -> Rep GCDetails x
$cto :: forall x. Rep GCDetails x -> GCDetails
to :: forall x. Rep GCDetails x -> GCDetails
Generic -- ^ @since base-4.15.0.0
             )

-------------------------------- compat ----------------------------------------

internal_to_base_RTSStats :: Internal.RTSStats -> RTSStats
internal_to_base_RTSStats :: RTSStats -> RTSStats
internal_to_base_RTSStats i :: RTSStats
i@Internal.RTSStats{RtsTime
Word32
Word64
GCDetails
gcs :: Word32
major_gcs :: Word32
allocated_bytes :: Word64
max_live_bytes :: Word64
max_large_objects_bytes :: Word64
max_compact_bytes :: Word64
max_slop_bytes :: Word64
max_mem_in_use_bytes :: Word64
cumulative_live_bytes :: Word64
copied_bytes :: Word64
par_copied_bytes :: Word64
cumulative_par_max_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes :: Word64
init_cpu_ns :: RtsTime
init_elapsed_ns :: RtsTime
mutator_cpu_ns :: RtsTime
mutator_elapsed_ns :: RtsTime
gc_cpu_ns :: RtsTime
gc_elapsed_ns :: RtsTime
cpu_ns :: RtsTime
elapsed_ns :: RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
nonmoving_gc_cpu_ns :: RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime
gc :: GCDetails
gc :: RTSStats -> GCDetails
nonmoving_gc_max_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_cpu_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_elapsed_ns :: RTSStats -> RtsTime
nonmoving_gc_sync_cpu_ns :: RTSStats -> RtsTime
elapsed_ns :: RTSStats -> RtsTime
cpu_ns :: RTSStats -> RtsTime
gc_elapsed_ns :: RTSStats -> RtsTime
gc_cpu_ns :: RTSStats -> RtsTime
mutator_elapsed_ns :: RTSStats -> RtsTime
mutator_cpu_ns :: RTSStats -> RtsTime
init_elapsed_ns :: RTSStats -> RtsTime
init_cpu_ns :: RTSStats -> RtsTime
cumulative_par_balanced_copied_bytes :: RTSStats -> Word64
cumulative_par_max_copied_bytes :: RTSStats -> Word64
par_copied_bytes :: RTSStats -> Word64
copied_bytes :: RTSStats -> Word64
cumulative_live_bytes :: RTSStats -> Word64
max_mem_in_use_bytes :: RTSStats -> Word64
max_slop_bytes :: RTSStats -> Word64
max_compact_bytes :: RTSStats -> Word64
max_large_objects_bytes :: RTSStats -> Word64
max_live_bytes :: RTSStats -> Word64
allocated_bytes :: RTSStats -> Word64
major_gcs :: RTSStats -> Word32
gcs :: RTSStats -> Word32
..} =
  let gc_details :: GCDetails
gc_details = GCDetails -> GCDetails
internal_to_base_GCDetails (RTSStats -> GCDetails
Internal.gc RTSStats
i)
  in RTSStats{gc :: GCDetails
gc = GCDetails
gc_details,RtsTime
Word32
Word64
gcs :: Word32
major_gcs :: Word32
allocated_bytes :: Word64
max_live_bytes :: Word64
max_large_objects_bytes :: Word64
max_compact_bytes :: Word64
max_slop_bytes :: Word64
max_mem_in_use_bytes :: Word64
cumulative_live_bytes :: Word64
copied_bytes :: Word64
par_copied_bytes :: Word64
cumulative_par_max_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes :: Word64
init_cpu_ns :: RtsTime
init_elapsed_ns :: RtsTime
mutator_cpu_ns :: RtsTime
mutator_elapsed_ns :: RtsTime
gc_cpu_ns :: RtsTime
gc_elapsed_ns :: RtsTime
cpu_ns :: RtsTime
elapsed_ns :: RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
nonmoving_gc_cpu_ns :: RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime
gcs :: Word32
major_gcs :: Word32
allocated_bytes :: Word64
max_live_bytes :: Word64
max_large_objects_bytes :: Word64
max_compact_bytes :: Word64
max_slop_bytes :: Word64
max_mem_in_use_bytes :: Word64
cumulative_live_bytes :: Word64
copied_bytes :: Word64
par_copied_bytes :: Word64
cumulative_par_max_copied_bytes :: Word64
cumulative_par_balanced_copied_bytes :: Word64
init_cpu_ns :: RtsTime
init_elapsed_ns :: RtsTime
mutator_cpu_ns :: RtsTime
mutator_elapsed_ns :: RtsTime
gc_cpu_ns :: RtsTime
gc_elapsed_ns :: RtsTime
cpu_ns :: RtsTime
elapsed_ns :: RtsTime
nonmoving_gc_sync_cpu_ns :: RtsTime
nonmoving_gc_sync_elapsed_ns :: RtsTime
nonmoving_gc_sync_max_elapsed_ns :: RtsTime
nonmoving_gc_cpu_ns :: RtsTime
nonmoving_gc_elapsed_ns :: RtsTime
nonmoving_gc_max_elapsed_ns :: RtsTime
..}

internal_to_base_GCDetails :: Internal.GCDetails -> GCDetails
internal_to_base_GCDetails :: GCDetails -> GCDetails
internal_to_base_GCDetails Internal.GCDetails{RtsTime
Word32
Word64
gcdetails_gen :: Word32
gcdetails_threads :: Word32
gcdetails_allocated_bytes :: Word64
gcdetails_live_bytes :: Word64
gcdetails_large_objects_bytes :: Word64
gcdetails_compact_bytes :: Word64
gcdetails_slop_bytes :: Word64
gcdetails_mem_in_use_bytes :: Word64
gcdetails_copied_bytes :: Word64
gcdetails_par_max_copied_bytes :: Word64
gcdetails_par_balanced_copied_bytes :: Word64
gcdetails_block_fragmentation_bytes :: Word64
gcdetails_sync_elapsed_ns :: RtsTime
gcdetails_cpu_ns :: RtsTime
gcdetails_elapsed_ns :: RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: GCDetails -> RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: GCDetails -> RtsTime
gcdetails_elapsed_ns :: GCDetails -> RtsTime
gcdetails_cpu_ns :: GCDetails -> RtsTime
gcdetails_sync_elapsed_ns :: GCDetails -> RtsTime
gcdetails_block_fragmentation_bytes :: GCDetails -> Word64
gcdetails_par_balanced_copied_bytes :: GCDetails -> Word64
gcdetails_par_max_copied_bytes :: GCDetails -> Word64
gcdetails_copied_bytes :: GCDetails -> Word64
gcdetails_mem_in_use_bytes :: GCDetails -> Word64
gcdetails_slop_bytes :: GCDetails -> Word64
gcdetails_compact_bytes :: GCDetails -> Word64
gcdetails_large_objects_bytes :: GCDetails -> Word64
gcdetails_live_bytes :: GCDetails -> Word64
gcdetails_allocated_bytes :: GCDetails -> Word64
gcdetails_threads :: GCDetails -> Word32
gcdetails_gen :: GCDetails -> Word32
..} = GCDetails{RtsTime
Word32
Word64
gcdetails_gen :: Word32
gcdetails_threads :: Word32
gcdetails_allocated_bytes :: Word64
gcdetails_live_bytes :: Word64
gcdetails_large_objects_bytes :: Word64
gcdetails_compact_bytes :: Word64
gcdetails_slop_bytes :: Word64
gcdetails_mem_in_use_bytes :: Word64
gcdetails_copied_bytes :: Word64
gcdetails_par_max_copied_bytes :: Word64
gcdetails_par_balanced_copied_bytes :: Word64
gcdetails_block_fragmentation_bytes :: Word64
gcdetails_sync_elapsed_ns :: RtsTime
gcdetails_cpu_ns :: RtsTime
gcdetails_elapsed_ns :: RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
gcdetails_gen :: Word32
gcdetails_threads :: Word32
gcdetails_allocated_bytes :: Word64
gcdetails_live_bytes :: Word64
gcdetails_large_objects_bytes :: Word64
gcdetails_compact_bytes :: Word64
gcdetails_slop_bytes :: Word64
gcdetails_mem_in_use_bytes :: Word64
gcdetails_copied_bytes :: Word64
gcdetails_par_max_copied_bytes :: Word64
gcdetails_par_balanced_copied_bytes :: Word64
gcdetails_block_fragmentation_bytes :: Word64
gcdetails_sync_elapsed_ns :: RtsTime
gcdetails_cpu_ns :: RtsTime
gcdetails_elapsed_ns :: RtsTime
gcdetails_nonmoving_gc_sync_cpu_ns :: RtsTime
gcdetails_nonmoving_gc_sync_elapsed_ns :: RtsTime
..}

-------------------------------- shims -----------------------------------------

getRTSStats :: IO RTSStats
getRTSStats :: IO RTSStats
getRTSStats = RTSStats -> RTSStats
internal_to_base_RTSStats (RTSStats -> RTSStats) -> IO RTSStats -> IO RTSStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
Internal.getRTSStats

getRTSStatsEnabled :: IO Bool
getRTSStatsEnabled :: IO Bool
getRTSStatsEnabled = IO Bool
Internal.getRTSStatsEnabled