{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module GHC.Toolchain.Target where

import GHC.Platform.ArchOS

import GHC.Toolchain.Prelude
import GHC.Toolchain.Program

import GHC.Toolchain.Tools.Cc
import GHC.Toolchain.Tools.Cxx
import GHC.Toolchain.Tools.Cpp
import GHC.Toolchain.Tools.Ar
import GHC.Toolchain.Tools.Ranlib
import GHC.Toolchain.Tools.Link
import GHC.Toolchain.Tools.Nm
import GHC.Toolchain.Tools.MergeObjs

data WordSize = WS4 | WS8
    deriving (Show, Read, Eq, Ord)

data Endianness = LittleEndian | BigEndian
    deriving (Show, Read, Eq, Ord)

-- TODO(#23674): Move the remaining relevant `settings-xxx` to Target:
-- * llc command
-- * opt command
-- * install_name_tool
-- * otool command
--
-- Those are all things that are put into GHC's settings, and that might be
-- different across targets

-- | A 'Target' consists of:
--
-- * a target architecture and operating system
-- * various bits of information about the platform
-- * various toolchain components targetting that platform
data Target = Target
    { -- Platform
      tgtArchOs :: ArchOS
    , tgtVendor :: Maybe String -- ^ This is the vendor component of the triple, the other two components are found in @'tgtArchOs'@
    , tgtLocallyExecutable :: Bool
    , tgtSupportsGnuNonexecStack :: Bool
    , tgtSupportsSubsectionsViaSymbols :: Bool
    , tgtSupportsIdentDirective :: Bool
    , tgtWordSize :: WordSize
    , tgtEndianness :: Endianness
    , tgtSymbolsHaveLeadingUnderscore :: Bool
    , tgtLlvmTarget :: String

      -- GHC capabilities
    , tgtUnregisterised :: Bool
    , tgtTablesNextToCode :: Bool
    -- , tgtHasThreadedRts :: Bool -- We likely just need this when bootstrapping
    , tgtUseLibffiForAdjustors :: Bool
    -- ^ We need to know whether or not to include libffi headers, and generate additional code for it

      -- C toolchain
    , tgtCCompiler :: Cc
    , tgtCxxCompiler :: Cxx
    , tgtCPreprocessor :: Cpp
    , tgtHsCPreprocessor :: HsCpp
    , tgtJsCPreprocessor :: Maybe JsCpp
    , tgtCmmCPreprocessor :: CmmCpp
    -- ^ We set it only in javascript target
    , tgtCCompilerLink :: CcLink
    , tgtAr :: Ar
    , tgtRanlib :: Maybe Ranlib
    -- ^ N.B. Most @ar@ implementations will add an index by default without @ranlib@ so this is often optional
    , tgtNm :: Nm
    , tgtMergeObjs :: Maybe MergeObjs
    -- ^ We don't need a merge objects tool if we @Ar@ supports @-L@

      -- Windows-specific tools
    , tgtWindres :: Maybe Program
    }
    deriving (Read, Eq, Ord)

-- | The word size as an integer representing the number of bytes
wordSize2Bytes :: WordSize -> Int
wordSize2Bytes WS4 = 4
wordSize2Bytes WS8 = 8

-- | Reconstruct the platform triple from a toolchain target
-- (specifically from tgtArchOs and tgtVendor)
targetPlatformTriple :: Target -> String
targetPlatformTriple Target{tgtArchOs, tgtVendor} =
  let archStr = stringEncodeArch $ archOS_arch tgtArchOs
      osStr   = stringEncodeOS $ archOS_OS tgtArchOs
   in case tgtVendor of
        Nothing -> archStr <> "-" <> osStr
        Just vendor -> archStr <> "-" <> vendor <> "-" <> osStr

-- | Handwritten Show instance to have have better diffs against the toolchain
-- targets generated by configure
instance Show Target where
  show Target{..} = unlines
    [ "Target"
    , "{ tgtArchOs = " ++ show tgtArchOs
    , ", tgtVendor = " ++ show tgtVendor
    , ", tgtLocallyExecutable = " ++ show tgtLocallyExecutable
    , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack
    , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols
    , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective
    , ", tgtWordSize = " ++ show tgtWordSize
    , ", tgtEndianness = " ++ show tgtEndianness
    , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore
    , ", tgtLlvmTarget = " ++ show tgtLlvmTarget
    , ", tgtUnregisterised = " ++ show tgtUnregisterised
    , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode
    , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors
    , ", tgtCCompiler = " ++ show tgtCCompiler
    , ", tgtCxxCompiler = " ++ show tgtCxxCompiler
    , ", tgtCPreprocessor = " ++ show tgtCPreprocessor
    , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor
    , ", tgtJsCPreprocessor = " ++ show tgtJsCPreprocessor
    , ", tgtCmmCPreprocessor = " ++ show tgtCmmCPreprocessor
    , ", tgtCCompilerLink = " ++ show tgtCCompilerLink
    , ", tgtAr = " ++ show tgtAr
    , ", tgtRanlib = " ++ show tgtRanlib
    , ", tgtNm = " ++ show tgtNm
    , ", tgtMergeObjs = " ++ show tgtMergeObjs
    , ", tgtWindres = " ++ show tgtWindres
    , "}"
    ]
