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

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

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

-- | 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
<= ClosureType
ct Bool -> Bool -> Bool
&& ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Ord a => a -> a -> Bool
<= ClosureType
THUNK_0_2 -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
== ClosureType
THUNK_SELECTOR -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
== ClosureType
AP -> Int
thunkHeader
        ClosureType
ct | ClosureType
ct ClosureType -> ClosureType -> Bool
forall a. Eq a => a -> a -> Bool
== ClosureType
AP_STACK -> Int
thunkHeader
        ClosureType
_ -> Int
header
  where
    header :: Int
header = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prof
    thunkHeader :: Int
thunkHeader = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prof
#if defined(PROFILING)
    prof = 2
#else
    prof :: Int
prof = Int
0
#endif