{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}

module GHC.Exts.Heap.ClosureTypes
    ( ClosureType(..)
    , closureTypeHeaderSize
    ) where

import Prelude -- See note [Why do we import Prelude here?]
import GHC.Generics

{- ---------------------------------------------
-- Enum representing closure types
-- This is a mirror of:
-- includes/rts/storage/ClosureTypes.h
-- ---------------------------------------------}

data ClosureType
    = INVALID_OBJECT
    | CONSTR
    | CONSTR_1_0
    | CONSTR_0_1
    | CONSTR_2_0
    | CONSTR_1_1
    | CONSTR_0_2
    | CONSTR_NOCAF
    | FUN
    | FUN_1_0
    | FUN_0_1
    | FUN_2_0
    | FUN_1_1
    | FUN_0_2
    | FUN_STATIC
    | THUNK
    | THUNK_1_0
    | THUNK_0_1
    | THUNK_2_0
    | THUNK_1_1
    | THUNK_0_2
    | THUNK_STATIC
    | THUNK_SELECTOR
    | BCO
    | AP
    | PAP
    | AP_STACK
    | IND
    | IND_STATIC
    | RET_BCO
    | RET_SMALL
    | RET_BIG
    | RET_FUN
    | UPDATE_FRAME
    | CATCH_FRAME
    | UNDERFLOW_FRAME
    | STOP_FRAME
    | BLOCKING_QUEUE
    | BLACKHOLE
    | MVAR_CLEAN
    | MVAR_DIRTY
    | TVAR
    | ARR_WORDS
    | MUT_ARR_PTRS_CLEAN
    | MUT_ARR_PTRS_DIRTY
    | MUT_ARR_PTRS_FROZEN_DIRTY
    | MUT_ARR_PTRS_FROZEN_CLEAN
    | MUT_VAR_CLEAN
    | MUT_VAR_DIRTY
    | WEAK
    | PRIM
    | MUT_PRIM
    | TSO
    | STACK
    | TREC_CHUNK
    | ATOMICALLY_FRAME
    | CATCH_RETRY_FRAME
    | CATCH_STM_FRAME
    | WHITEHOLE
    | SMALL_MUT_ARR_PTRS_CLEAN
    | SMALL_MUT_ARR_PTRS_DIRTY
    | SMALL_MUT_ARR_PTRS_FROZEN_DIRTY
    | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN
    | COMPACT_NFDATA
    | N_CLOSURE_TYPES
 deriving (Int -> ClosureType
ClosureType -> Int
ClosureType -> [ClosureType]
ClosureType -> ClosureType
ClosureType -> ClosureType -> [ClosureType]
ClosureType -> ClosureType -> ClosureType -> [ClosureType]
(ClosureType -> ClosureType)
-> (ClosureType -> ClosureType)
-> (Int -> ClosureType)
-> (ClosureType -> Int)
-> (ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> [ClosureType])
-> (ClosureType -> ClosureType -> ClosureType -> [ClosureType])
-> Enum ClosureType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
$cenumFromThenTo :: ClosureType -> ClosureType -> ClosureType -> [ClosureType]
enumFromTo :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromTo :: ClosureType -> ClosureType -> [ClosureType]
enumFromThen :: ClosureType -> ClosureType -> [ClosureType]
$cenumFromThen :: ClosureType -> ClosureType -> [ClosureType]
enumFrom :: ClosureType -> [ClosureType]
$cenumFrom :: ClosureType -> [ClosureType]
fromEnum :: ClosureType -> Int
$cfromEnum :: ClosureType -> Int
toEnum :: Int -> ClosureType
$ctoEnum :: Int -> ClosureType
pred :: ClosureType -> ClosureType
$cpred :: ClosureType -> ClosureType
succ :: ClosureType -> ClosureType
$csucc :: ClosureType -> ClosureType
External instance of the constraint type Enum Int
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
Enum, ClosureType -> ClosureType -> Bool
(ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool) -> Eq ClosureType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClosureType -> ClosureType -> Bool
$c/= :: ClosureType -> ClosureType -> Bool
== :: ClosureType -> ClosureType -> Bool
$c== :: ClosureType -> ClosureType -> Bool
Eq, Eq ClosureType
Eq ClosureType
-> (ClosureType -> ClosureType -> Ordering)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> Bool)
-> (ClosureType -> ClosureType -> ClosureType)
-> (ClosureType -> ClosureType -> ClosureType)
-> Ord ClosureType
ClosureType -> ClosureType -> Bool
ClosureType -> ClosureType -> Ordering
ClosureType -> ClosureType -> ClosureType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClosureType -> ClosureType -> ClosureType
$cmin :: ClosureType -> ClosureType -> ClosureType
max :: ClosureType -> ClosureType -> ClosureType
$cmax :: ClosureType -> ClosureType -> ClosureType
>= :: ClosureType -> ClosureType -> Bool
$c>= :: ClosureType -> ClosureType -> Bool
> :: ClosureType -> ClosureType -> Bool
$c> :: ClosureType -> ClosureType -> Bool
<= :: ClosureType -> ClosureType -> Bool
$c<= :: ClosureType -> ClosureType -> Bool
< :: ClosureType -> ClosureType -> Bool
$c< :: ClosureType -> ClosureType -> Bool
compare :: ClosureType -> ClosureType -> Ordering
$ccompare :: ClosureType -> ClosureType -> Ordering
Instance of class: Eq of the constraint type Eq ClosureType
Instance of class: Ord of the constraint type Ord ClosureType
Instance of class: Eq of the constraint type Eq ClosureType
Ord, Int -> ClosureType -> ShowS
[ClosureType] -> ShowS
ClosureType -> String
(Int -> ClosureType -> ShowS)
-> (ClosureType -> String)
-> ([ClosureType] -> ShowS)
-> Show ClosureType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClosureType] -> ShowS
$cshowList :: [ClosureType] -> ShowS
show :: ClosureType -> String
$cshow :: ClosureType -> String
showsPrec :: Int -> ClosureType -> ShowS
$cshowsPrec :: Int -> ClosureType -> ShowS
Show, (forall x. ClosureType -> Rep ClosureType x)
-> (forall x. Rep ClosureType x -> ClosureType)
-> Generic ClosureType
forall x. Rep ClosureType x -> ClosureType
forall x. ClosureType -> Rep ClosureType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClosureType x -> ClosureType
$cfrom :: forall x. ClosureType -> Rep ClosureType x
Generic)

-- | Return the size of the closures header in words
closureTypeHeaderSize :: ClosureType -> Int
closureTypeHeaderSize :: ClosureType -> Int
closureTypeHeaderSize ClosureType
closType =
    case ClosureType
closType of
        ClosureType
ct | ClosureType
THUNK ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
Instance of class: Ord of the constraint type Ord ClosureType
<= ClosureType
ct Bool -> Bool -> Bool
&& ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
Instance of class: Ord of the constraint type Ord ClosureType
<= ClosureType
THUNK_0_2 -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq ClosureType
== ClosureType
THUNK_SELECTOR -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq ClosureType
== ClosureType
AP -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
Instance of class: Eq of the constraint type Eq ClosureType
== ClosureType
AP_STACK -> Int
thunkHeader
        ClosureType
_ -> Int
header
  where
    header :: Int
header = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
prof
    thunkHeader :: Int
thunkHeader = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
prof
#if defined(PROFILING)
    prof = 2
#else
    prof :: Int
prof = Int
0
#endif