{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}

-- | A description of the platform we're compiling for.
--
module GHC.Platform
   ( PlatformMini(..)
   , PlatformWordSize(..)
   , Platform(..)
   , platformArch
   , platformOS
   , Arch(..)
   , OS(..)
   , ArmISA(..)
   , ArmISAExt(..)
   , ArmABI(..)
   , PPC_64ABI(..)
   , ByteOrder(..)
   , target32Bit
   , isARM
   , osElfTarget
   , osMachOTarget
   , osSubsectionsViaSymbols
   , platformUsesFrameworks
   , platformWordSizeInBytes
   , platformWordSizeInBits
   , platformMinInt
   , platformMaxInt
   , platformMaxWord
   , platformInIntRange
   , platformInWordRange
   , PlatformMisc(..)
   , IntegerLibrary(..)
   , stringEncodeArch
   , stringEncodeOS
   , SseVersion (..)
   , BmiVersion (..)
)

where

import Prelude -- See Note [Why do we import Prelude here?]
import GHC.Read
import GHC.ByteOrder (ByteOrder(..))
import Data.Word
import Data.Int

-- | Contains the bare-bones arch and os information. This isn't enough for
-- code gen, but useful for tasks where we can fall back upon the host
-- platform, as this is all we know about the host platform.
data PlatformMini
  = PlatformMini
    { PlatformMini -> Arch
platformMini_arch :: Arch
    , PlatformMini -> OS
platformMini_os :: OS
    }
    deriving (ReadPrec [PlatformMini]
ReadPrec PlatformMini
Int -> ReadS PlatformMini
ReadS [PlatformMini]
(Int -> ReadS PlatformMini)
-> ReadS [PlatformMini]
-> ReadPrec PlatformMini
-> ReadPrec [PlatformMini]
-> Read PlatformMini
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PlatformMini]
$creadListPrec :: ReadPrec [PlatformMini]
readPrec :: ReadPrec PlatformMini
$creadPrec :: ReadPrec PlatformMini
readList :: ReadS [PlatformMini]
$creadList :: ReadS [PlatformMini]
readsPrec :: Int -> ReadS PlatformMini
$creadsPrec :: Int -> ReadS PlatformMini
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read OS
Instance of class: Read of the constraint type Read Arch
Instance of class: Read of the constraint type Read PlatformMini
Read, Int -> PlatformMini -> ShowS
[PlatformMini] -> ShowS
PlatformMini -> String
(Int -> PlatformMini -> ShowS)
-> (PlatformMini -> String)
-> ([PlatformMini] -> ShowS)
-> Show PlatformMini
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlatformMini] -> ShowS
$cshowList :: [PlatformMini] -> ShowS
show :: PlatformMini -> String
$cshow :: PlatformMini -> String
showsPrec :: Int -> PlatformMini -> ShowS
$cshowsPrec :: Int -> PlatformMini -> ShowS
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show OS
Instance of class: Show of the constraint type Show Arch
Show, PlatformMini -> PlatformMini -> Bool
(PlatformMini -> PlatformMini -> Bool)
-> (PlatformMini -> PlatformMini -> Bool) -> Eq PlatformMini
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlatformMini -> PlatformMini -> Bool
$c/= :: PlatformMini -> PlatformMini -> Bool
== :: PlatformMini -> PlatformMini -> Bool
$c== :: PlatformMini -> PlatformMini -> Bool
Instance of class: Eq of the constraint type Eq OS
Instance of class: Eq of the constraint type Eq Arch
Eq)

-- | Contains enough information for the native code generator to emit
-- code for this platform.
data Platform = Platform
   { Platform -> PlatformMini
platformMini                     :: !PlatformMini
   , Platform -> PlatformWordSize
platformWordSize                 :: !PlatformWordSize -- ^ Word size
   , Platform -> ByteOrder
platformByteOrder                :: !ByteOrder        -- ^ Byte order (endianness)
   , Platform -> Bool
platformUnregisterised           :: !Bool
   , Platform -> Bool
platformHasGnuNonexecStack       :: !Bool
   , Platform -> Bool
platformHasIdentDirective        :: !Bool
   , Platform -> Bool
platformHasSubsectionsViaSymbols :: !Bool
   , Platform -> Bool
platformIsCrossCompiling         :: !Bool
   , Platform -> Bool
platformLeadingUnderscore        :: !Bool             -- ^ Symbols need underscore prefix
   }
   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
External instance of the constraint type Read Bool
External instance of the constraint type Read Bool
External instance of the constraint type Read ByteOrder
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read PlatformWordSize
Instance of class: Read of the constraint type Read PlatformMini
Instance of class: Read of the constraint type Read 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
External instance of the constraint type Show Bool
External instance of the constraint type Show Bool
External instance of the constraint type Show ByteOrder
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show PlatformWordSize
Instance of class: Show of the constraint type Show PlatformMini
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
External instance of the constraint type Eq Bool
External instance of the constraint type Eq Bool
External instance of the constraint type Eq ByteOrder
Instance of class: Eq of the constraint type Eq PlatformWordSize
Instance of class: Eq of the constraint type Eq PlatformMini
Eq)

data PlatformWordSize
  = PW4 -- ^ A 32-bit platform
  | PW8 -- ^ A 64-bit platform
  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)

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
External instance of the constraint type Read Int
readPrec
    case Int
i of
      Int
4 -> PlatformWordSize -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadPrec
return PlatformWordSize
PW4
      Int
8 -> PlatformWordSize -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadPrec
return PlatformWordSize
PW8
      Int
other -> String -> ReadPrec PlatformWordSize
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type MonadFail ReadPrec
fail (String
"Invalid PlatformWordSize: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
External instance of the constraint type Show Int
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
External instance of the constraint type Num Int
* Int
8

-- | Legacy accessor
platformArch :: Platform -> Arch
platformArch :: Platform -> Arch
platformArch = PlatformMini -> Arch
platformMini_arch (PlatformMini -> Arch)
-> (Platform -> PlatformMini) -> Platform -> Arch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> PlatformMini
platformMini

-- | Legacy accessor
platformOS :: Platform -> OS
platformOS :: Platform -> OS
platformOS = PlatformMini -> OS
platformMini_os (PlatformMini -> OS)
-> (Platform -> PlatformMini) -> Platform -> OS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> PlatformMini
platformMini

-- | Architectures that the native code generator knows about.
--      TODO: It might be nice to extend these constructors with information
--      about what instruction set extensions an architecture might support.
--
data Arch
        = ArchUnknown
        | ArchX86
        | ArchX86_64
        | ArchPPC
        | ArchPPC_64
          { Arch -> PPC_64ABI
ppc_64ABI :: PPC_64ABI
          }
        | ArchS390X
        | ArchSPARC
        | ArchSPARC64
        | ArchARM
          { Arch -> ArmISA
armISA    :: ArmISA
          , Arch -> [ArmISAExt]
armISAExt :: [ArmISAExt]
          , Arch -> ArmABI
armABI    :: ArmABI
          }
        | ArchARM64
        | ArchAlpha
        | ArchMipseb
        | ArchMipsel
        | ArchJavaScript
        deriving (ReadPrec [Arch]
ReadPrec Arch
Int -> ReadS Arch
ReadS [Arch]
(Int -> ReadS Arch)
-> ReadS [Arch] -> ReadPrec Arch -> ReadPrec [Arch] -> Read Arch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Arch]
$creadListPrec :: ReadPrec [Arch]
readPrec :: ReadPrec Arch
$creadPrec :: ReadPrec Arch
readList :: ReadS [Arch]
$creadList :: ReadS [Arch]
readsPrec :: Int -> ReadS Arch
$creadsPrec :: Int -> ReadS Arch
Instance of class: Read of the constraint type Read ArmISAExt
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ArmISA
Instance of class: Read of the constraint type Read ArmISAExt
Instance of class: Read of the constraint type Read ArmABI
Instance of class: Read of the constraint type Read PPC_64ABI
Instance of class: Read of the constraint type Read Arch
Read, Int -> Arch -> ShowS
[Arch] -> ShowS
Arch -> String
(Int -> Arch -> ShowS)
-> (Arch -> String) -> ([Arch] -> ShowS) -> Show Arch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arch] -> ShowS
$cshowList :: [Arch] -> ShowS
show :: Arch -> String
$cshow :: Arch -> String
showsPrec :: Int -> Arch -> ShowS
$cshowsPrec :: Int -> Arch -> ShowS
Instance of class: Show of the constraint type Show ArmISAExt
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show ArmISA
Instance of class: Show of the constraint type Show ArmISAExt
Instance of class: Show of the constraint type Show ArmABI
Instance of class: Show of the constraint type Show PPC_64ABI
Show, Arch -> Arch -> Bool
(Arch -> Arch -> Bool) -> (Arch -> Arch -> Bool) -> Eq Arch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arch -> Arch -> Bool
$c/= :: Arch -> Arch -> Bool
== :: Arch -> Arch -> Bool
$c== :: Arch -> Arch -> Bool
Instance of class: Eq of the constraint type Eq ArmISAExt
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq ArmISA
Instance of class: Eq of the constraint type Eq ArmISAExt
Instance of class: Eq of the constraint type Eq ArmABI
Instance of class: Eq of the constraint type Eq PPC_64ABI
Eq)

-- Note [Platform Syntax]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- There is a very loose encoding of platforms shared by many tools we are
-- encoding to here. GNU Config (http://git.savannah.gnu.org/cgit/config.git),
-- and LLVM's http://llvm.org/doxygen/classllvm_1_1Triple.html are perhaps the
-- most definitional parsers. The basic syntax is a list of of '-'-separated
-- components. The Unix 'uname' command syntax is related but briefer.
--
-- Those two parsers are quite forgiving, and even the 'config.sub'
-- normalization is forgiving too. The "best" way to encode a platform is
-- therefore somewhat a matter of taste.
--
-- The 'stringEncode*' functions here convert each part of GHC's structured
-- notion of a platform into one dash-separated component.

-- | See Note [Platform Syntax].
stringEncodeArch :: Arch -> String
stringEncodeArch :: Arch -> String
stringEncodeArch = \case
  Arch
ArchUnknown -> String
"unknown"
  Arch
ArchX86 -> String
"i386"
  Arch
ArchX86_64 -> String
"x86_64"
  Arch
ArchPPC -> String
"powerpc"
  ArchPPC_64 { ppc_64ABI :: Arch -> PPC_64ABI
ppc_64ABI = PPC_64ABI
abi } -> case PPC_64ABI
abi of
    PPC_64ABI
ELF_V1 -> String
"powerpc64"
    PPC_64ABI
ELF_V2 -> String
"powerpc64le"
  Arch
ArchS390X -> String
"s390x"
  Arch
ArchSPARC -> String
"sparc"
  Arch
ArchSPARC64 -> String
"sparc64"
  ArchARM { armISA :: Arch -> ArmISA
armISA = ArmISA
isa, armISAExt :: Arch -> [ArmISAExt]
armISAExt = [ArmISAExt]
_, armABI :: Arch -> ArmABI
armABI = ArmABI
_ } -> String
"arm" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
vsuf
    where
      vsuf :: String
vsuf = case ArmISA
isa of
        ArmISA
ARMv5 -> String
"v5"
        ArmISA
ARMv6 -> String
"v6"
        ArmISA
ARMv7 -> String
"v7"
  Arch
ArchARM64 -> String
"aarch64"
  Arch
ArchAlpha -> String
"alpha"
  Arch
ArchMipseb -> String
"mipseb"
  Arch
ArchMipsel -> String
"mipsel"
  Arch
ArchJavaScript -> String
"js"

isARM :: Arch -> Bool
isARM :: Arch -> Bool
isARM (ArchARM {}) = Bool
True
isARM Arch
ArchARM64    = Bool
True
isARM Arch
_ = Bool
False

-- | Operating systems that the native code generator knows about.
--      Having OSUnknown should produce a sensible default, but no promises.
data OS
        = OSUnknown
        | OSLinux
        | OSDarwin
        | OSSolaris2
        | OSMinGW32
        | OSFreeBSD
        | OSDragonFly
        | OSOpenBSD
        | OSNetBSD
        | OSKFreeBSD
        | OSHaiku
        | OSQNXNTO
        | OSAIX
        | OSHurd
        deriving (ReadPrec [OS]
ReadPrec OS
Int -> ReadS OS
ReadS [OS]
(Int -> ReadS OS)
-> ReadS [OS] -> ReadPrec OS -> ReadPrec [OS] -> Read OS
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OS]
$creadListPrec :: ReadPrec [OS]
readPrec :: ReadPrec OS
$creadPrec :: ReadPrec OS
readList :: ReadS [OS]
$creadList :: ReadS [OS]
readsPrec :: Int -> ReadS OS
$creadsPrec :: Int -> ReadS OS
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read OS
Read, Int -> OS -> ShowS
[OS] -> ShowS
OS -> String
(Int -> OS -> ShowS)
-> (OS -> String) -> ([OS] -> ShowS) -> Show OS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OS] -> ShowS
$cshowList :: [OS] -> ShowS
show :: OS -> String
$cshow :: OS -> String
showsPrec :: Int -> OS -> ShowS
$cshowsPrec :: Int -> OS -> ShowS
Show, OS -> OS -> Bool
(OS -> OS -> Bool) -> (OS -> OS -> Bool) -> Eq OS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OS -> OS -> Bool
$c/= :: OS -> OS -> Bool
== :: OS -> OS -> Bool
$c== :: OS -> OS -> Bool
Eq)

-- | See Note [Platform Syntax].
stringEncodeOS :: OS -> String
stringEncodeOS :: OS -> String
stringEncodeOS = \case
  OS
OSUnknown -> String
"unknown"
  OS
OSLinux -> String
"linux"
  OS
OSDarwin -> String
"darwin"
  OS
OSSolaris2 -> String
"solaris2"
  OS
OSMinGW32 -> String
"mingw32"
  OS
OSFreeBSD -> String
"freebsd"
  OS
OSDragonFly -> String
"dragonfly"
  OS
OSOpenBSD -> String
"openbsd"
  OS
OSNetBSD -> String
"netbsd"
  OS
OSKFreeBSD -> String
"kfreebsdgnu"
  OS
OSHaiku -> String
"haiku"
  OS
OSQNXNTO -> String
"nto-qnx"
  OS
OSAIX -> String
"aix"
  OS
OSHurd -> String
"hurd"

-- | ARM Instruction Set Architecture, Extensions and ABI
--
data ArmISA
    = ARMv5
    | ARMv6
    | ARMv7
    deriving (ReadPrec [ArmISA]
ReadPrec ArmISA
Int -> ReadS ArmISA
ReadS [ArmISA]
(Int -> ReadS ArmISA)
-> ReadS [ArmISA]
-> ReadPrec ArmISA
-> ReadPrec [ArmISA]
-> Read ArmISA
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArmISA]
$creadListPrec :: ReadPrec [ArmISA]
readPrec :: ReadPrec ArmISA
$creadPrec :: ReadPrec ArmISA
readList :: ReadS [ArmISA]
$creadList :: ReadS [ArmISA]
readsPrec :: Int -> ReadS ArmISA
$creadsPrec :: Int -> ReadS ArmISA
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ArmISA
Read, Int -> ArmISA -> ShowS
[ArmISA] -> ShowS
ArmISA -> String
(Int -> ArmISA -> ShowS)
-> (ArmISA -> String) -> ([ArmISA] -> ShowS) -> Show ArmISA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArmISA] -> ShowS
$cshowList :: [ArmISA] -> ShowS
show :: ArmISA -> String
$cshow :: ArmISA -> String
showsPrec :: Int -> ArmISA -> ShowS
$cshowsPrec :: Int -> ArmISA -> ShowS
Show, ArmISA -> ArmISA -> Bool
(ArmISA -> ArmISA -> Bool)
-> (ArmISA -> ArmISA -> Bool) -> Eq ArmISA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArmISA -> ArmISA -> Bool
$c/= :: ArmISA -> ArmISA -> Bool
== :: ArmISA -> ArmISA -> Bool
$c== :: ArmISA -> ArmISA -> Bool
Eq)

data ArmISAExt
    = VFPv2
    | VFPv3
    | VFPv3D16
    | NEON
    | IWMMX2
    deriving (ReadPrec [ArmISAExt]
ReadPrec ArmISAExt
Int -> ReadS ArmISAExt
ReadS [ArmISAExt]
(Int -> ReadS ArmISAExt)
-> ReadS [ArmISAExt]
-> ReadPrec ArmISAExt
-> ReadPrec [ArmISAExt]
-> Read ArmISAExt
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArmISAExt]
$creadListPrec :: ReadPrec [ArmISAExt]
readPrec :: ReadPrec ArmISAExt
$creadPrec :: ReadPrec ArmISAExt
readList :: ReadS [ArmISAExt]
$creadList :: ReadS [ArmISAExt]
readsPrec :: Int -> ReadS ArmISAExt
$creadsPrec :: Int -> ReadS ArmISAExt
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ArmISAExt
Read, Int -> ArmISAExt -> ShowS
[ArmISAExt] -> ShowS
ArmISAExt -> String
(Int -> ArmISAExt -> ShowS)
-> (ArmISAExt -> String)
-> ([ArmISAExt] -> ShowS)
-> Show ArmISAExt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArmISAExt] -> ShowS
$cshowList :: [ArmISAExt] -> ShowS
show :: ArmISAExt -> String
$cshow :: ArmISAExt -> String
showsPrec :: Int -> ArmISAExt -> ShowS
$cshowsPrec :: Int -> ArmISAExt -> ShowS
Show, ArmISAExt -> ArmISAExt -> Bool
(ArmISAExt -> ArmISAExt -> Bool)
-> (ArmISAExt -> ArmISAExt -> Bool) -> Eq ArmISAExt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArmISAExt -> ArmISAExt -> Bool
$c/= :: ArmISAExt -> ArmISAExt -> Bool
== :: ArmISAExt -> ArmISAExt -> Bool
$c== :: ArmISAExt -> ArmISAExt -> Bool
Eq)

data ArmABI
    = SOFT
    | SOFTFP
    | HARD
    deriving (ReadPrec [ArmABI]
ReadPrec ArmABI
Int -> ReadS ArmABI
ReadS [ArmABI]
(Int -> ReadS ArmABI)
-> ReadS [ArmABI]
-> ReadPrec ArmABI
-> ReadPrec [ArmABI]
-> Read ArmABI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArmABI]
$creadListPrec :: ReadPrec [ArmABI]
readPrec :: ReadPrec ArmABI
$creadPrec :: ReadPrec ArmABI
readList :: ReadS [ArmABI]
$creadList :: ReadS [ArmABI]
readsPrec :: Int -> ReadS ArmABI
$creadsPrec :: Int -> ReadS ArmABI
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read ArmABI
Read, Int -> ArmABI -> ShowS
[ArmABI] -> ShowS
ArmABI -> String
(Int -> ArmABI -> ShowS)
-> (ArmABI -> String) -> ([ArmABI] -> ShowS) -> Show ArmABI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArmABI] -> ShowS
$cshowList :: [ArmABI] -> ShowS
show :: ArmABI -> String
$cshow :: ArmABI -> String
showsPrec :: Int -> ArmABI -> ShowS
$cshowsPrec :: Int -> ArmABI -> ShowS
Show, ArmABI -> ArmABI -> Bool
(ArmABI -> ArmABI -> Bool)
-> (ArmABI -> ArmABI -> Bool) -> Eq ArmABI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArmABI -> ArmABI -> Bool
$c/= :: ArmABI -> ArmABI -> Bool
== :: ArmABI -> ArmABI -> Bool
$c== :: ArmABI -> ArmABI -> Bool
Eq)

-- | PowerPC 64-bit ABI
--
data PPC_64ABI
    = ELF_V1
    | ELF_V2
    deriving (ReadPrec [PPC_64ABI]
ReadPrec PPC_64ABI
Int -> ReadS PPC_64ABI
ReadS [PPC_64ABI]
(Int -> ReadS PPC_64ABI)
-> ReadS [PPC_64ABI]
-> ReadPrec PPC_64ABI
-> ReadPrec [PPC_64ABI]
-> Read PPC_64ABI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PPC_64ABI]
$creadListPrec :: ReadPrec [PPC_64ABI]
readPrec :: ReadPrec PPC_64ABI
$creadPrec :: ReadPrec PPC_64ABI
readList :: ReadS [PPC_64ABI]
$creadList :: ReadS [PPC_64ABI]
readsPrec :: Int -> ReadS PPC_64ABI
$creadsPrec :: Int -> ReadS PPC_64ABI
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read PPC_64ABI
Read, Int -> PPC_64ABI -> ShowS
[PPC_64ABI] -> ShowS
PPC_64ABI -> String
(Int -> PPC_64ABI -> ShowS)
-> (PPC_64ABI -> String)
-> ([PPC_64ABI] -> ShowS)
-> Show PPC_64ABI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PPC_64ABI] -> ShowS
$cshowList :: [PPC_64ABI] -> ShowS
show :: PPC_64ABI -> String
$cshow :: PPC_64ABI -> String
showsPrec :: Int -> PPC_64ABI -> ShowS
$cshowsPrec :: Int -> PPC_64ABI -> ShowS
Show, PPC_64ABI -> PPC_64ABI -> Bool
(PPC_64ABI -> PPC_64ABI -> Bool)
-> (PPC_64ABI -> PPC_64ABI -> Bool) -> Eq PPC_64ABI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PPC_64ABI -> PPC_64ABI -> Bool
$c/= :: PPC_64ABI -> PPC_64ABI -> Bool
== :: PPC_64ABI -> PPC_64ABI -> Bool
$c== :: PPC_64ABI -> PPC_64ABI -> Bool
Eq)

-- | This predicate tells us whether the platform is 32-bit.
target32Bit :: Platform -> Bool
target32Bit :: Platform -> Bool
target32Bit Platform
p =
    case Platform -> PlatformWordSize
platformWordSize Platform
p of
      PlatformWordSize
PW4 -> Bool
True
      PlatformWordSize
PW8 -> Bool
False

-- | This predicate tells us whether the OS supports ELF-like shared libraries.
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
 -- Defaulting to False is safe; it means don't rely on any
 -- ELF-specific functionality.  It is important to have a default for
 -- portability, otherwise we have to answer this question for every
 -- new platform we compile on (even unreg).

-- | This predicate tells us whether the OS support Mach-O shared libraries.
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

-- | Platform-specific settings formerly hard-coded in Config.hs.
--
-- These should probably be all be triaged whether they can be computed from
-- other settings or belong in another another place (like 'Platform' above).
data PlatformMisc = PlatformMisc
  { -- TODO Recalculate string from richer info?
    PlatformMisc -> String
platformMisc_targetPlatformString :: String
  , PlatformMisc -> String
platformMisc_integerLibrary       :: String
  , PlatformMisc -> IntegerLibrary
platformMisc_integerLibraryType   :: IntegerLibrary
  , PlatformMisc -> Bool
platformMisc_ghcWithInterpreter   :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcWithNativeCodeGen :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcWithSMP           :: Bool
  , PlatformMisc -> String
platformMisc_ghcRTSWays           :: String
  -- | Determines whether we will be compiling info tables that reside just
  --   before the entry code, or with an indirection to the entry code. See
  --   TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
  , PlatformMisc -> Bool
platformMisc_tablesNextToCode     :: Bool
  , PlatformMisc -> Bool
platformMisc_libFFI               :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcThreaded          :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcDebugged          :: Bool
  , PlatformMisc -> Bool
platformMisc_ghcRtsWithLibdw      :: Bool
  , PlatformMisc -> String
platformMisc_llvmTarget           :: String
  }

data IntegerLibrary
    = IntegerGMP
    | IntegerSimple
    deriving (ReadPrec [IntegerLibrary]
ReadPrec IntegerLibrary
Int -> ReadS IntegerLibrary
ReadS [IntegerLibrary]
(Int -> ReadS IntegerLibrary)
-> ReadS [IntegerLibrary]
-> ReadPrec IntegerLibrary
-> ReadPrec [IntegerLibrary]
-> Read IntegerLibrary
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IntegerLibrary]
$creadListPrec :: ReadPrec [IntegerLibrary]
readPrec :: ReadPrec IntegerLibrary
$creadPrec :: ReadPrec IntegerLibrary
readList :: ReadS [IntegerLibrary]
$creadList :: ReadS [IntegerLibrary]
readsPrec :: Int -> ReadS IntegerLibrary
$creadsPrec :: Int -> ReadS IntegerLibrary
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read IntegerLibrary
Read, Int -> IntegerLibrary -> ShowS
[IntegerLibrary] -> ShowS
IntegerLibrary -> String
(Int -> IntegerLibrary -> ShowS)
-> (IntegerLibrary -> String)
-> ([IntegerLibrary] -> ShowS)
-> Show IntegerLibrary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegerLibrary] -> ShowS
$cshowList :: [IntegerLibrary] -> ShowS
show :: IntegerLibrary -> String
$cshow :: IntegerLibrary -> String
showsPrec :: Int -> IntegerLibrary -> ShowS
$cshowsPrec :: Int -> IntegerLibrary -> ShowS
Show, IntegerLibrary -> IntegerLibrary -> Bool
(IntegerLibrary -> IntegerLibrary -> Bool)
-> (IntegerLibrary -> IntegerLibrary -> Bool) -> Eq IntegerLibrary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntegerLibrary -> IntegerLibrary -> Bool
$c/= :: IntegerLibrary -> IntegerLibrary -> Bool
== :: IntegerLibrary -> IntegerLibrary -> Bool
$c== :: IntegerLibrary -> IntegerLibrary -> Bool
Eq)

-- | Minimum representable Int value for the given platform
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
External instance of the constraint type Integral Int32
toInteger (Int32
forall a. Bounded a => a
External instance of the constraint type Bounded Int32
minBound :: Int32)
   PlatformWordSize
PW8 -> Int64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int64
toInteger (Int64
forall a. Bounded a => a
External instance of the constraint type Bounded Int64
minBound :: Int64)

-- | Maximum representable Int value for the given platform
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
External instance of the constraint type Integral Int32
toInteger (Int32
forall a. Bounded a => a
External instance of the constraint type Bounded Int32
maxBound :: Int32)
   PlatformWordSize
PW8 -> Int64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Int64
toInteger (Int64
forall a. Bounded a => a
External instance of the constraint type Bounded Int64
maxBound :: Int64)

-- | Maximum representable Word value for the given platform
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
External instance of the constraint type Integral Word32
toInteger (Word32
forall a. Bounded a => a
External instance of the constraint type Bounded Word32
maxBound :: Word32)
   PlatformWordSize
PW8 -> Word64 -> Integer
forall a. Integral a => a -> Integer
External instance of the constraint type Integral Word64
toInteger (Word64
forall a. Bounded a => a
External instance of the constraint type Bounded Word64
maxBound :: Word64)

-- | Test if the given Integer is representable with a platform Int
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
External instance of the constraint type Ord Integer
>= Platform -> Integer
platformMinInt Platform
platform Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= Platform -> Integer
platformMaxInt Platform
platform

-- | Test if the given Integer is representable with a platform Word
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
External instance of the constraint type Ord Integer
>= Integer
0 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Integer
<= Platform -> Integer
platformMaxWord Platform
platform


--------------------------------------------------
-- Instruction sets
--------------------------------------------------

-- | x86 SSE instructions
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
Instance of class: Eq of the constraint type Eq SseVersion
Instance of class: Ord of the constraint type Ord SseVersion
Instance of class: Eq of the constraint type Eq SseVersion
Ord)

-- | x86 BMI (bit manipulation) instructions
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
Instance of class: Eq of the constraint type Eq BmiVersion
Instance of class: Ord of the constraint type Ord BmiVersion
Instance of class: Eq of the constraint type Eq BmiVersion
Ord)