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

-- |
-- Module      :  GHC.RTS.Flags
-- 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)
--
-- /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.
--
-- Descriptions of flags can be seen in
-- <https://www.haskell.org/ghc/docs/latest/html/users_guide/runtime_control.html GHC User's Guide>,
-- or by running RTS help message using @+RTS --help@.
--
-- @since 4.8.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.RTS.Flags
  ( RtsTime
  , RTSFlags (..)
  , GiveGCStats (..)
  , GCFlags (..)
  , ConcFlags (..)
  , MiscFlags (..)
  , IoManagerFlag (..)
  , DebugFlags (..)
  , DoCostCentres (..)
  , CCFlags (..)
  , DoHeapProfile (..)
  , ProfFlags (..)
  , DoTrace (..)
  , TraceFlags (..)
  , TickyFlags (..)
  , ParFlags (..)
  , HpcFlags (..)
  , {-# DEPRECATED "import GHC.IO.SubSystem (IoSubSystem (..))" #-}
    IoSubSystem (..)
  , getRTSFlags
  , getGCFlags
  , getConcFlags
  , getMiscFlags
  , getDebugFlags
  , getCCFlags
  , getProfFlags
  , getTraceFlags
  , getTickyFlags
  , getParFlags
  , getHpcFlags
  ) where

import Prelude (Show,IO,Bool,Maybe,String,Int,Enum,FilePath,Double,Eq,(<$>))

import GHC.Generics (Generic)
import qualified GHC.Internal.RTS.Flags as Internal
import GHC.Internal.IO.SubSystem (IoSubSystem(..))

import Data.Word (Word32,Word64,Word)

-- | 'RtsTime' is defined as a @StgWord64@ in @stg/Types.h@
--
-- @since base-4.8.2.0
type RtsTime = Word64

-- | Should we produce a summary of the garbage collector statistics after the
-- program has exited?
--
-- @since base-4.8.2.0
data GiveGCStats
    = NoGCStats
    | CollectGCStats
    | OneLineGCStats
    | SummaryGCStats
    | VerboseGCStats
    deriving ( Int -> GiveGCStats -> ShowS
[GiveGCStats] -> ShowS
GiveGCStats -> String
(Int -> GiveGCStats -> ShowS)
-> (GiveGCStats -> String)
-> ([GiveGCStats] -> ShowS)
-> Show GiveGCStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GiveGCStats -> ShowS
showsPrec :: Int -> GiveGCStats -> ShowS
$cshow :: GiveGCStats -> String
show :: GiveGCStats -> String
$cshowList :: [GiveGCStats] -> ShowS
showList :: [GiveGCStats] -> ShowS
Show -- ^ @since base-4.8.0.0
             , (forall x. GiveGCStats -> Rep GiveGCStats x)
-> (forall x. Rep GiveGCStats x -> GiveGCStats)
-> Generic GiveGCStats
forall x. Rep GiveGCStats x -> GiveGCStats
forall x. GiveGCStats -> Rep GiveGCStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GiveGCStats -> Rep GiveGCStats x
from :: forall x. GiveGCStats -> Rep GiveGCStats x
$cto :: forall x. Rep GiveGCStats x -> GiveGCStats
to :: forall x. Rep GiveGCStats x -> GiveGCStats
Generic -- ^ @since base-4.15.0.0
             )

-- | Parameters of the garbage collector.
--
-- @since base-4.8.0.0
data GCFlags = GCFlags
    { GCFlags -> Maybe String
statsFile             :: Maybe FilePath
    , GCFlags -> GiveGCStats
giveStats             :: GiveGCStats
    , GCFlags -> Word32
maxStkSize            :: Word32
    , GCFlags -> Word32
initialStkSize        :: Word32
    , GCFlags -> Word32
stkChunkSize          :: Word32
    , GCFlags -> Word32
stkChunkBufferSize    :: Word32
    , GCFlags -> Word32
maxHeapSize           :: Word32
    , GCFlags -> Word32
minAllocAreaSize      :: Word32
    , GCFlags -> Word32
largeAllocLim         :: Word32
    , GCFlags -> Word32
nurseryChunkSize      :: Word32
    , GCFlags -> Word32
minOldGenSize         :: Word32
    , GCFlags -> Word32
heapSizeSuggestion    :: Word32
    , GCFlags -> Bool
heapSizeSuggestionAuto :: Bool
    , GCFlags -> Double
oldGenFactor          :: Double
    , GCFlags -> Double
returnDecayFactor     :: Double
    , GCFlags -> Double
pcFreeHeap            :: Double
    , GCFlags -> Word32
generations           :: Word32
    , GCFlags -> Bool
squeezeUpdFrames      :: Bool
    , GCFlags -> Bool
compact               :: Bool -- ^ True <=> "compact all the time"
    , GCFlags -> Double
compactThreshold      :: Double
    , GCFlags -> Bool
sweep                 :: Bool
      -- ^ use "mostly mark-sweep" instead of copying for the oldest generation
    , GCFlags -> Bool
ringBell              :: Bool
    , GCFlags -> RtsTime
idleGCDelayTime       :: RtsTime
    , GCFlags -> Bool
doIdleGC              :: Bool
    , GCFlags -> Word
heapBase              :: Word -- ^ address to ask the OS for memory
    , GCFlags -> Word
allocLimitGrace       :: Word
    , GCFlags -> Bool
numa                  :: Bool
    , GCFlags -> Word
numaMask              :: Word
    } deriving ( Int -> GCFlags -> ShowS
[GCFlags] -> ShowS
GCFlags -> String
(Int -> GCFlags -> ShowS)
-> (GCFlags -> String) -> ([GCFlags] -> ShowS) -> Show GCFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GCFlags -> ShowS
showsPrec :: Int -> GCFlags -> ShowS
$cshow :: GCFlags -> String
show :: GCFlags -> String
$cshowList :: [GCFlags] -> ShowS
showList :: [GCFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. GCFlags -> Rep GCFlags x)
-> (forall x. Rep GCFlags x -> GCFlags) -> Generic GCFlags
forall x. Rep GCFlags x -> GCFlags
forall x. GCFlags -> Rep GCFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GCFlags -> Rep GCFlags x
from :: forall x. GCFlags -> Rep GCFlags x
$cto :: forall x. Rep GCFlags x -> GCFlags
to :: forall x. Rep GCFlags x -> GCFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Parameters concerning context switching
--
-- @since base-4.8.0.0
data ConcFlags = ConcFlags
    { ConcFlags -> RtsTime
ctxtSwitchTime  :: RtsTime
    , ConcFlags -> Int
ctxtSwitchTicks :: Int
    } deriving ( Int -> ConcFlags -> ShowS
[ConcFlags] -> ShowS
ConcFlags -> String
(Int -> ConcFlags -> ShowS)
-> (ConcFlags -> String)
-> ([ConcFlags] -> ShowS)
-> Show ConcFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcFlags -> ShowS
showsPrec :: Int -> ConcFlags -> ShowS
$cshow :: ConcFlags -> String
show :: ConcFlags -> String
$cshowList :: [ConcFlags] -> ShowS
showList :: [ConcFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. ConcFlags -> Rep ConcFlags x)
-> (forall x. Rep ConcFlags x -> ConcFlags) -> Generic ConcFlags
forall x. Rep ConcFlags x -> ConcFlags
forall x. ConcFlags -> Rep ConcFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConcFlags -> Rep ConcFlags x
from :: forall x. ConcFlags -> Rep ConcFlags x
$cto :: forall x. Rep ConcFlags x -> ConcFlags
to :: forall x. Rep ConcFlags x -> ConcFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Miscellaneous parameters
--
-- @since base-4.8.0.0
data MiscFlags = MiscFlags
    { MiscFlags -> RtsTime
tickInterval          :: RtsTime
    , MiscFlags -> Bool
installSignalHandlers :: Bool
    , MiscFlags -> Bool
installSEHHandlers    :: Bool
    , MiscFlags -> Bool
generateCrashDumpFile :: Bool
    , MiscFlags -> Bool
generateStackTrace    :: Bool
    , MiscFlags -> Bool
machineReadable       :: Bool
    , MiscFlags -> Bool
disableDelayedOsMemoryReturn :: Bool
    , MiscFlags -> Bool
internalCounters      :: Bool
    , MiscFlags -> Bool
linkerAlwaysPic       :: Bool
    , MiscFlags -> Word
linkerMemBase         :: Word
      -- ^ address to ask the OS for memory for the linker, 0 ==> off
    , MiscFlags -> IoManagerFlag
ioManager             :: IoManagerFlag
    , MiscFlags -> Word32
numIoWorkerThreads    :: Word32
    } deriving ( Int -> MiscFlags -> ShowS
[MiscFlags] -> ShowS
MiscFlags -> String
(Int -> MiscFlags -> ShowS)
-> (MiscFlags -> String)
-> ([MiscFlags] -> ShowS)
-> Show MiscFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MiscFlags -> ShowS
showsPrec :: Int -> MiscFlags -> ShowS
$cshow :: MiscFlags -> String
show :: MiscFlags -> String
$cshowList :: [MiscFlags] -> ShowS
showList :: [MiscFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. MiscFlags -> Rep MiscFlags x)
-> (forall x. Rep MiscFlags x -> MiscFlags) -> Generic MiscFlags
forall x. Rep MiscFlags x -> MiscFlags
forall x. MiscFlags -> Rep MiscFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MiscFlags -> Rep MiscFlags x
from :: forall x. MiscFlags -> Rep MiscFlags x
$cto :: forall x. Rep MiscFlags x -> MiscFlags
to :: forall x. Rep MiscFlags x -> MiscFlags
Generic -- ^ @since base-4.15.0.0
               )

-- |
--
-- @since base-4.21.0.0
data IoManagerFlag =
       IoManagerFlagAuto
     | IoManagerFlagSelect        -- ^ Unix only, non-threaded RTS only
     | IoManagerFlagMIO           -- ^ cross-platform, threaded RTS only
     | IoManagerFlagWinIO         -- ^ Windows only
     | IoManagerFlagWin32Legacy   -- ^ Windows only, non-threaded RTS only
  deriving (IoManagerFlag -> IoManagerFlag -> Bool
(IoManagerFlag -> IoManagerFlag -> Bool)
-> (IoManagerFlag -> IoManagerFlag -> Bool) -> Eq IoManagerFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IoManagerFlag -> IoManagerFlag -> Bool
== :: IoManagerFlag -> IoManagerFlag -> Bool
$c/= :: IoManagerFlag -> IoManagerFlag -> Bool
/= :: IoManagerFlag -> IoManagerFlag -> Bool
Eq, Int -> IoManagerFlag
IoManagerFlag -> Int
IoManagerFlag -> [IoManagerFlag]
IoManagerFlag -> IoManagerFlag
IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
IoManagerFlag -> IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
(IoManagerFlag -> IoManagerFlag)
-> (IoManagerFlag -> IoManagerFlag)
-> (Int -> IoManagerFlag)
-> (IoManagerFlag -> Int)
-> (IoManagerFlag -> [IoManagerFlag])
-> (IoManagerFlag -> IoManagerFlag -> [IoManagerFlag])
-> (IoManagerFlag -> IoManagerFlag -> [IoManagerFlag])
-> (IoManagerFlag
    -> IoManagerFlag -> IoManagerFlag -> [IoManagerFlag])
-> Enum IoManagerFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: IoManagerFlag -> IoManagerFlag
succ :: IoManagerFlag -> IoManagerFlag
$cpred :: IoManagerFlag -> IoManagerFlag
pred :: IoManagerFlag -> IoManagerFlag
$ctoEnum :: Int -> IoManagerFlag
toEnum :: Int -> IoManagerFlag
$cfromEnum :: IoManagerFlag -> Int
fromEnum :: IoManagerFlag -> Int
$cenumFrom :: IoManagerFlag -> [IoManagerFlag]
enumFrom :: IoManagerFlag -> [IoManagerFlag]
$cenumFromThen :: IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
enumFromThen :: IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
$cenumFromTo :: IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
enumFromTo :: IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
$cenumFromThenTo :: IoManagerFlag -> IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
enumFromThenTo :: IoManagerFlag -> IoManagerFlag -> IoManagerFlag -> [IoManagerFlag]
Enum, Int -> IoManagerFlag -> ShowS
[IoManagerFlag] -> ShowS
IoManagerFlag -> String
(Int -> IoManagerFlag -> ShowS)
-> (IoManagerFlag -> String)
-> ([IoManagerFlag] -> ShowS)
-> Show IoManagerFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IoManagerFlag -> ShowS
showsPrec :: Int -> IoManagerFlag -> ShowS
$cshow :: IoManagerFlag -> String
show :: IoManagerFlag -> String
$cshowList :: [IoManagerFlag] -> ShowS
showList :: [IoManagerFlag] -> ShowS
Show)

-- | Flags to control debugging output & extra checking in various
-- subsystems.
--
-- @since base-4.8.0.0
data DebugFlags = DebugFlags
    { DebugFlags -> Bool
scheduler      :: Bool -- ^ @s@
    , DebugFlags -> Bool
interpreter    :: Bool -- ^ @i@
    , DebugFlags -> Bool
weak           :: Bool -- ^ @w@
    , DebugFlags -> Bool
gccafs         :: Bool -- ^ @G@
    , DebugFlags -> Bool
gc             :: Bool -- ^ @g@
    , DebugFlags -> Bool
nonmoving_gc   :: Bool -- ^ @n@
    , DebugFlags -> Bool
block_alloc    :: Bool -- ^ @b@
    , DebugFlags -> Bool
sanity         :: Bool -- ^ @S@
    , DebugFlags -> Bool
stable         :: Bool -- ^ @t@
    , DebugFlags -> Bool
prof           :: Bool -- ^ @p@
    , DebugFlags -> Bool
linker         :: Bool -- ^ @l@ the object linker
    , DebugFlags -> Bool
apply          :: Bool -- ^ @a@
    , DebugFlags -> Bool
stm            :: Bool -- ^ @m@
    , DebugFlags -> Bool
squeeze        :: Bool -- ^ @z@ stack squeezing & lazy blackholing
    , DebugFlags -> Bool
hpc            :: Bool -- ^ @c@ coverage
    , DebugFlags -> Bool
sparks         :: Bool -- ^ @r@
    } deriving ( Int -> DebugFlags -> ShowS
[DebugFlags] -> ShowS
DebugFlags -> String
(Int -> DebugFlags -> ShowS)
-> (DebugFlags -> String)
-> ([DebugFlags] -> ShowS)
-> Show DebugFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugFlags -> ShowS
showsPrec :: Int -> DebugFlags -> ShowS
$cshow :: DebugFlags -> String
show :: DebugFlags -> String
$cshowList :: [DebugFlags] -> ShowS
showList :: [DebugFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. DebugFlags -> Rep DebugFlags x)
-> (forall x. Rep DebugFlags x -> DebugFlags) -> Generic DebugFlags
forall x. Rep DebugFlags x -> DebugFlags
forall x. DebugFlags -> Rep DebugFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DebugFlags -> Rep DebugFlags x
from :: forall x. DebugFlags -> Rep DebugFlags x
$cto :: forall x. Rep DebugFlags x -> DebugFlags
to :: forall x. Rep DebugFlags x -> DebugFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Should the RTS produce a cost-center summary?
--
-- @since base-4.8.2.0
data DoCostCentres
    = CostCentresNone
    | CostCentresSummary
    | CostCentresVerbose
    | CostCentresAll
    | CostCentresJSON
    deriving ( Int -> DoCostCentres -> ShowS
[DoCostCentres] -> ShowS
DoCostCentres -> String
(Int -> DoCostCentres -> ShowS)
-> (DoCostCentres -> String)
-> ([DoCostCentres] -> ShowS)
-> Show DoCostCentres
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoCostCentres -> ShowS
showsPrec :: Int -> DoCostCentres -> ShowS
$cshow :: DoCostCentres -> String
show :: DoCostCentres -> String
$cshowList :: [DoCostCentres] -> ShowS
showList :: [DoCostCentres] -> ShowS
Show -- ^ @since base-4.8.0.0
             , (forall x. DoCostCentres -> Rep DoCostCentres x)
-> (forall x. Rep DoCostCentres x -> DoCostCentres)
-> Generic DoCostCentres
forall x. Rep DoCostCentres x -> DoCostCentres
forall x. DoCostCentres -> Rep DoCostCentres x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DoCostCentres -> Rep DoCostCentres x
from :: forall x. DoCostCentres -> Rep DoCostCentres x
$cto :: forall x. Rep DoCostCentres x -> DoCostCentres
to :: forall x. Rep DoCostCentres x -> DoCostCentres
Generic -- ^ @since base-4.15.0.0
             )

-- | Parameters pertaining to the cost-center profiler.
--
-- @since base-4.8.0.0
data CCFlags = CCFlags
    { CCFlags -> DoCostCentres
doCostCentres :: DoCostCentres
    , CCFlags -> Int
profilerTicks :: Int
    , CCFlags -> Int
msecsPerTick  :: Int
    } deriving ( Int -> CCFlags -> ShowS
[CCFlags] -> ShowS
CCFlags -> String
(Int -> CCFlags -> ShowS)
-> (CCFlags -> String) -> ([CCFlags] -> ShowS) -> Show CCFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CCFlags -> ShowS
showsPrec :: Int -> CCFlags -> ShowS
$cshow :: CCFlags -> String
show :: CCFlags -> String
$cshowList :: [CCFlags] -> ShowS
showList :: [CCFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. CCFlags -> Rep CCFlags x)
-> (forall x. Rep CCFlags x -> CCFlags) -> Generic CCFlags
forall x. Rep CCFlags x -> CCFlags
forall x. CCFlags -> Rep CCFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CCFlags -> Rep CCFlags x
from :: forall x. CCFlags -> Rep CCFlags x
$cto :: forall x. Rep CCFlags x -> CCFlags
to :: forall x. Rep CCFlags x -> CCFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | What sort of heap profile are we collecting?
--
-- @since base-4.8.2.0
data DoHeapProfile
    = NoHeapProfiling
    | HeapByCCS
    | HeapByMod
    | HeapByDescr
    | HeapByType
    | HeapByRetainer
    | HeapByLDV
    | HeapByClosureType
    | HeapByInfoTable
    | HeapByEra -- ^ @since base-4.20.0.0
    deriving ( Int -> DoHeapProfile -> ShowS
[DoHeapProfile] -> ShowS
DoHeapProfile -> String
(Int -> DoHeapProfile -> ShowS)
-> (DoHeapProfile -> String)
-> ([DoHeapProfile] -> ShowS)
-> Show DoHeapProfile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoHeapProfile -> ShowS
showsPrec :: Int -> DoHeapProfile -> ShowS
$cshow :: DoHeapProfile -> String
show :: DoHeapProfile -> String
$cshowList :: [DoHeapProfile] -> ShowS
showList :: [DoHeapProfile] -> ShowS
Show -- ^ @since base-4.8.0.0
             , (forall x. DoHeapProfile -> Rep DoHeapProfile x)
-> (forall x. Rep DoHeapProfile x -> DoHeapProfile)
-> Generic DoHeapProfile
forall x. Rep DoHeapProfile x -> DoHeapProfile
forall x. DoHeapProfile -> Rep DoHeapProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DoHeapProfile -> Rep DoHeapProfile x
from :: forall x. DoHeapProfile -> Rep DoHeapProfile x
$cto :: forall x. Rep DoHeapProfile x -> DoHeapProfile
to :: forall x. Rep DoHeapProfile x -> DoHeapProfile
Generic -- ^ @since base-4.15.0.0
             )

-- | Parameters of the cost-center profiler
--
-- @since base-4.8.0.0
data ProfFlags = ProfFlags
    { ProfFlags -> DoHeapProfile
doHeapProfile            :: DoHeapProfile
    , ProfFlags -> RtsTime
heapProfileInterval      :: RtsTime -- ^ time between samples
    , ProfFlags -> Word
heapProfileIntervalTicks :: Word    -- ^ ticks between samples (derived)
    , ProfFlags -> Bool
startHeapProfileAtStartup :: Bool
    , ProfFlags -> Bool
startTimeProfileAtStartup :: Bool   -- ^ @since base-4.20.0.0
    , ProfFlags -> Bool
showCCSOnException       :: Bool
    , ProfFlags -> Bool
automaticEraIncrement    :: Bool   -- ^ @since 4.20.0.0
    , ProfFlags -> Word
maxRetainerSetSize       :: Word
    , ProfFlags -> Word
ccsLength                :: Word
    , ProfFlags -> Maybe String
modSelector              :: Maybe String
    , ProfFlags -> Maybe String
descrSelector            :: Maybe String
    , ProfFlags -> Maybe String
typeSelector             :: Maybe String
    , ProfFlags -> Maybe String
ccSelector               :: Maybe String
    , ProfFlags -> Maybe String
ccsSelector              :: Maybe String
    , ProfFlags -> Maybe String
retainerSelector         :: Maybe String
    , ProfFlags -> Maybe String
bioSelector              :: Maybe String
    , ProfFlags -> Word
eraSelector              :: Word -- ^ @since base-4.20.0.0
    } deriving ( Int -> ProfFlags -> ShowS
[ProfFlags] -> ShowS
ProfFlags -> String
(Int -> ProfFlags -> ShowS)
-> (ProfFlags -> String)
-> ([ProfFlags] -> ShowS)
-> Show ProfFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfFlags -> ShowS
showsPrec :: Int -> ProfFlags -> ShowS
$cshow :: ProfFlags -> String
show :: ProfFlags -> String
$cshowList :: [ProfFlags] -> ShowS
showList :: [ProfFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. ProfFlags -> Rep ProfFlags x)
-> (forall x. Rep ProfFlags x -> ProfFlags) -> Generic ProfFlags
forall x. Rep ProfFlags x -> ProfFlags
forall x. ProfFlags -> Rep ProfFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProfFlags -> Rep ProfFlags x
from :: forall x. ProfFlags -> Rep ProfFlags x
$cto :: forall x. Rep ProfFlags x -> ProfFlags
to :: forall x. Rep ProfFlags x -> ProfFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Is event tracing enabled?
--
-- @since base-4.8.2.0
data DoTrace
    = TraceNone      -- ^ no tracing
    | TraceEventLog  -- ^ send tracing events to the event log
    | TraceStderr    -- ^ send tracing events to @stderr@
    deriving ( Int -> DoTrace -> ShowS
[DoTrace] -> ShowS
DoTrace -> String
(Int -> DoTrace -> ShowS)
-> (DoTrace -> String) -> ([DoTrace] -> ShowS) -> Show DoTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DoTrace -> ShowS
showsPrec :: Int -> DoTrace -> ShowS
$cshow :: DoTrace -> String
show :: DoTrace -> String
$cshowList :: [DoTrace] -> ShowS
showList :: [DoTrace] -> ShowS
Show -- ^ @since base-4.8.0.0
             , (forall x. DoTrace -> Rep DoTrace x)
-> (forall x. Rep DoTrace x -> DoTrace) -> Generic DoTrace
forall x. Rep DoTrace x -> DoTrace
forall x. DoTrace -> Rep DoTrace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DoTrace -> Rep DoTrace x
from :: forall x. DoTrace -> Rep DoTrace x
$cto :: forall x. Rep DoTrace x -> DoTrace
to :: forall x. Rep DoTrace x -> DoTrace
Generic -- ^ @since base-4.15.0.0
             )

-- | Parameters pertaining to event tracing
--
-- @since base-4.8.0.0
data TraceFlags = TraceFlags
    { TraceFlags -> DoTrace
tracing        :: DoTrace
    , TraceFlags -> Bool
timestamp      :: Bool -- ^ show timestamp in stderr output
    , TraceFlags -> Bool
traceScheduler :: Bool -- ^ trace scheduler events
    , TraceFlags -> Bool
traceGc        :: Bool -- ^ trace GC events
    , TraceFlags -> Bool
traceNonmovingGc
                     :: Bool -- ^ trace nonmoving GC heap census samples
    , TraceFlags -> Bool
sparksSampled  :: Bool -- ^ trace spark events by a sampled method
    , TraceFlags -> Bool
sparksFull     :: Bool -- ^ trace spark events 100% accurately
    , TraceFlags -> Bool
user           :: Bool -- ^ trace user events (emitted from Haskell code)
    } deriving ( Int -> TraceFlags -> ShowS
[TraceFlags] -> ShowS
TraceFlags -> String
(Int -> TraceFlags -> ShowS)
-> (TraceFlags -> String)
-> ([TraceFlags] -> ShowS)
-> Show TraceFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceFlags -> ShowS
showsPrec :: Int -> TraceFlags -> ShowS
$cshow :: TraceFlags -> String
show :: TraceFlags -> String
$cshowList :: [TraceFlags] -> ShowS
showList :: [TraceFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. TraceFlags -> Rep TraceFlags x)
-> (forall x. Rep TraceFlags x -> TraceFlags) -> Generic TraceFlags
forall x. Rep TraceFlags x -> TraceFlags
forall x. TraceFlags -> Rep TraceFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceFlags -> Rep TraceFlags x
from :: forall x. TraceFlags -> Rep TraceFlags x
$cto :: forall x. Rep TraceFlags x -> TraceFlags
to :: forall x. Rep TraceFlags x -> TraceFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Parameters pertaining to ticky-ticky profiler
--
-- @since base-4.8.0.0
data TickyFlags = TickyFlags
    { TickyFlags -> Bool
showTickyStats :: Bool
    , TickyFlags -> Maybe String
tickyFile      :: Maybe FilePath
    } deriving ( Int -> TickyFlags -> ShowS
[TickyFlags] -> ShowS
TickyFlags -> String
(Int -> TickyFlags -> ShowS)
-> (TickyFlags -> String)
-> ([TickyFlags] -> ShowS)
-> Show TickyFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TickyFlags -> ShowS
showsPrec :: Int -> TickyFlags -> ShowS
$cshow :: TickyFlags -> String
show :: TickyFlags -> String
$cshowList :: [TickyFlags] -> ShowS
showList :: [TickyFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. TickyFlags -> Rep TickyFlags x)
-> (forall x. Rep TickyFlags x -> TickyFlags) -> Generic TickyFlags
forall x. Rep TickyFlags x -> TickyFlags
forall x. TickyFlags -> Rep TickyFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TickyFlags -> Rep TickyFlags x
from :: forall x. TickyFlags -> Rep TickyFlags x
$cto :: forall x. Rep TickyFlags x -> TickyFlags
to :: forall x. Rep TickyFlags x -> TickyFlags
Generic -- ^ @since base-4.15.0.0
               )

-- | Parameters pertaining to parallelism
--
-- @since base-4.8.0.0
data ParFlags = ParFlags
    { ParFlags -> Word32
nCapabilities             :: Word32
    , ParFlags -> Bool
migrate                   :: Bool
    , ParFlags -> Word32
maxLocalSparks            :: Word32
    , ParFlags -> Bool
parGcEnabled              :: Bool
    , ParFlags -> Word32
parGcGen                  :: Word32
    , ParFlags -> Bool
parGcLoadBalancingEnabled :: Bool
    , ParFlags -> Word32
parGcLoadBalancingGen     :: Word32
    , ParFlags -> Word32
parGcNoSyncWithIdle       :: Word32
    , ParFlags -> Word32
parGcThreads              :: Word32
    , ParFlags -> Bool
setAffinity               :: Bool
    }
    deriving ( Int -> ParFlags -> ShowS
[ParFlags] -> ShowS
ParFlags -> String
(Int -> ParFlags -> ShowS)
-> (ParFlags -> String) -> ([ParFlags] -> ShowS) -> Show ParFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParFlags -> ShowS
showsPrec :: Int -> ParFlags -> ShowS
$cshow :: ParFlags -> String
show :: ParFlags -> String
$cshowList :: [ParFlags] -> ShowS
showList :: [ParFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
             , (forall x. ParFlags -> Rep ParFlags x)
-> (forall x. Rep ParFlags x -> ParFlags) -> Generic ParFlags
forall x. Rep ParFlags x -> ParFlags
forall x. ParFlags -> Rep ParFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParFlags -> Rep ParFlags x
from :: forall x. ParFlags -> Rep ParFlags x
$cto :: forall x. Rep ParFlags x -> ParFlags
to :: forall x. Rep ParFlags x -> ParFlags
Generic -- ^ @since base-4.15.0.0
             )

-- | Parameters pertaining to Haskell program coverage (HPC)
--
-- @since base-4.20.0.0
data HpcFlags = HpcFlags
    { HpcFlags -> Bool
readTixFile :: Bool
      -- ^ Controls whether a @<program>.tix@ file is read at
      -- the start of execution to initialize the RTS internal
      -- HPC datastructures.
    , HpcFlags -> Bool
writeTixFile :: Bool
      -- ^ Controls whether the @<program>.tix@ file should be
      -- written after the execution of the program.
    }
    deriving (Int -> HpcFlags -> ShowS
[HpcFlags] -> ShowS
HpcFlags -> String
(Int -> HpcFlags -> ShowS)
-> (HpcFlags -> String) -> ([HpcFlags] -> ShowS) -> Show HpcFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HpcFlags -> ShowS
showsPrec :: Int -> HpcFlags -> ShowS
$cshow :: HpcFlags -> String
show :: HpcFlags -> String
$cshowList :: [HpcFlags] -> ShowS
showList :: [HpcFlags] -> ShowS
Show -- ^ @since base-4.20.0.0
             , (forall x. HpcFlags -> Rep HpcFlags x)
-> (forall x. Rep HpcFlags x -> HpcFlags) -> Generic HpcFlags
forall x. Rep HpcFlags x -> HpcFlags
forall x. HpcFlags -> Rep HpcFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HpcFlags -> Rep HpcFlags x
from :: forall x. HpcFlags -> Rep HpcFlags x
$cto :: forall x. Rep HpcFlags x -> HpcFlags
to :: forall x. Rep HpcFlags x -> HpcFlags
Generic -- ^ @since base-4.20.0.0
             )
-- | Parameters of the runtime system
--
-- @since base-4.8.0.0
data RTSFlags = RTSFlags
    { RTSFlags -> GCFlags
gcFlags         :: GCFlags
    , RTSFlags -> ConcFlags
concurrentFlags :: ConcFlags
    , RTSFlags -> MiscFlags
miscFlags       :: MiscFlags
    , RTSFlags -> DebugFlags
debugFlags      :: DebugFlags
    , RTSFlags -> CCFlags
costCentreFlags :: CCFlags
    , RTSFlags -> ProfFlags
profilingFlags  :: ProfFlags
    , RTSFlags -> TraceFlags
traceFlags      :: TraceFlags
    , RTSFlags -> TickyFlags
tickyFlags      :: TickyFlags
    , RTSFlags -> ParFlags
parFlags        :: ParFlags
    , RTSFlags -> HpcFlags
hpcFlags        :: HpcFlags
    } deriving ( Int -> RTSFlags -> ShowS
[RTSFlags] -> ShowS
RTSFlags -> String
(Int -> RTSFlags -> ShowS)
-> (RTSFlags -> String) -> ([RTSFlags] -> ShowS) -> Show RTSFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RTSFlags -> ShowS
showsPrec :: Int -> RTSFlags -> ShowS
$cshow :: RTSFlags -> String
show :: RTSFlags -> String
$cshowList :: [RTSFlags] -> ShowS
showList :: [RTSFlags] -> ShowS
Show -- ^ @since base-4.8.0.0
               , (forall x. RTSFlags -> Rep RTSFlags x)
-> (forall x. Rep RTSFlags x -> RTSFlags) -> Generic RTSFlags
forall x. Rep RTSFlags x -> RTSFlags
forall x. RTSFlags -> Rep RTSFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RTSFlags -> Rep RTSFlags x
from :: forall x. RTSFlags -> Rep RTSFlags x
$cto :: forall x. Rep RTSFlags x -> RTSFlags
to :: forall x. Rep RTSFlags x -> RTSFlags
Generic -- ^ @since base-4.15.0.0
               )

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

internal_to_base_RTSFlags :: Internal.RTSFlags -> RTSFlags
internal_to_base_RTSFlags :: RTSFlags -> RTSFlags
internal_to_base_RTSFlags Internal.RTSFlags{HpcFlags
ParFlags
TickyFlags
TraceFlags
ProfFlags
CCFlags
DebugFlags
MiscFlags
ConcFlags
GCFlags
gcFlags :: GCFlags
concurrentFlags :: ConcFlags
miscFlags :: MiscFlags
debugFlags :: DebugFlags
costCentreFlags :: CCFlags
profilingFlags :: ProfFlags
traceFlags :: TraceFlags
tickyFlags :: TickyFlags
parFlags :: ParFlags
hpcFlags :: HpcFlags
hpcFlags :: RTSFlags -> HpcFlags
parFlags :: RTSFlags -> ParFlags
tickyFlags :: RTSFlags -> TickyFlags
traceFlags :: RTSFlags -> TraceFlags
profilingFlags :: RTSFlags -> ProfFlags
costCentreFlags :: RTSFlags -> CCFlags
debugFlags :: RTSFlags -> DebugFlags
miscFlags :: RTSFlags -> MiscFlags
concurrentFlags :: RTSFlags -> ConcFlags
gcFlags :: RTSFlags -> GCFlags
..} =
  RTSFlags{ gcFlags :: GCFlags
gcFlags         = GCFlags -> GCFlags
internal_to_base_GCFlags    GCFlags
gcFlags
          , concurrentFlags :: ConcFlags
concurrentFlags = ConcFlags -> ConcFlags
internal_to_base_ConcFlags  ConcFlags
concurrentFlags
          , miscFlags :: MiscFlags
miscFlags       = MiscFlags -> MiscFlags
internal_to_base_MiscFlags  MiscFlags
miscFlags
          , debugFlags :: DebugFlags
debugFlags      = DebugFlags -> DebugFlags
internal_to_base_DebugFlags DebugFlags
debugFlags
          , costCentreFlags :: CCFlags
costCentreFlags = CCFlags -> CCFlags
internal_to_base_CCFlags    CCFlags
costCentreFlags
          , profilingFlags :: ProfFlags
profilingFlags  = ProfFlags -> ProfFlags
internal_to_base_ProfFlags  ProfFlags
profilingFlags
          , traceFlags :: TraceFlags
traceFlags      = TraceFlags -> TraceFlags
internal_to_base_TraceFlags TraceFlags
traceFlags
          , tickyFlags :: TickyFlags
tickyFlags      = TickyFlags -> TickyFlags
internal_to_base_TickyFlags TickyFlags
tickyFlags
          , parFlags :: ParFlags
parFlags        = ParFlags -> ParFlags
internal_to_base_ParFlags   ParFlags
parFlags
          , hpcFlags :: HpcFlags
hpcFlags        = HpcFlags -> HpcFlags
internal_to_base_HpcFlags   HpcFlags
hpcFlags
          }

internal_to_base_GCFlags :: Internal.GCFlags -> GCFlags
internal_to_base_GCFlags :: GCFlags -> GCFlags
internal_to_base_GCFlags i :: GCFlags
i@Internal.GCFlags{Bool
Double
Maybe String
Word
Word32
RtsTime
GiveGCStats
statsFile :: Maybe String
giveStats :: GiveGCStats
maxStkSize :: Word32
initialStkSize :: Word32
stkChunkSize :: Word32
stkChunkBufferSize :: Word32
maxHeapSize :: Word32
minAllocAreaSize :: Word32
largeAllocLim :: Word32
nurseryChunkSize :: Word32
minOldGenSize :: Word32
heapSizeSuggestion :: Word32
heapSizeSuggestionAuto :: Bool
oldGenFactor :: Double
returnDecayFactor :: Double
pcFreeHeap :: Double
generations :: Word32
squeezeUpdFrames :: Bool
compact :: Bool
compactThreshold :: Double
sweep :: Bool
ringBell :: Bool
idleGCDelayTime :: RtsTime
doIdleGC :: Bool
heapBase :: Word
allocLimitGrace :: Word
numa :: Bool
numaMask :: Word
numaMask :: GCFlags -> Word
numa :: GCFlags -> Bool
allocLimitGrace :: GCFlags -> Word
heapBase :: GCFlags -> Word
doIdleGC :: GCFlags -> Bool
idleGCDelayTime :: GCFlags -> RtsTime
ringBell :: GCFlags -> Bool
sweep :: GCFlags -> Bool
compactThreshold :: GCFlags -> Double
compact :: GCFlags -> Bool
squeezeUpdFrames :: GCFlags -> Bool
generations :: GCFlags -> Word32
pcFreeHeap :: GCFlags -> Double
returnDecayFactor :: GCFlags -> Double
oldGenFactor :: GCFlags -> Double
heapSizeSuggestionAuto :: GCFlags -> Bool
heapSizeSuggestion :: GCFlags -> Word32
minOldGenSize :: GCFlags -> Word32
nurseryChunkSize :: GCFlags -> Word32
largeAllocLim :: GCFlags -> Word32
minAllocAreaSize :: GCFlags -> Word32
maxHeapSize :: GCFlags -> Word32
stkChunkBufferSize :: GCFlags -> Word32
stkChunkSize :: GCFlags -> Word32
initialStkSize :: GCFlags -> Word32
maxStkSize :: GCFlags -> Word32
giveStats :: GCFlags -> GiveGCStats
statsFile :: GCFlags -> Maybe String
..} =
  let give_stats :: GiveGCStats
give_stats = GiveGCStats -> GiveGCStats
internal_to_base_giveStats (GCFlags -> GiveGCStats
Internal.giveStats GCFlags
i)
  in GCFlags{ giveStats :: GiveGCStats
giveStats = GiveGCStats
give_stats, Bool
Double
Maybe String
Word
Word32
RtsTime
statsFile :: Maybe String
maxStkSize :: Word32
initialStkSize :: Word32
stkChunkSize :: Word32
stkChunkBufferSize :: Word32
maxHeapSize :: Word32
minAllocAreaSize :: Word32
largeAllocLim :: Word32
nurseryChunkSize :: Word32
minOldGenSize :: Word32
heapSizeSuggestion :: Word32
heapSizeSuggestionAuto :: Bool
oldGenFactor :: Double
returnDecayFactor :: Double
pcFreeHeap :: Double
generations :: Word32
squeezeUpdFrames :: Bool
compact :: Bool
compactThreshold :: Double
sweep :: Bool
ringBell :: Bool
idleGCDelayTime :: RtsTime
doIdleGC :: Bool
heapBase :: Word
allocLimitGrace :: Word
numa :: Bool
numaMask :: Word
statsFile :: Maybe String
maxStkSize :: Word32
initialStkSize :: Word32
stkChunkSize :: Word32
stkChunkBufferSize :: Word32
maxHeapSize :: Word32
minAllocAreaSize :: Word32
largeAllocLim :: Word32
nurseryChunkSize :: Word32
minOldGenSize :: Word32
heapSizeSuggestion :: Word32
heapSizeSuggestionAuto :: Bool
oldGenFactor :: Double
returnDecayFactor :: Double
pcFreeHeap :: Double
generations :: Word32
squeezeUpdFrames :: Bool
compact :: Bool
compactThreshold :: Double
sweep :: Bool
ringBell :: Bool
idleGCDelayTime :: RtsTime
doIdleGC :: Bool
heapBase :: Word
allocLimitGrace :: Word
numa :: Bool
numaMask :: Word
.. }
  where
    internal_to_base_giveStats :: Internal.GiveGCStats -> GiveGCStats
    internal_to_base_giveStats :: GiveGCStats -> GiveGCStats
internal_to_base_giveStats GiveGCStats
Internal.NoGCStats      = GiveGCStats
NoGCStats
    internal_to_base_giveStats GiveGCStats
Internal.CollectGCStats = GiveGCStats
CollectGCStats
    internal_to_base_giveStats GiveGCStats
Internal.OneLineGCStats = GiveGCStats
OneLineGCStats
    internal_to_base_giveStats GiveGCStats
Internal.SummaryGCStats = GiveGCStats
SummaryGCStats
    internal_to_base_giveStats GiveGCStats
Internal.VerboseGCStats = GiveGCStats
VerboseGCStats

internal_to_base_ParFlags :: Internal.ParFlags -> ParFlags
internal_to_base_ParFlags :: ParFlags -> ParFlags
internal_to_base_ParFlags Internal.ParFlags{Bool
Word32
nCapabilities :: Word32
migrate :: Bool
maxLocalSparks :: Word32
parGcEnabled :: Bool
parGcGen :: Word32
parGcLoadBalancingEnabled :: Bool
parGcLoadBalancingGen :: Word32
parGcNoSyncWithIdle :: Word32
parGcThreads :: Word32
setAffinity :: Bool
setAffinity :: ParFlags -> Bool
parGcThreads :: ParFlags -> Word32
parGcNoSyncWithIdle :: ParFlags -> Word32
parGcLoadBalancingGen :: ParFlags -> Word32
parGcLoadBalancingEnabled :: ParFlags -> Bool
parGcGen :: ParFlags -> Word32
parGcEnabled :: ParFlags -> Bool
maxLocalSparks :: ParFlags -> Word32
migrate :: ParFlags -> Bool
nCapabilities :: ParFlags -> Word32
..} = ParFlags{Bool
Word32
nCapabilities :: Word32
migrate :: Bool
maxLocalSparks :: Word32
parGcEnabled :: Bool
parGcGen :: Word32
parGcLoadBalancingEnabled :: Bool
parGcLoadBalancingGen :: Word32
parGcNoSyncWithIdle :: Word32
parGcThreads :: Word32
setAffinity :: Bool
nCapabilities :: Word32
migrate :: Bool
maxLocalSparks :: Word32
parGcEnabled :: Bool
parGcGen :: Word32
parGcLoadBalancingEnabled :: Bool
parGcLoadBalancingGen :: Word32
parGcNoSyncWithIdle :: Word32
parGcThreads :: Word32
setAffinity :: Bool
..}

internal_to_base_HpcFlags :: Internal.HpcFlags -> HpcFlags
internal_to_base_HpcFlags :: HpcFlags -> HpcFlags
internal_to_base_HpcFlags Internal.HpcFlags{Bool
readTixFile :: Bool
writeTixFile :: Bool
writeTixFile :: HpcFlags -> Bool
readTixFile :: HpcFlags -> Bool
..} = HpcFlags{Bool
readTixFile :: Bool
writeTixFile :: Bool
readTixFile :: Bool
writeTixFile :: Bool
..}

internal_to_base_ConcFlags :: Internal.ConcFlags -> ConcFlags
internal_to_base_ConcFlags :: ConcFlags -> ConcFlags
internal_to_base_ConcFlags Internal.ConcFlags{Int
RtsTime
ctxtSwitchTime :: RtsTime
ctxtSwitchTicks :: Int
ctxtSwitchTicks :: ConcFlags -> Int
ctxtSwitchTime :: ConcFlags -> RtsTime
..} = ConcFlags{Int
RtsTime
ctxtSwitchTime :: RtsTime
ctxtSwitchTicks :: Int
ctxtSwitchTime :: RtsTime
ctxtSwitchTicks :: Int
..}

internal_to_base_MiscFlags :: Internal.MiscFlags -> MiscFlags
internal_to_base_MiscFlags :: MiscFlags -> MiscFlags
internal_to_base_MiscFlags i :: MiscFlags
i@Internal.MiscFlags{Bool
Word
Word32
RtsTime
IoManagerFlag
tickInterval :: RtsTime
installSignalHandlers :: Bool
installSEHHandlers :: Bool
generateCrashDumpFile :: Bool
generateStackTrace :: Bool
machineReadable :: Bool
disableDelayedOsMemoryReturn :: Bool
internalCounters :: Bool
linkerAlwaysPic :: Bool
linkerMemBase :: Word
ioManager :: IoManagerFlag
numIoWorkerThreads :: Word32
numIoWorkerThreads :: MiscFlags -> Word32
ioManager :: MiscFlags -> IoManagerFlag
linkerMemBase :: MiscFlags -> Word
linkerAlwaysPic :: MiscFlags -> Bool
internalCounters :: MiscFlags -> Bool
disableDelayedOsMemoryReturn :: MiscFlags -> Bool
machineReadable :: MiscFlags -> Bool
generateStackTrace :: MiscFlags -> Bool
generateCrashDumpFile :: MiscFlags -> Bool
installSEHHandlers :: MiscFlags -> Bool
installSignalHandlers :: MiscFlags -> Bool
tickInterval :: MiscFlags -> RtsTime
..} =
  let io_manager :: IoManagerFlag
io_manager = IoManagerFlag -> IoManagerFlag
internal_to_base_ioManager (MiscFlags -> IoManagerFlag
Internal.ioManager MiscFlags
i)
  in MiscFlags{ ioManager :: IoManagerFlag
ioManager = IoManagerFlag
io_manager, Bool
Word
Word32
RtsTime
tickInterval :: RtsTime
installSignalHandlers :: Bool
installSEHHandlers :: Bool
generateCrashDumpFile :: Bool
generateStackTrace :: Bool
machineReadable :: Bool
disableDelayedOsMemoryReturn :: Bool
internalCounters :: Bool
linkerAlwaysPic :: Bool
linkerMemBase :: Word
numIoWorkerThreads :: Word32
tickInterval :: RtsTime
installSignalHandlers :: Bool
installSEHHandlers :: Bool
generateCrashDumpFile :: Bool
generateStackTrace :: Bool
machineReadable :: Bool
disableDelayedOsMemoryReturn :: Bool
internalCounters :: Bool
linkerAlwaysPic :: Bool
linkerMemBase :: Word
numIoWorkerThreads :: Word32
..}
  where
    internal_to_base_ioManager :: Internal.IoManagerFlag -> IoManagerFlag
    internal_to_base_ioManager :: IoManagerFlag -> IoManagerFlag
internal_to_base_ioManager IoManagerFlag
Internal.IoManagerFlagAuto        = IoManagerFlag
IoManagerFlagAuto
    internal_to_base_ioManager IoManagerFlag
Internal.IoManagerFlagSelect      = IoManagerFlag
IoManagerFlagSelect
    internal_to_base_ioManager IoManagerFlag
Internal.IoManagerFlagMIO         = IoManagerFlag
IoManagerFlagMIO
    internal_to_base_ioManager IoManagerFlag
Internal.IoManagerFlagWinIO       = IoManagerFlag
IoManagerFlagWinIO
    internal_to_base_ioManager IoManagerFlag
Internal.IoManagerFlagWin32Legacy = IoManagerFlag
IoManagerFlagWin32Legacy

internal_to_base_DebugFlags :: Internal.DebugFlags -> DebugFlags
internal_to_base_DebugFlags :: DebugFlags -> DebugFlags
internal_to_base_DebugFlags Internal.DebugFlags{Bool
scheduler :: Bool
interpreter :: Bool
weak :: Bool
gccafs :: Bool
gc :: Bool
nonmoving_gc :: Bool
block_alloc :: Bool
sanity :: Bool
stable :: Bool
prof :: Bool
linker :: Bool
apply :: Bool
stm :: Bool
squeeze :: Bool
hpc :: Bool
sparks :: Bool
sparks :: DebugFlags -> Bool
hpc :: DebugFlags -> Bool
squeeze :: DebugFlags -> Bool
stm :: DebugFlags -> Bool
apply :: DebugFlags -> Bool
linker :: DebugFlags -> Bool
prof :: DebugFlags -> Bool
stable :: DebugFlags -> Bool
sanity :: DebugFlags -> Bool
block_alloc :: DebugFlags -> Bool
nonmoving_gc :: DebugFlags -> Bool
gc :: DebugFlags -> Bool
gccafs :: DebugFlags -> Bool
weak :: DebugFlags -> Bool
interpreter :: DebugFlags -> Bool
scheduler :: DebugFlags -> Bool
..} = DebugFlags{Bool
scheduler :: Bool
interpreter :: Bool
weak :: Bool
gccafs :: Bool
gc :: Bool
nonmoving_gc :: Bool
block_alloc :: Bool
sanity :: Bool
stable :: Bool
prof :: Bool
linker :: Bool
apply :: Bool
stm :: Bool
squeeze :: Bool
hpc :: Bool
sparks :: Bool
scheduler :: Bool
interpreter :: Bool
weak :: Bool
gccafs :: Bool
gc :: Bool
nonmoving_gc :: Bool
block_alloc :: Bool
sanity :: Bool
stable :: Bool
prof :: Bool
linker :: Bool
apply :: Bool
stm :: Bool
squeeze :: Bool
hpc :: Bool
sparks :: Bool
..}

internal_to_base_CCFlags :: Internal.CCFlags -> CCFlags
internal_to_base_CCFlags :: CCFlags -> CCFlags
internal_to_base_CCFlags i :: CCFlags
i@Internal.CCFlags{Int
DoCostCentres
doCostCentres :: DoCostCentres
profilerTicks :: Int
msecsPerTick :: Int
msecsPerTick :: CCFlags -> Int
profilerTicks :: CCFlags -> Int
doCostCentres :: CCFlags -> DoCostCentres
..} =
  let do_cost_centres :: DoCostCentres
do_cost_centres = DoCostCentres -> DoCostCentres
internal_to_base_costCentres (CCFlags -> DoCostCentres
Internal.doCostCentres CCFlags
i)
  in CCFlags{ doCostCentres :: DoCostCentres
doCostCentres = DoCostCentres
do_cost_centres, Int
profilerTicks :: Int
msecsPerTick :: Int
profilerTicks :: Int
msecsPerTick :: Int
..}
  where
    internal_to_base_costCentres :: Internal.DoCostCentres -> DoCostCentres
    internal_to_base_costCentres :: DoCostCentres -> DoCostCentres
internal_to_base_costCentres DoCostCentres
Internal.CostCentresNone    = DoCostCentres
CostCentresNone
    internal_to_base_costCentres DoCostCentres
Internal.CostCentresSummary = DoCostCentres
CostCentresSummary
    internal_to_base_costCentres DoCostCentres
Internal.CostCentresVerbose = DoCostCentres
CostCentresVerbose
    internal_to_base_costCentres DoCostCentres
Internal.CostCentresAll     = DoCostCentres
CostCentresAll
    internal_to_base_costCentres DoCostCentres
Internal.CostCentresJSON    = DoCostCentres
CostCentresJSON

internal_to_base_ProfFlags :: Internal.ProfFlags -> ProfFlags
internal_to_base_ProfFlags :: ProfFlags -> ProfFlags
internal_to_base_ProfFlags i :: ProfFlags
i@Internal.ProfFlags{Bool
Maybe String
Word
RtsTime
DoHeapProfile
doHeapProfile :: DoHeapProfile
heapProfileInterval :: RtsTime
heapProfileIntervalTicks :: Word
startHeapProfileAtStartup :: Bool
startTimeProfileAtStartup :: Bool
showCCSOnException :: Bool
automaticEraIncrement :: Bool
maxRetainerSetSize :: Word
ccsLength :: Word
modSelector :: Maybe String
descrSelector :: Maybe String
typeSelector :: Maybe String
ccSelector :: Maybe String
ccsSelector :: Maybe String
retainerSelector :: Maybe String
bioSelector :: Maybe String
eraSelector :: Word
eraSelector :: ProfFlags -> Word
bioSelector :: ProfFlags -> Maybe String
retainerSelector :: ProfFlags -> Maybe String
ccsSelector :: ProfFlags -> Maybe String
ccSelector :: ProfFlags -> Maybe String
typeSelector :: ProfFlags -> Maybe String
descrSelector :: ProfFlags -> Maybe String
modSelector :: ProfFlags -> Maybe String
ccsLength :: ProfFlags -> Word
maxRetainerSetSize :: ProfFlags -> Word
automaticEraIncrement :: ProfFlags -> Bool
showCCSOnException :: ProfFlags -> Bool
startTimeProfileAtStartup :: ProfFlags -> Bool
startHeapProfileAtStartup :: ProfFlags -> Bool
heapProfileIntervalTicks :: ProfFlags -> Word
heapProfileInterval :: ProfFlags -> RtsTime
doHeapProfile :: ProfFlags -> DoHeapProfile
..} =
  let do_heap_profile :: DoHeapProfile
do_heap_profile = DoHeapProfile -> DoHeapProfile
internal_to_base_doHeapProfile (ProfFlags -> DoHeapProfile
Internal.doHeapProfile ProfFlags
i)
  in ProfFlags{ doHeapProfile :: DoHeapProfile
doHeapProfile = DoHeapProfile
do_heap_profile,Bool
Maybe String
Word
RtsTime
heapProfileInterval :: RtsTime
heapProfileIntervalTicks :: Word
startHeapProfileAtStartup :: Bool
startTimeProfileAtStartup :: Bool
showCCSOnException :: Bool
automaticEraIncrement :: Bool
maxRetainerSetSize :: Word
ccsLength :: Word
modSelector :: Maybe String
descrSelector :: Maybe String
typeSelector :: Maybe String
ccSelector :: Maybe String
ccsSelector :: Maybe String
retainerSelector :: Maybe String
bioSelector :: Maybe String
eraSelector :: Word
heapProfileInterval :: RtsTime
heapProfileIntervalTicks :: Word
startHeapProfileAtStartup :: Bool
startTimeProfileAtStartup :: Bool
showCCSOnException :: Bool
automaticEraIncrement :: Bool
maxRetainerSetSize :: Word
ccsLength :: Word
modSelector :: Maybe String
descrSelector :: Maybe String
typeSelector :: Maybe String
ccSelector :: Maybe String
ccsSelector :: Maybe String
retainerSelector :: Maybe String
bioSelector :: Maybe String
eraSelector :: Word
..}
  where
    internal_to_base_doHeapProfile :: Internal.DoHeapProfile -> DoHeapProfile
    internal_to_base_doHeapProfile :: DoHeapProfile -> DoHeapProfile
internal_to_base_doHeapProfile DoHeapProfile
Internal.NoHeapProfiling   = DoHeapProfile
NoHeapProfiling
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByCCS         = DoHeapProfile
HeapByCCS
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByMod         = DoHeapProfile
HeapByMod
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByDescr       = DoHeapProfile
HeapByDescr
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByType        = DoHeapProfile
HeapByType
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByRetainer    = DoHeapProfile
HeapByRetainer
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByLDV         = DoHeapProfile
HeapByLDV
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByClosureType = DoHeapProfile
HeapByClosureType
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByInfoTable   = DoHeapProfile
HeapByInfoTable
    internal_to_base_doHeapProfile DoHeapProfile
Internal.HeapByEra         = DoHeapProfile
HeapByEra

internal_to_base_TraceFlags :: Internal.TraceFlags -> TraceFlags
internal_to_base_TraceFlags :: TraceFlags -> TraceFlags
internal_to_base_TraceFlags i :: TraceFlags
i@Internal.TraceFlags{Bool
DoTrace
tracing :: DoTrace
timestamp :: Bool
traceScheduler :: Bool
traceGc :: Bool
traceNonmovingGc :: Bool
sparksSampled :: Bool
sparksFull :: Bool
user :: Bool
user :: TraceFlags -> Bool
sparksFull :: TraceFlags -> Bool
sparksSampled :: TraceFlags -> Bool
traceNonmovingGc :: TraceFlags -> Bool
traceGc :: TraceFlags -> Bool
traceScheduler :: TraceFlags -> Bool
timestamp :: TraceFlags -> Bool
tracing :: TraceFlags -> DoTrace
..} =
  let do_trace :: DoTrace
do_trace = DoTrace -> DoTrace
internal_to_base_doTrace (TraceFlags -> DoTrace
Internal.tracing TraceFlags
i)
  in TraceFlags{ tracing :: DoTrace
tracing = DoTrace
do_trace,Bool
timestamp :: Bool
traceScheduler :: Bool
traceGc :: Bool
traceNonmovingGc :: Bool
sparksSampled :: Bool
sparksFull :: Bool
user :: Bool
timestamp :: Bool
traceScheduler :: Bool
traceGc :: Bool
traceNonmovingGc :: Bool
sparksSampled :: Bool
sparksFull :: Bool
user :: Bool
..}
  where
    internal_to_base_doTrace :: Internal.DoTrace -> DoTrace
    internal_to_base_doTrace :: DoTrace -> DoTrace
internal_to_base_doTrace DoTrace
Internal.TraceNone     = DoTrace
TraceNone
    internal_to_base_doTrace DoTrace
Internal.TraceEventLog = DoTrace
TraceEventLog
    internal_to_base_doTrace DoTrace
Internal.TraceStderr   = DoTrace
TraceStderr

internal_to_base_TickyFlags :: Internal.TickyFlags -> TickyFlags
internal_to_base_TickyFlags :: TickyFlags -> TickyFlags
internal_to_base_TickyFlags Internal.TickyFlags{Bool
Maybe String
showTickyStats :: Bool
tickyFile :: Maybe String
tickyFile :: TickyFlags -> Maybe String
showTickyStats :: TickyFlags -> Bool
..} = TickyFlags{Bool
Maybe String
showTickyStats :: Bool
tickyFile :: Maybe String
showTickyStats :: Bool
tickyFile :: Maybe String
..}

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

getRTSFlags :: IO RTSFlags
getRTSFlags :: IO RTSFlags
getRTSFlags = RTSFlags -> RTSFlags
internal_to_base_RTSFlags (RTSFlags -> RTSFlags) -> IO RTSFlags -> IO RTSFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSFlags
Internal.getRTSFlags

getGCFlags :: IO GCFlags
getGCFlags :: IO GCFlags
getGCFlags = GCFlags -> GCFlags
internal_to_base_GCFlags (GCFlags -> GCFlags) -> IO GCFlags -> IO GCFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO GCFlags
Internal.getGCFlags

getParFlags :: IO ParFlags
getParFlags :: IO ParFlags
getParFlags = ParFlags -> ParFlags
internal_to_base_ParFlags (ParFlags -> ParFlags) -> IO ParFlags -> IO ParFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ParFlags
Internal.getParFlags

getHpcFlags :: IO HpcFlags
getHpcFlags :: IO HpcFlags
getHpcFlags = HpcFlags -> HpcFlags
internal_to_base_HpcFlags (HpcFlags -> HpcFlags) -> IO HpcFlags -> IO HpcFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO HpcFlags
Internal.getHpcFlags

getConcFlags :: IO ConcFlags
getConcFlags :: IO ConcFlags
getConcFlags =  ConcFlags -> ConcFlags
internal_to_base_ConcFlags (ConcFlags -> ConcFlags) -> IO ConcFlags -> IO ConcFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ConcFlags
Internal.getConcFlags

{-# INLINEABLE getMiscFlags #-}
getMiscFlags :: IO MiscFlags
getMiscFlags :: IO MiscFlags
getMiscFlags = MiscFlags -> MiscFlags
internal_to_base_MiscFlags (MiscFlags -> MiscFlags) -> IO MiscFlags -> IO MiscFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO MiscFlags
Internal.getMiscFlags

getDebugFlags :: IO DebugFlags
getDebugFlags :: IO DebugFlags
getDebugFlags = DebugFlags -> DebugFlags
internal_to_base_DebugFlags (DebugFlags -> DebugFlags) -> IO DebugFlags -> IO DebugFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DebugFlags
Internal.getDebugFlags

getCCFlags :: IO CCFlags
getCCFlags :: IO CCFlags
getCCFlags = CCFlags -> CCFlags
internal_to_base_CCFlags (CCFlags -> CCFlags) -> IO CCFlags -> IO CCFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CCFlags
Internal.getCCFlags

getProfFlags :: IO ProfFlags
getProfFlags :: IO ProfFlags
getProfFlags = ProfFlags -> ProfFlags
internal_to_base_ProfFlags (ProfFlags -> ProfFlags) -> IO ProfFlags -> IO ProfFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProfFlags
Internal.getProfFlags

getTraceFlags :: IO TraceFlags
getTraceFlags :: IO TraceFlags
getTraceFlags = TraceFlags -> TraceFlags
internal_to_base_TraceFlags (TraceFlags -> TraceFlags) -> IO TraceFlags -> IO TraceFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TraceFlags
Internal.getTraceFlags

getTickyFlags :: IO TickyFlags
getTickyFlags :: IO TickyFlags
getTickyFlags = TickyFlags -> TickyFlags
internal_to_base_TickyFlags (TickyFlags -> TickyFlags) -> IO TickyFlags -> IO TickyFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TickyFlags
Internal.getTickyFlags