{-# LANGUAGE ScopedTypeVariables #-}
module GHC.Platform
( Platform (..)
, PlatformWordSize(..)
, PlatformConstants(..)
, platformArch
, platformOS
, ArchOS(..)
, Arch(..)
, OS(..)
, ArmISA(..)
, ArmISAExt(..)
, ArmABI(..)
, PPC_64ABI(..)
, ByteOrder(..)
, target32Bit
, isARM
, osElfTarget
, osMachOTarget
, osSubsectionsViaSymbols
, platformUsesFrameworks
, platformWordSizeInBytes
, platformWordSizeInBits
, platformMinInt
, platformMaxInt
, platformMaxWord
, platformInIntRange
, platformInWordRange
, platformCConvNeedsExtension
, PlatformMisc(..)
, SseVersion (..)
, BmiVersion (..)
, platformSOName
, platformHsSOName
, platformSOExt
)
where
import Prelude
import GHC.Read
import GHC.ByteOrder (ByteOrder(..))
import GHC.Platform.Constants
import GHC.Platform.ArchOS
import Data.Word
import Data.Int
import System.FilePath
data Platform = Platform
{ Platform -> ArchOS
platformArchOS :: !ArchOS
, Platform -> PlatformWordSize
platformWordSize :: !PlatformWordSize
, Platform -> ByteOrder
platformByteOrder :: !ByteOrder
, Platform -> Bool
platformUnregisterised :: !Bool
, Platform -> Bool
platformHasGnuNonexecStack :: !Bool
, Platform -> Bool
platformHasIdentDirective :: !Bool
, Platform -> Bool
platformHasSubsectionsViaSymbols :: !Bool
, Platform -> Bool
platformIsCrossCompiling :: !Bool
, Platform -> Bool
platformLeadingUnderscore :: !Bool
, Platform -> Bool
platformTablesNextToCode :: !Bool
, Platform -> PlatformConstants
platformConstants :: !PlatformConstants
}
deriving (ReadPrec [Platform]
ReadPrec Platform
Int -> ReadS Platform
ReadS [Platform]
(Int -> ReadS Platform)
-> ReadS [Platform]
-> ReadPrec Platform
-> ReadPrec [Platform]
-> Read Platform
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Platform]
$creadListPrec :: ReadPrec [Platform]
readPrec :: ReadPrec Platform
$creadPrec :: ReadPrec Platform
readList :: ReadS [Platform]
$creadList :: ReadS [Platform]
readsPrec :: Int -> ReadS Platform
$creadsPrec :: Int -> ReadS Platform
Read, Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
(Int -> Platform -> ShowS)
-> (Platform -> String) -> ([Platform] -> ShowS) -> Show Platform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Platform] -> ShowS
$cshowList :: [Platform] -> ShowS
show :: Platform -> String
$cshow :: Platform -> String
showsPrec :: Int -> Platform -> ShowS
$cshowsPrec :: Int -> Platform -> ShowS
Show, Platform -> Platform -> Bool
(Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool) -> Eq Platform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c== :: Platform -> Platform -> Bool
Eq)
data PlatformWordSize
= PW4
| PW8
deriving (PlatformWordSize -> PlatformWordSize -> Bool
(PlatformWordSize -> PlatformWordSize -> Bool)
-> (PlatformWordSize -> PlatformWordSize -> Bool)
-> Eq PlatformWordSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlatformWordSize -> PlatformWordSize -> Bool
$c/= :: PlatformWordSize -> PlatformWordSize -> Bool
== :: PlatformWordSize -> PlatformWordSize -> Bool
$c== :: PlatformWordSize -> PlatformWordSize -> Bool
Eq, Eq PlatformWordSize
Eq PlatformWordSize
-> (PlatformWordSize -> PlatformWordSize -> Ordering)
-> (PlatformWordSize -> PlatformWordSize -> Bool)
-> (PlatformWordSize -> PlatformWordSize -> Bool)
-> (PlatformWordSize -> PlatformWordSize -> Bool)
-> (PlatformWordSize -> PlatformWordSize -> Bool)
-> (PlatformWordSize -> PlatformWordSize -> PlatformWordSize)
-> (PlatformWordSize -> PlatformWordSize -> PlatformWordSize)
-> Ord PlatformWordSize
PlatformWordSize -> PlatformWordSize -> Bool
PlatformWordSize -> PlatformWordSize -> Ordering
PlatformWordSize -> PlatformWordSize -> PlatformWordSize
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 :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
$cmin :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
max :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
$cmax :: PlatformWordSize -> PlatformWordSize -> PlatformWordSize
>= :: PlatformWordSize -> PlatformWordSize -> Bool
$c>= :: PlatformWordSize -> PlatformWordSize -> Bool
> :: PlatformWordSize -> PlatformWordSize -> Bool
$c> :: PlatformWordSize -> PlatformWordSize -> Bool
<= :: PlatformWordSize -> PlatformWordSize -> Bool
$c<= :: PlatformWordSize -> PlatformWordSize -> Bool
< :: PlatformWordSize -> PlatformWordSize -> Bool
$c< :: PlatformWordSize -> PlatformWordSize -> Bool
compare :: PlatformWordSize -> PlatformWordSize -> Ordering
$ccompare :: PlatformWordSize -> PlatformWordSize -> Ordering
Ord)
instance Show PlatformWordSize where
show :: PlatformWordSize -> String
show PlatformWordSize
PW4 = String
"4"
show PlatformWordSize
PW8 = String
"8"
instance Read PlatformWordSize where
readPrec :: ReadPrec PlatformWordSize
readPrec = do
Int
i :: Int <- ReadPrec Int
forall a. Read a => ReadPrec a
readPrec
case Int
i of
Int
4 -> PlatformWordSize -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. Monad m => a -> m a
return PlatformWordSize
PW4
Int
8 -> PlatformWordSize -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. Monad m => a -> m a
return PlatformWordSize
PW8
Int
other -> String -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid PlatformWordSize: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
other)
platformWordSizeInBytes :: Platform -> Int
platformWordSizeInBytes :: Platform -> Int
platformWordSizeInBytes Platform
p =
case Platform -> PlatformWordSize
platformWordSize Platform
p of
PlatformWordSize
PW4 -> Int
4
PlatformWordSize
PW8 -> Int
8
platformWordSizeInBits :: Platform -> Int
platformWordSizeInBits :: Platform -> Int
platformWordSizeInBits Platform
p = Platform -> Int
platformWordSizeInBytes Platform
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
platformArch :: Platform -> Arch
platformArch :: Platform -> Arch
platformArch Platform
platform = case Platform -> ArchOS
platformArchOS Platform
platform of
ArchOS Arch
arch OS
_ -> Arch
arch
platformOS :: Platform -> OS
platformOS :: Platform -> OS
platformOS Platform
platform = case Platform -> ArchOS
platformArchOS Platform
platform of
ArchOS Arch
_ OS
os -> OS
os
isARM :: Arch -> Bool
isARM :: Arch -> Bool
isARM (ArchARM {}) = Bool
True
isARM Arch
ArchAArch64 = Bool
True
isARM Arch
_ = Bool
False
target32Bit :: Platform -> Bool
target32Bit :: Platform -> Bool
target32Bit Platform
p =
case Platform -> PlatformWordSize
platformWordSize Platform
p of
PlatformWordSize
PW4 -> Bool
True
PlatformWordSize
PW8 -> Bool
False
osElfTarget :: OS -> Bool
osElfTarget :: OS -> Bool
osElfTarget OS
OSLinux = Bool
True
osElfTarget OS
OSFreeBSD = Bool
True
osElfTarget OS
OSDragonFly = Bool
True
osElfTarget OS
OSOpenBSD = Bool
True
osElfTarget OS
OSNetBSD = Bool
True
osElfTarget OS
OSSolaris2 = Bool
True
osElfTarget OS
OSDarwin = Bool
False
osElfTarget OS
OSMinGW32 = Bool
False
osElfTarget OS
OSKFreeBSD = Bool
True
osElfTarget OS
OSHaiku = Bool
True
osElfTarget OS
OSQNXNTO = Bool
False
osElfTarget OS
OSAIX = Bool
False
osElfTarget OS
OSHurd = Bool
True
osElfTarget OS
OSUnknown = Bool
False
osMachOTarget :: OS -> Bool
osMachOTarget :: OS -> Bool
osMachOTarget OS
OSDarwin = Bool
True
osMachOTarget OS
_ = Bool
False
osUsesFrameworks :: OS -> Bool
osUsesFrameworks :: OS -> Bool
osUsesFrameworks OS
OSDarwin = Bool
True
osUsesFrameworks OS
_ = Bool
False
platformUsesFrameworks :: Platform -> Bool
platformUsesFrameworks :: Platform -> Bool
platformUsesFrameworks = OS -> Bool
osUsesFrameworks (OS -> Bool) -> (Platform -> OS) -> Platform -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> OS
platformOS
osSubsectionsViaSymbols :: OS -> Bool
osSubsectionsViaSymbols :: OS -> Bool
osSubsectionsViaSymbols OS
OSDarwin = Bool
True
osSubsectionsViaSymbols OS
_ = Bool
False
platformMinInt :: Platform -> Integer
platformMinInt :: Platform -> Integer
platformMinInt Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
PlatformWordSize
PW4 -> Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
minBound :: Int32)
PlatformWordSize
PW8 -> Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64)
platformMaxInt :: Platform -> Integer
platformMaxInt :: Platform -> Integer
platformMaxInt Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
PlatformWordSize
PW4 -> Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
maxBound :: Int32)
PlatformWordSize
PW8 -> Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64)
platformMaxWord :: Platform -> Integer
platformMaxWord :: Platform -> Integer
platformMaxWord Platform
p = case Platform -> PlatformWordSize
platformWordSize Platform
p of
PlatformWordSize
PW4 -> Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word32
forall a. Bounded a => a
maxBound :: Word32)
PlatformWordSize
PW8 -> Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64)
platformInIntRange :: Platform -> Integer -> Bool
platformInIntRange :: Platform -> Integer -> Bool
platformInIntRange Platform
platform Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Platform -> Integer
platformMinInt Platform
platform Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Platform -> Integer
platformMaxInt Platform
platform
platformInWordRange :: Platform -> Integer -> Bool
platformInWordRange :: Platform -> Integer -> Bool
platformInWordRange Platform
platform Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Platform -> Integer
platformMaxWord Platform
platform
platformCConvNeedsExtension :: Platform -> Bool
platformCConvNeedsExtension :: Platform -> Bool
platformCConvNeedsExtension Platform
platform = case Platform -> Arch
platformArch Platform
platform of
ArchPPC_64 PPC_64ABI
_ -> Bool
True
Arch
ArchS390X -> Bool
True
Arch
_ -> Bool
False
data SseVersion
= SSE1
| SSE2
| SSE3
| SSE4
| SSE42
deriving (SseVersion -> SseVersion -> Bool
(SseVersion -> SseVersion -> Bool)
-> (SseVersion -> SseVersion -> Bool) -> Eq SseVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SseVersion -> SseVersion -> Bool
$c/= :: SseVersion -> SseVersion -> Bool
== :: SseVersion -> SseVersion -> Bool
$c== :: SseVersion -> SseVersion -> Bool
Eq, Eq SseVersion
Eq SseVersion
-> (SseVersion -> SseVersion -> Ordering)
-> (SseVersion -> SseVersion -> Bool)
-> (SseVersion -> SseVersion -> Bool)
-> (SseVersion -> SseVersion -> Bool)
-> (SseVersion -> SseVersion -> Bool)
-> (SseVersion -> SseVersion -> SseVersion)
-> (SseVersion -> SseVersion -> SseVersion)
-> Ord SseVersion
SseVersion -> SseVersion -> Bool
SseVersion -> SseVersion -> Ordering
SseVersion -> SseVersion -> SseVersion
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 :: SseVersion -> SseVersion -> SseVersion
$cmin :: SseVersion -> SseVersion -> SseVersion
max :: SseVersion -> SseVersion -> SseVersion
$cmax :: SseVersion -> SseVersion -> SseVersion
>= :: SseVersion -> SseVersion -> Bool
$c>= :: SseVersion -> SseVersion -> Bool
> :: SseVersion -> SseVersion -> Bool
$c> :: SseVersion -> SseVersion -> Bool
<= :: SseVersion -> SseVersion -> Bool
$c<= :: SseVersion -> SseVersion -> Bool
< :: SseVersion -> SseVersion -> Bool
$c< :: SseVersion -> SseVersion -> Bool
compare :: SseVersion -> SseVersion -> Ordering
$ccompare :: SseVersion -> SseVersion -> Ordering
Ord)
data BmiVersion
= BMI1
| BMI2
deriving (BmiVersion -> BmiVersion -> Bool
(BmiVersion -> BmiVersion -> Bool)
-> (BmiVersion -> BmiVersion -> Bool) -> Eq BmiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BmiVersion -> BmiVersion -> Bool
$c/= :: BmiVersion -> BmiVersion -> Bool
== :: BmiVersion -> BmiVersion -> Bool
$c== :: BmiVersion -> BmiVersion -> Bool
Eq, Eq BmiVersion
Eq BmiVersion
-> (BmiVersion -> BmiVersion -> Ordering)
-> (BmiVersion -> BmiVersion -> Bool)
-> (BmiVersion -> BmiVersion -> Bool)
-> (BmiVersion -> BmiVersion -> Bool)
-> (BmiVersion -> BmiVersion -> Bool)
-> (BmiVersion -> BmiVersion -> BmiVersion)
-> (BmiVersion -> BmiVersion -> BmiVersion)
-> Ord BmiVersion
BmiVersion -> BmiVersion -> Bool
BmiVersion -> BmiVersion -> Ordering
BmiVersion -> BmiVersion -> BmiVersion
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 :: BmiVersion -> BmiVersion -> BmiVersion
$cmin :: BmiVersion -> BmiVersion -> BmiVersion
max :: BmiVersion -> BmiVersion -> BmiVersion
$cmax :: BmiVersion -> BmiVersion -> BmiVersion
>= :: BmiVersion -> BmiVersion -> Bool
$c>= :: BmiVersion -> BmiVersion -> Bool
> :: BmiVersion -> BmiVersion -> Bool
$c> :: BmiVersion -> BmiVersion -> Bool
<= :: BmiVersion -> BmiVersion -> Bool
$c<= :: BmiVersion -> BmiVersion -> Bool
< :: BmiVersion -> BmiVersion -> Bool
$c< :: BmiVersion -> BmiVersion -> Bool
compare :: BmiVersion -> BmiVersion -> Ordering
$ccompare :: BmiVersion -> BmiVersion -> Ordering
Ord)
data PlatformMisc = PlatformMisc
{
PlatformMisc -> String
platformMisc_targetPlatformString :: String
, PlatformMisc -> Bool
platformMisc_ghcWithInterpreter :: Bool
, PlatformMisc -> Bool
platformMisc_ghcWithSMP :: Bool
, PlatformMisc -> String
platformMisc_ghcRTSWays :: String
, PlatformMisc -> Bool
platformMisc_libFFI :: Bool
, PlatformMisc -> Bool
platformMisc_ghcRtsWithLibdw :: Bool
, PlatformMisc -> String
platformMisc_llvmTarget :: String
}
platformSOName :: Platform -> FilePath -> FilePath
platformSOName :: Platform -> ShowS
platformSOName Platform
platform String
root = case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> String
root String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform
OS
_ -> (String
"lib" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform
platformHsSOName :: Platform -> FilePath -> FilePath
platformHsSOName :: Platform -> ShowS
platformHsSOName Platform
platform String
root = (String
"lib" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
root) String -> ShowS
<.> Platform -> String
platformSOExt Platform
platform
platformSOExt :: Platform -> FilePath
platformSOExt :: Platform -> String
platformSOExt Platform
platform
= case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin -> String
"dylib"
OS
OSMinGW32 -> String
"dll"
OS
_ -> String
"so"