module DDC.Build.Platform
( Platform (..)
, staticFileExtensionOfPlatform
, sharedFileExtensionOfPlatform
, Arch (..)
, archPointerWidth
, Os (..)
, determineHostPlatform
, determineHostArch
, determineHostOs
, determineHostLlvmVersion)
where
import DDC.Base.Pretty
import Data.List as List
import Data.Maybe as Maybe
import Data.Char as Char
import qualified System.Process as System
import qualified System.Exit as System
data Platform
= Platform
{ platformArch :: Arch
, platformOs :: Os }
deriving (Eq, Show)
instance Pretty Platform where
ppr platform
= vcat
[ text "Processor Architecture : " <> ppr (platformArch platform)
, text "Operating System : " <> ppr (platformOs platform) ]
staticFileExtensionOfPlatform :: Platform -> String
staticFileExtensionOfPlatform pp
= case platformOs pp of
OsDarwin{} -> "a"
OsLinux -> "a"
OsCygwin -> "a"
OsMingw -> "a"
sharedFileExtensionOfPlatform :: Platform -> String
sharedFileExtensionOfPlatform pp
= case platformOs pp of
OsDarwin{} -> "dylib"
OsLinux -> "so"
OsCygwin -> "so"
OsMingw -> "dll"
data Arch
= ArchX86_32
| ArchX86_64
| ArchPPC_32
| ArchPPC_64
deriving (Eq, Show)
instance Pretty Arch where
ppr arch
= case arch of
ArchX86_32 -> text "x86 32-bit"
ArchX86_64 -> text "x86 64-bit"
ArchPPC_32 -> text "PPC 32-bit"
ArchPPC_64 -> text "PPC 64-bit"
archPointerWidth :: Arch -> Int
archPointerWidth arch
= case arch of
ArchX86_32 -> 32
ArchX86_64 -> 64
ArchPPC_32 -> 32
ArchPPC_64 -> 64
data Os
= OsDarwin (Maybe (Int, Int, Int))
| OsLinux
| OsCygwin
| OsMingw
deriving (Eq, Show)
instance Pretty Os where
ppr os
= case os of
OsDarwin{} -> text "Darwin"
OsLinux -> text "Linux"
OsCygwin -> text "Cygwin"
OsMingw -> text "Mingw"
determineHostPlatform :: IO (Maybe Platform)
determineHostPlatform
= do mArch <- determineHostArch
mOs <- determineHostOs
case (mArch, mOs) of
(Just arch, Just os) -> return $ Just (Platform arch os)
_ -> return Nothing
determineHostArch :: IO (Maybe Arch)
determineHostArch
= do (exitCode, strArch, _)
<- System.readProcessWithExitCode "uname" ["-m"] ""
let result
| System.ExitFailure{} <- exitCode
= Nothing
| isPrefixOf "i386" strArch = Just ArchX86_32
| isPrefixOf "i486" strArch = Just ArchX86_32
| isPrefixOf "i586" strArch = Just ArchX86_32
| isPrefixOf "i686" strArch = Just ArchX86_32
| isPrefixOf "x86_64" strArch = Just ArchX86_64
| isPrefixOf "ppc" strArch = Just ArchPPC_32
| isPrefixOf "ppc64" strArch = Just ArchPPC_64
| otherwise = Nothing
return result
determineHostOs :: IO (Maybe Os)
determineHostOs
= do (exitCode, strOs, _)
<- System.readProcessWithExitCode "uname" [] ""
case exitCode of
System.ExitFailure{}
-> return Nothing
System.ExitSuccess
| isPrefixOf "Darwin" strOs -> determineHostOsDarwin
| isPrefixOf "Linux" strOs -> return $ Just OsLinux
| isPrefixOf "CYGWIN" strOs -> return $ Just OsCygwin
| isPrefixOf "MINGW" strOs -> return $ Just OsMingw
| otherwise -> return Nothing
determineHostOsDarwin :: IO (Maybe Os)
determineHostOsDarwin
= do (exitCode, strVersion, _)
<- System.readProcessWithExitCode "uname" ["-r"] ""
case exitCode of
System.ExitFailure{}
-> return Nothing
System.ExitSuccess
| (dsMajor, '.' : rest1) <- List.span isDigit strVersion
, nMajor <- read dsMajor
, (dsMinor, '.' : rest2) <- List.span isDigit rest1
, nMinor <- read dsMinor
, (dsPatch, _) <- List.span isDigit rest2
, nPatch <- read dsPatch
-> return $ Just $ OsDarwin (Just (nMajor, nMinor, nPatch))
| otherwise
-> return $ Nothing
determineHostLlvmVersion :: Maybe FilePath -> IO (Maybe String)
determineHostLlvmVersion mpath
= do
let path = fromMaybe "llc" mpath
(exitCode, strAll, _)
<- System.readProcessWithExitCode path ["-version"] ""
case exitCode of
System.ExitFailure{}
-> return Nothing
System.ExitSuccess
-> do
let ls = map (takeWhile $ not . Char.isSpace)
$ map (dropWhile Char.isSpace)
$ mapMaybe (stripPrefix "LLVM version")
$ map (dropWhile Char.isSpace)
$ lines strAll
case ls of
[str] -> return $ Just str
_ -> return Nothing