{-# LANGUAGE CPP #-}

-- | Llvm code generator configuration
module GHC.CmmToLlvm.Config
  ( LlvmCgConfig(..)
  , LlvmConfig(..)
  , LlvmTarget(..)
  , initLlvmConfig
  -- * LLVM version
  , LlvmVersion(..)
  , supportedLlvmVersionLowerBound
  , supportedLlvmVersionUpperBound
  , parseLlvmVersion
  , llvmVersionSupported
  , llvmVersionStr
  , llvmVersionList
  )
where

#include "ghc-llvm-version.h"

import GHC.Prelude
import GHC.Platform

import GHC.Utils.Outputable
import GHC.Settings.Utils
import GHC.Utils.Panic

import Data.Char (isDigit)
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NE
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 -> 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)]
  }


---------------------------------------------------------
-- LLVM version
---------------------------------------------------------

newtype LlvmVersion = LlvmVersion { LlvmVersion -> NonEmpty Int
llvmVersionNE :: NE.NonEmpty Int }
  deriving (LlvmVersion -> LlvmVersion -> Bool
(LlvmVersion -> LlvmVersion -> Bool)
-> (LlvmVersion -> LlvmVersion -> Bool) -> Eq LlvmVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LlvmVersion -> LlvmVersion -> Bool
== :: LlvmVersion -> LlvmVersion -> Bool
$c/= :: LlvmVersion -> LlvmVersion -> Bool
/= :: LlvmVersion -> LlvmVersion -> Bool
Eq, Eq LlvmVersion
Eq LlvmVersion =>
(LlvmVersion -> LlvmVersion -> Ordering)
-> (LlvmVersion -> LlvmVersion -> Bool)
-> (LlvmVersion -> LlvmVersion -> Bool)
-> (LlvmVersion -> LlvmVersion -> Bool)
-> (LlvmVersion -> LlvmVersion -> Bool)
-> (LlvmVersion -> LlvmVersion -> LlvmVersion)
-> (LlvmVersion -> LlvmVersion -> LlvmVersion)
-> Ord LlvmVersion
LlvmVersion -> LlvmVersion -> Bool
LlvmVersion -> LlvmVersion -> Ordering
LlvmVersion -> LlvmVersion -> LlvmVersion
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
$ccompare :: LlvmVersion -> LlvmVersion -> Ordering
compare :: LlvmVersion -> LlvmVersion -> Ordering
$c< :: LlvmVersion -> LlvmVersion -> Bool
< :: LlvmVersion -> LlvmVersion -> Bool
$c<= :: LlvmVersion -> LlvmVersion -> Bool
<= :: LlvmVersion -> LlvmVersion -> Bool
$c> :: LlvmVersion -> LlvmVersion -> Bool
> :: LlvmVersion -> LlvmVersion -> Bool
$c>= :: LlvmVersion -> LlvmVersion -> Bool
>= :: LlvmVersion -> LlvmVersion -> Bool
$cmax :: LlvmVersion -> LlvmVersion -> LlvmVersion
max :: LlvmVersion -> LlvmVersion -> LlvmVersion
$cmin :: LlvmVersion -> LlvmVersion -> LlvmVersion
min :: LlvmVersion -> LlvmVersion -> LlvmVersion
Ord)

parseLlvmVersion :: String -> Maybe LlvmVersion
parseLlvmVersion :: String -> Maybe LlvmVersion
parseLlvmVersion =
    (NonEmpty Int -> LlvmVersion)
-> Maybe (NonEmpty Int) -> Maybe LlvmVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Int -> LlvmVersion
LlvmVersion (Maybe (NonEmpty Int) -> Maybe LlvmVersion)
-> (String -> Maybe (NonEmpty Int)) -> String -> Maybe LlvmVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe (NonEmpty Int)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Int] -> Maybe (NonEmpty Int))
-> (String -> [Int]) -> String -> Maybe (NonEmpty Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String -> [Int]
forall {a}. Read a => [a] -> String -> [a]
go [] (String -> [Int]) -> (String -> String) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)
  where
    go :: [a] -> String -> [a]
go [a]
vs String
s
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ver_str
      = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
vs
      | Char
'.' : String
rest' <- String
rest
      = [a] -> String -> [a]
go (String -> a
forall a. Read a => String -> a
read String
ver_str a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs) String
rest'
      | Bool
otherwise
      = [a] -> [a]
forall a. [a] -> [a]
reverse (String -> a
forall a. Read a => String -> a
read String
ver_str a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs)
      where
        (String
ver_str, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
s

-- | The (inclusive) lower bound on the LLVM Version that is currently supported.
supportedLlvmVersionLowerBound :: LlvmVersion
supportedLlvmVersionLowerBound :: LlvmVersion
supportedLlvmVersionLowerBound = NonEmpty Int -> LlvmVersion
LlvmVersion (sUPPORTED_LLVM_VERSION_MIN NE.:| [])

-- | The (not-inclusive) upper bound  bound on the LLVM Version that is currently supported.
supportedLlvmVersionUpperBound :: LlvmVersion
supportedLlvmVersionUpperBound :: LlvmVersion
supportedLlvmVersionUpperBound = NonEmpty Int -> LlvmVersion
LlvmVersion (sUPPORTED_LLVM_VERSION_MAX NE.:| [])

llvmVersionSupported :: LlvmVersion -> Bool
llvmVersionSupported :: LlvmVersion -> Bool
llvmVersionSupported LlvmVersion
v =
  LlvmVersion
v LlvmVersion -> LlvmVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= LlvmVersion
supportedLlvmVersionLowerBound Bool -> Bool -> Bool
&& LlvmVersion
v LlvmVersion -> LlvmVersion -> Bool
forall a. Ord a => a -> a -> Bool
< LlvmVersion
supportedLlvmVersionUpperBound

llvmVersionStr :: LlvmVersion -> String
llvmVersionStr :: LlvmVersion -> String
llvmVersionStr = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> (LlvmVersion -> [String]) -> LlvmVersion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String])
-> (LlvmVersion -> [Int]) -> LlvmVersion -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmVersion -> [Int]
llvmVersionList

llvmVersionList :: LlvmVersion -> [Int]
llvmVersionList :: LlvmVersion -> [Int]
llvmVersionList = NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Int -> [Int])
-> (LlvmVersion -> NonEmpty Int) -> LlvmVersion -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LlvmVersion -> NonEmpty Int
llvmVersionNE