-- | Llvm code generator configuration
module GHC.CmmToLlvm.Config
  ( LlvmCgConfig(..)
  , LlvmConfig(..)
  , LlvmTarget(..)
  , initLlvmConfig
  )
where

import GHC.Prelude
import GHC.Platform

import GHC.Utils.Outputable
import GHC.Settings.Utils
import GHC.Utils.Panic
import GHC.CmmToLlvm.Version.Type (LlvmVersion)

import System.FilePath

data LlvmCgConfig = LlvmCgConfig
  { LlvmCgConfig -> Platform
llvmCgPlatform          :: !Platform     -- ^ Target platform
  , LlvmCgConfig -> SDocContext
llvmCgContext           :: !SDocContext  -- ^ Context for LLVM code generation
  , LlvmCgConfig -> Bool
llvmCgFillUndefWithGarbage :: !Bool      -- ^ Fill undefined literals with garbage values
  , LlvmCgConfig -> Bool
llvmCgSplitSection      :: !Bool         -- ^ Split sections
  , LlvmCgConfig -> Bool
llvmCgAvxEnabled        :: !Bool
  , LlvmCgConfig -> Maybe BmiVersion
llvmCgBmiVersion        :: Maybe BmiVersion  -- ^ (x86) BMI instructions
  , LlvmCgConfig -> Maybe LlvmVersion
llvmCgLlvmVersion       :: Maybe LlvmVersion -- ^ version of Llvm we're using
  , LlvmCgConfig -> Bool
llvmCgDoWarn            :: !Bool         -- ^ True ==> warn unsupported Llvm version
  , LlvmCgConfig -> String
llvmCgLlvmTarget        :: !String       -- ^ target triple passed to LLVM
  , LlvmCgConfig -> LlvmConfig
llvmCgLlvmConfig        :: !LlvmConfig   -- ^ Supported LLVM configurations.
                                             -- see Note [LLVM configuration]
  }

data LlvmTarget = LlvmTarget
  { LlvmTarget -> String
lDataLayout :: String
  , LlvmTarget -> String
lCPU        :: String
  , LlvmTarget -> [String]
lAttributes :: [String]
  }

-- Note [LLVM configuration]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- The `llvm-targets` and `llvm-passes` files are shipped with GHC and contain
-- information needed by the LLVM backend to invoke `llc` and `opt`.
-- Specifically:
--
--  * llvm-targets maps autoconf host triples to the corresponding LLVM
--    `data-layout` declarations. This information is extracted from clang using
--    the script in utils/llvm-targets/gen-data-layout.sh and should be updated
--    whenever we target a new version of LLVM.
--
--  * llvm-passes maps GHC optimization levels to sets of LLVM optimization
--    flags that GHC should pass to `opt`.
--
-- This information is contained in files rather the GHC source to allow users
-- to add new targets to GHC without having to recompile the compiler.
--

initLlvmConfig :: FilePath -> IO LlvmConfig
initLlvmConfig :: String -> IO LlvmConfig
initLlvmConfig String
top_dir
  = do
      [(String, (String, String, String))]
targets <- String -> IO [(String, (String, String, String))]
forall a. Read a => String -> IO a
readAndParse String
"llvm-targets"
      [(Int, String)]
passes <- String -> IO [(Int, String)]
forall a. Read a => String -> IO a
readAndParse String
"llvm-passes"
      LlvmConfig -> IO LlvmConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmConfig -> IO LlvmConfig) -> LlvmConfig -> IO LlvmConfig
forall a b. (a -> b) -> a -> b
$ LlvmConfig
        { llvmTargets :: [(String, LlvmTarget)]
llvmTargets = ((String, String, String) -> LlvmTarget)
-> (String, (String, String, String)) -> (String, LlvmTarget)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String, String) -> LlvmTarget
mkLlvmTarget ((String, (String, String, String)) -> (String, LlvmTarget))
-> [(String, (String, String, String))] -> [(String, LlvmTarget)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, (String, String, String))]
targets
        , llvmPasses :: [(Int, String)]
llvmPasses = [(Int, String)]
passes
        }
  where
    readAndParse :: Read a => String -> IO a
    readAndParse :: forall a. Read a => String -> IO a
readAndParse String
name = do
      let f :: String
f = String
top_dir String -> String -> String
</> String
name
      String
llvmConfigStr <- String -> IO String
readFile String
f
      case String -> Maybe a
forall a. Read a => String -> Maybe a
maybeReadFuzzy String
llvmConfigStr of
        Just a
s -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s
        Maybe a
Nothing -> String -> IO a
forall a. HasCallStack => String -> a
pgmError (String
"Can't parse LLVM config file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
f)

    mkLlvmTarget :: (String, String, String) -> LlvmTarget
    mkLlvmTarget :: (String, String, String) -> LlvmTarget
mkLlvmTarget (String
dl, String
cpu, String
attrs) = String -> String -> [String] -> LlvmTarget
LlvmTarget String
dl String
cpu (String -> [String]
words String
attrs)

data LlvmConfig = LlvmConfig
  { LlvmConfig -> [(String, LlvmTarget)]
llvmTargets :: [(String, LlvmTarget)]
  , LlvmConfig -> [(Int, String)]
llvmPasses  :: [(Int, String)]
  }