{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module GHC.Toolchain.Tools.Cc
( Cc(..)
, _ccProgram
, findBasicCc
, findCc
, preprocess
, compileC
, compileAsm
, addPlatformDepCcFlags
, checkC99Support
) where
import Control.Monad
import Data.List (isInfixOf)
import System.FilePath
import GHC.Platform.ArchOS
import GHC.Toolchain.Prelude
import GHC.Toolchain.Utils
import GHC.Toolchain.Program
newtype Cc = Cc { Cc -> Program
ccProgram :: Program
}
deriving (Int -> Cc -> ShowS
[Cc] -> ShowS
Cc -> [Char]
(Int -> Cc -> ShowS)
-> (Cc -> [Char]) -> ([Cc] -> ShowS) -> Show Cc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cc -> ShowS
showsPrec :: Int -> Cc -> ShowS
$cshow :: Cc -> [Char]
show :: Cc -> [Char]
$cshowList :: [Cc] -> ShowS
showList :: [Cc] -> ShowS
Show, ReadPrec [Cc]
ReadPrec Cc
Int -> ReadS Cc
ReadS [Cc]
(Int -> ReadS Cc)
-> ReadS [Cc] -> ReadPrec Cc -> ReadPrec [Cc] -> Read Cc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cc
readsPrec :: Int -> ReadS Cc
$creadList :: ReadS [Cc]
readList :: ReadS [Cc]
$creadPrec :: ReadPrec Cc
readPrec :: ReadPrec Cc
$creadListPrec :: ReadPrec [Cc]
readListPrec :: ReadPrec [Cc]
Read, Cc -> Cc -> Bool
(Cc -> Cc -> Bool) -> (Cc -> Cc -> Bool) -> Eq Cc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cc -> Cc -> Bool
== :: Cc -> Cc -> Bool
$c/= :: Cc -> Cc -> Bool
/= :: Cc -> Cc -> Bool
Eq, Eq Cc
Eq Cc =>
(Cc -> Cc -> Ordering)
-> (Cc -> Cc -> Bool)
-> (Cc -> Cc -> Bool)
-> (Cc -> Cc -> Bool)
-> (Cc -> Cc -> Bool)
-> (Cc -> Cc -> Cc)
-> (Cc -> Cc -> Cc)
-> Ord Cc
Cc -> Cc -> Bool
Cc -> Cc -> Ordering
Cc -> Cc -> Cc
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 :: Cc -> Cc -> Ordering
compare :: Cc -> Cc -> Ordering
$c< :: Cc -> Cc -> Bool
< :: Cc -> Cc -> Bool
$c<= :: Cc -> Cc -> Bool
<= :: Cc -> Cc -> Bool
$c> :: Cc -> Cc -> Bool
> :: Cc -> Cc -> Bool
$c>= :: Cc -> Cc -> Bool
>= :: Cc -> Cc -> Bool
$cmax :: Cc -> Cc -> Cc
max :: Cc -> Cc -> Cc
$cmin :: Cc -> Cc -> Cc
min :: Cc -> Cc -> Cc
Ord)
_ccProgram :: Lens Cc Program
_ccProgram :: Lens Cc Program
_ccProgram = (Cc -> Program) -> (Program -> Cc -> Cc) -> Lens Cc Program
forall a b. (a -> b) -> (b -> a -> a) -> Lens a b
Lens Cc -> Program
ccProgram (\Program
x Cc
o -> Cc
o{ccProgram=x})
_ccFlags :: Lens Cc [String]
_ccFlags :: Lens Cc [[Char]]
_ccFlags = Lens Cc Program
_ccProgram Lens Cc Program -> Lens Program [[Char]] -> Lens Cc [[Char]]
forall a b c. Lens a b -> Lens b c -> Lens a c
% Lens Program [[Char]]
_prgFlags
findBasicCc :: ProgOpt -> M Cc
findBasicCc :: ProgOpt -> M Cc
findBasicCc ProgOpt
progOpt = [Char] -> M Cc -> M Cc
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"for C compiler" (M Cc -> M Cc) -> M Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ do
ccProgram <- [Char] -> ProgOpt -> [[Char]] -> M Program
findProgram [Char]
"C compiler" ProgOpt
progOpt [[Char]
"gcc", [Char]
"clang", [Char]
"cc"]
return $ Cc{ccProgram}
findCc :: ArchOS
-> String
-> ProgOpt -> M Cc
findCc :: ArchOS -> [Char] -> ProgOpt -> M Cc
findCc ArchOS
archOs [Char]
llvmTarget ProgOpt
progOpt = do
cc0 <- ProgOpt -> M Cc
findBasicCc ProgOpt
progOpt
cc1 <- ignoreUnusedArgs cc0
cc2 <- ccSupportsTarget archOs llvmTarget cc1
checking "whether Cc works" $ checkCcWorks cc2
cc3 <- oneOf "cc doesn't support C99" $ map checkC99Support
[ cc2
, cc2 & _ccFlags %++ "-std=gnu99"
]
checkCcSupportsExtraViaCFlags cc3
return cc3
checkCcWorks :: Cc -> M ()
checkCcWorks :: Cc -> M ()
checkCcWorks Cc
cc = ([Char] -> M ()) -> M ()
forall a. ([Char] -> M a) -> M a
withTempDir (([Char] -> M ()) -> M ()) -> ([Char] -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
let test_o :: [Char]
test_o = [Char]
dir [Char] -> ShowS
</> [Char]
"test.o"
Cc -> [Char] -> [Char] -> M ()
compileC Cc
cc [Char]
test_o ([Char] -> M ()) -> [Char] -> M ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"#include <stdio.h>"
, [Char]
"int main(int argc, char **argv) {"
, [Char]
" printf(\"hello world!\");"
, [Char]
" return 0;"
, [Char]
"}"
]
ignoreUnusedArgs :: Cc -> M Cc
ignoreUnusedArgs :: Cc -> M Cc
ignoreUnusedArgs Cc
cc
| [Char]
"-Qunused-arguments" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Lens Cc [[Char]] -> Cc -> [[Char]]
forall a b. Lens a b -> a -> b
view Lens Cc [[Char]]
_ccFlags Cc
cc) = Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Cc
cc
| Bool
otherwise
= [Char] -> M Cc -> M Cc
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"for -Qunused-arguments support" (M Cc -> M Cc) -> M Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ do
let cc' :: Cc
cc' = Cc
cc Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-Qunused-arguments"
(Cc
cc' Cc -> M () -> M Cc
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Cc -> M ()
checkCcWorks Cc
cc') M Cc -> M Cc -> M Cc
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Cc
cc
ccSupportsTarget :: ArchOS -> String -> Cc -> M Cc
ccSupportsTarget :: ArchOS -> [Char] -> Cc -> M Cc
ccSupportsTarget ArchOS
archOs [Char]
target Cc
cc =
[Char] -> M Cc -> M Cc
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"whether Cc supports --target" (M Cc -> M Cc) -> M Cc -> M Cc
forall a b. (a -> b) -> a -> b
$
ArchOS -> Lens Cc Program -> (Cc -> M ()) -> [Char] -> Cc -> M Cc
forall compiler.
ArchOS
-> Lens compiler Program
-> (compiler -> M ())
-> [Char]
-> compiler
-> M compiler
supportsTarget ArchOS
archOs Lens Cc Program
_ccProgram Cc -> M ()
checkCcWorks [Char]
target Cc
cc
checkC99Support :: Cc -> M Cc
checkC99Support :: Cc -> M Cc
checkC99Support Cc
cc = [Char] -> M Cc -> M Cc
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"for C99 support" (M Cc -> M Cc) -> M Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ ([Char] -> M Cc) -> M Cc
forall a. ([Char] -> M a) -> M a
withTempDir (([Char] -> M Cc) -> M Cc) -> ([Char] -> M Cc) -> M Cc
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
let test_o :: [Char]
test_o = [Char]
dir [Char] -> ShowS
</> [Char]
"test.o"
Cc -> [Char] -> [Char] -> M ()
compileC Cc
cc [Char]
test_o ([Char] -> M ()) -> [Char] -> M ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"#include <stdio.h>"
, [Char]
"#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L"
, [Char]
"# error \"Compiler does not advertise C99 conformance\""
, [Char]
"#endif"
]
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Cc
cc
checkCcSupportsExtraViaCFlags :: Cc -> M ()
Cc
cc = [Char] -> M () -> M ()
forall a. Show a => [Char] -> M a -> M a
checking [Char]
"whether cc supports extra via-c flags" (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> M ()) -> M ()
forall a. ([Char] -> M a) -> M a
withTempDir (([Char] -> M ()) -> M ()) -> ([Char] -> M ()) -> M ()
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
let test_o :: [Char]
test_o = [Char]
dir [Char] -> ShowS
</> [Char]
"test.o"
test_c :: [Char]
test_c = [Char]
test_o [Char] -> ShowS
-<.> [Char]
"c"
[Char] -> [Char] -> M ()
writeFile [Char]
test_c [Char]
"int main() { return 0; }"
(code, out, err) <- Program -> [[Char]] -> M (ExitCode, [Char], [Char])
readProgram (Cc -> Program
ccProgram Cc
cc)
[ [Char]
"-c"
, [Char]
"-fwrapv", [Char]
"-fno-builtin"
, [Char]
"-Werror", [Char]
"-x", [Char]
"c"
, [Char]
"-o", [Char]
test_o, [Char]
test_c]
when (not (isSuccess code)
|| "unrecognized" `isInfixOf` out
|| "unrecognized" `isInfixOf` err
) $
throwE "Your C compiler must support the -fwrapv and -fno-builtin flags"
preprocess
:: Cc
-> String
-> M String
preprocess :: Cc -> [Char] -> M [Char]
preprocess Cc
cc [Char]
prog = ([Char] -> M [Char]) -> M [Char]
forall a. ([Char] -> M a) -> M a
withTempDir (([Char] -> M [Char]) -> M [Char])
-> ([Char] -> M [Char]) -> M [Char]
forall a b. (a -> b) -> a -> b
$ \[Char]
dir -> do
let out :: [Char]
out = [Char]
dir [Char] -> ShowS
</> [Char]
"test.c"
[Char]
-> [[Char]] -> Lens Cc Program -> Cc -> [Char] -> [Char] -> M ()
forall compiler.
[Char]
-> [[Char]]
-> Lens compiler Program
-> compiler
-> [Char]
-> [Char]
-> M ()
compile [Char]
"c" [[Char]
"-E"] Lens Cc Program
_ccProgram Cc
cc [Char]
out [Char]
prog
[Char] -> M [Char]
readFile [Char]
out
compileC
:: Cc
-> FilePath
-> String
-> M ()
compileC :: Cc -> [Char] -> [Char] -> M ()
compileC = [Char]
-> [[Char]] -> Lens Cc Program -> Cc -> [Char] -> [Char] -> M ()
forall compiler.
[Char]
-> [[Char]]
-> Lens compiler Program
-> compiler
-> [Char]
-> [Char]
-> M ()
compile [Char]
"c" [[Char]
"-c"] Lens Cc Program
_ccProgram
compileAsm
:: Cc
-> FilePath
-> String
-> M ()
compileAsm :: Cc -> [Char] -> [Char] -> M ()
compileAsm = [Char]
-> [[Char]] -> Lens Cc Program -> Cc -> [Char] -> [Char] -> M ()
forall compiler.
[Char]
-> [[Char]]
-> Lens compiler Program
-> compiler
-> [Char]
-> [Char]
-> M ()
compile [Char]
"S" [[Char]
"-c"] Lens Cc Program
_ccProgram
addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc
addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc
addPlatformDepCcFlags ArchOS
archOs Cc
cc0 = do
let cc1 :: Cc
cc1 = ArchOS -> Cc -> Cc
addWorkaroundFor7799 ArchOS
archOs Cc
cc0
case ArchOS
archOs of
ArchOS Arch
ArchX86 OS
OSFreeBSD ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-march=i686"
ArchOS Arch
ArchX86_64 OS
OSSolaris2 ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-m64"
ArchOS Arch
ArchAlpha OS
_ ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]] -> ([[Char]] -> [[Char]]) -> Cc -> Cc
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Cc [[Char]]
_ccFlags ([[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++[[Char]
"-w",[Char]
"-mieee",[Char]
"-D_REENTRANT"])
ArchOS ArchARM{} OS
OSFreeBSD ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-marm"
ArchOS ArchARM{} OS
OSLinux ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-marm"
ArchOS Arch
ArchPPC OS
OSAIX ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-D_THREAD_SAFE"
ArchOS Arch
ArchLoongArch64 OS
OSLinux ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cc -> M Cc) -> Cc -> M Cc
forall a b. (a -> b) -> a -> b
$ Cc
cc1 Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-mcmodel=medium"
ArchOS
_ ->
Cc -> M Cc
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Cc
cc1
addWorkaroundFor7799 :: ArchOS -> Cc -> Cc
addWorkaroundFor7799 :: ArchOS -> Cc -> Cc
addWorkaroundFor7799 ArchOS
archOs Cc
cc
| Arch
ArchX86 <- ArchOS -> Arch
archOS_arch ArchOS
archOs = Cc
cc Cc -> (Cc -> Cc) -> Cc
forall a b. a -> (a -> b) -> b
& Lens Cc [[Char]]
_ccFlags Lens Cc [[Char]] -> [Char] -> Cc -> Cc
forall a b. Lens a [b] -> b -> a -> a
%++ [Char]
"-U__i686"
| Bool
otherwise = Cc
cc