-- | Platform profiles
module GHC.Platform.Profile
   ( Profile (..)
   , profileBuildTag
   , profileConstants
   , profileIsProfiling
   , profileWordSizeInBytes
   )
where

import GHC.Prelude

import GHC.Platform
import GHC.Platform.Ways

-- | A platform profile fully describes the kind of objects that are generated
-- for a platform.
--
-- 'Platform' doesn't fully describe the ABI of an object. Compiler ways
-- (profiling, debug, dynamic) also modify the ABI.
--
data Profile = Profile
   { Profile -> Platform
profilePlatform :: !Platform -- ^ Platform
   , Profile -> Ways
profileWays     :: !Ways     -- ^ Ways
   }

-- | Get platform constants
profileConstants :: Profile -> PlatformConstants
{-# INLINE profileConstants #-}
profileConstants :: Profile -> PlatformConstants
profileConstants Profile
profile = Platform -> PlatformConstants
platformConstants (Profile -> Platform
profilePlatform Profile
profile)

-- | Is profiling enabled
profileIsProfiling :: Profile -> Bool
{-# INLINE profileIsProfiling #-}
profileIsProfiling :: Profile -> Bool
profileIsProfiling Profile
profile = Profile -> Ways
profileWays Profile
profile Ways -> Way -> Bool
`hasWay` Way
WayProf

-- | Word size in bytes
profileWordSizeInBytes :: Profile -> Int
{-# INLINE profileWordSizeInBytes #-}
profileWordSizeInBytes :: Profile -> Int
profileWordSizeInBytes Profile
profile = Platform -> Int
platformWordSizeInBytes (Profile -> Platform
profilePlatform Profile
profile)

-- | Unique build tag for the profile
profileBuildTag :: Profile -> String
profileBuildTag :: Profile -> String
profileBuildTag Profile
profile
    -- profiles using unregisterised convention are not binary compatible with
    -- those that don't. Make sure to make it apparent in the tag so that our
    -- interface files can't be mismatched by mistake.
  | Platform -> Bool
platformUnregisterised Platform
platform = Char
'u'forall a. a -> [a] -> [a]
:String
wayTag
  | Bool
otherwise                       =     String
wayTag
  where
   platform :: Platform
platform = Profile -> Platform
profilePlatform Profile
profile
   wayTag :: String
wayTag   = Ways -> String
waysBuildTag (Profile -> Ways
profileWays Profile
profile)