{-# LANGUAGE NamedFieldPuns #-}

module GHC.Toolchain.Tools.Cpp
  (HsCpp(..), findHsCpp
  , Cpp(..), findCpp
  , JsCpp(..), findJsCpp
  , CmmCpp(..), findCmmCpp
  ) where

import Control.Monad
import System.FilePath
import Data.List(isInfixOf, dropWhileEnd)
import Data.Char(isSpace)

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

import GHC.Toolchain.Tools.Cc
import GHC.Toolchain.Utils (withTempDir, oneOf, expectFileExists)

newtype Cpp = Cpp { Cpp -> Program
cppProgram :: Program
                    }
    deriving (Int -> Cpp -> ShowS
[Cpp] -> ShowS
Cpp -> String
(Int -> Cpp -> ShowS)
-> (Cpp -> String) -> ([Cpp] -> ShowS) -> Show Cpp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cpp -> ShowS
showsPrec :: Int -> Cpp -> ShowS
$cshow :: Cpp -> String
show :: Cpp -> String
$cshowList :: [Cpp] -> ShowS
showList :: [Cpp] -> ShowS
Show, ReadPrec [Cpp]
ReadPrec Cpp
Int -> ReadS Cpp
ReadS [Cpp]
(Int -> ReadS Cpp)
-> ReadS [Cpp] -> ReadPrec Cpp -> ReadPrec [Cpp] -> Read Cpp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Cpp
readsPrec :: Int -> ReadS Cpp
$creadList :: ReadS [Cpp]
readList :: ReadS [Cpp]
$creadPrec :: ReadPrec Cpp
readPrec :: ReadPrec Cpp
$creadListPrec :: ReadPrec [Cpp]
readListPrec :: ReadPrec [Cpp]
Read, Cpp -> Cpp -> Bool
(Cpp -> Cpp -> Bool) -> (Cpp -> Cpp -> Bool) -> Eq Cpp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cpp -> Cpp -> Bool
== :: Cpp -> Cpp -> Bool
$c/= :: Cpp -> Cpp -> Bool
/= :: Cpp -> Cpp -> Bool
Eq, Eq Cpp
Eq Cpp =>
(Cpp -> Cpp -> Ordering)
-> (Cpp -> Cpp -> Bool)
-> (Cpp -> Cpp -> Bool)
-> (Cpp -> Cpp -> Bool)
-> (Cpp -> Cpp -> Bool)
-> (Cpp -> Cpp -> Cpp)
-> (Cpp -> Cpp -> Cpp)
-> Ord Cpp
Cpp -> Cpp -> Bool
Cpp -> Cpp -> Ordering
Cpp -> Cpp -> Cpp
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 :: Cpp -> Cpp -> Ordering
compare :: Cpp -> Cpp -> Ordering
$c< :: Cpp -> Cpp -> Bool
< :: Cpp -> Cpp -> Bool
$c<= :: Cpp -> Cpp -> Bool
<= :: Cpp -> Cpp -> Bool
$c> :: Cpp -> Cpp -> Bool
> :: Cpp -> Cpp -> Bool
$c>= :: Cpp -> Cpp -> Bool
>= :: Cpp -> Cpp -> Bool
$cmax :: Cpp -> Cpp -> Cpp
max :: Cpp -> Cpp -> Cpp
$cmin :: Cpp -> Cpp -> Cpp
min :: Cpp -> Cpp -> Cpp
Ord)

newtype HsCpp = HsCpp { HsCpp -> Program
hsCppProgram :: Program
                      }
    deriving (Int -> HsCpp -> ShowS
[HsCpp] -> ShowS
HsCpp -> String
(Int -> HsCpp -> ShowS)
-> (HsCpp -> String) -> ([HsCpp] -> ShowS) -> Show HsCpp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsCpp -> ShowS
showsPrec :: Int -> HsCpp -> ShowS
$cshow :: HsCpp -> String
show :: HsCpp -> String
$cshowList :: [HsCpp] -> ShowS
showList :: [HsCpp] -> ShowS
Show, ReadPrec [HsCpp]
ReadPrec HsCpp
Int -> ReadS HsCpp
ReadS [HsCpp]
(Int -> ReadS HsCpp)
-> ReadS [HsCpp]
-> ReadPrec HsCpp
-> ReadPrec [HsCpp]
-> Read HsCpp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HsCpp
readsPrec :: Int -> ReadS HsCpp
$creadList :: ReadS [HsCpp]
readList :: ReadS [HsCpp]
$creadPrec :: ReadPrec HsCpp
readPrec :: ReadPrec HsCpp
$creadListPrec :: ReadPrec [HsCpp]
readListPrec :: ReadPrec [HsCpp]
Read, HsCpp -> HsCpp -> Bool
(HsCpp -> HsCpp -> Bool) -> (HsCpp -> HsCpp -> Bool) -> Eq HsCpp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HsCpp -> HsCpp -> Bool
== :: HsCpp -> HsCpp -> Bool
$c/= :: HsCpp -> HsCpp -> Bool
/= :: HsCpp -> HsCpp -> Bool
Eq, Eq HsCpp
Eq HsCpp =>
(HsCpp -> HsCpp -> Ordering)
-> (HsCpp -> HsCpp -> Bool)
-> (HsCpp -> HsCpp -> Bool)
-> (HsCpp -> HsCpp -> Bool)
-> (HsCpp -> HsCpp -> Bool)
-> (HsCpp -> HsCpp -> HsCpp)
-> (HsCpp -> HsCpp -> HsCpp)
-> Ord HsCpp
HsCpp -> HsCpp -> Bool
HsCpp -> HsCpp -> Ordering
HsCpp -> HsCpp -> HsCpp
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 :: HsCpp -> HsCpp -> Ordering
compare :: HsCpp -> HsCpp -> Ordering
$c< :: HsCpp -> HsCpp -> Bool
< :: HsCpp -> HsCpp -> Bool
$c<= :: HsCpp -> HsCpp -> Bool
<= :: HsCpp -> HsCpp -> Bool
$c> :: HsCpp -> HsCpp -> Bool
> :: HsCpp -> HsCpp -> Bool
$c>= :: HsCpp -> HsCpp -> Bool
>= :: HsCpp -> HsCpp -> Bool
$cmax :: HsCpp -> HsCpp -> HsCpp
max :: HsCpp -> HsCpp -> HsCpp
$cmin :: HsCpp -> HsCpp -> HsCpp
min :: HsCpp -> HsCpp -> HsCpp
Ord)

newtype JsCpp = JsCpp { JsCpp -> Program
jsCppProgram :: Program
                      }
    deriving (Int -> JsCpp -> ShowS
[JsCpp] -> ShowS
JsCpp -> String
(Int -> JsCpp -> ShowS)
-> (JsCpp -> String) -> ([JsCpp] -> ShowS) -> Show JsCpp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsCpp -> ShowS
showsPrec :: Int -> JsCpp -> ShowS
$cshow :: JsCpp -> String
show :: JsCpp -> String
$cshowList :: [JsCpp] -> ShowS
showList :: [JsCpp] -> ShowS
Show, ReadPrec [JsCpp]
ReadPrec JsCpp
Int -> ReadS JsCpp
ReadS [JsCpp]
(Int -> ReadS JsCpp)
-> ReadS [JsCpp]
-> ReadPrec JsCpp
-> ReadPrec [JsCpp]
-> Read JsCpp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS JsCpp
readsPrec :: Int -> ReadS JsCpp
$creadList :: ReadS [JsCpp]
readList :: ReadS [JsCpp]
$creadPrec :: ReadPrec JsCpp
readPrec :: ReadPrec JsCpp
$creadListPrec :: ReadPrec [JsCpp]
readListPrec :: ReadPrec [JsCpp]
Read, JsCpp -> JsCpp -> Bool
(JsCpp -> JsCpp -> Bool) -> (JsCpp -> JsCpp -> Bool) -> Eq JsCpp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsCpp -> JsCpp -> Bool
== :: JsCpp -> JsCpp -> Bool
$c/= :: JsCpp -> JsCpp -> Bool
/= :: JsCpp -> JsCpp -> Bool
Eq, Eq JsCpp
Eq JsCpp =>
(JsCpp -> JsCpp -> Ordering)
-> (JsCpp -> JsCpp -> Bool)
-> (JsCpp -> JsCpp -> Bool)
-> (JsCpp -> JsCpp -> Bool)
-> (JsCpp -> JsCpp -> Bool)
-> (JsCpp -> JsCpp -> JsCpp)
-> (JsCpp -> JsCpp -> JsCpp)
-> Ord JsCpp
JsCpp -> JsCpp -> Bool
JsCpp -> JsCpp -> Ordering
JsCpp -> JsCpp -> JsCpp
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 :: JsCpp -> JsCpp -> Ordering
compare :: JsCpp -> JsCpp -> Ordering
$c< :: JsCpp -> JsCpp -> Bool
< :: JsCpp -> JsCpp -> Bool
$c<= :: JsCpp -> JsCpp -> Bool
<= :: JsCpp -> JsCpp -> Bool
$c> :: JsCpp -> JsCpp -> Bool
> :: JsCpp -> JsCpp -> Bool
$c>= :: JsCpp -> JsCpp -> Bool
>= :: JsCpp -> JsCpp -> Bool
$cmax :: JsCpp -> JsCpp -> JsCpp
max :: JsCpp -> JsCpp -> JsCpp
$cmin :: JsCpp -> JsCpp -> JsCpp
min :: JsCpp -> JsCpp -> JsCpp
Ord)

data CmmCpp = CmmCpp { CmmCpp -> Program
cmmCppProgram :: Program
                     , CmmCpp -> Bool
cmmCppSupportsG0 :: Bool
                     -- ^ Whether the C-- preprocessor supports -g0.  Extracted
                     -- out as -g0 needs to be appended to the complete
                     -- invocation, rather than prefix flags, in order to
                     -- override other flags.
                     }
    deriving (Int -> CmmCpp -> ShowS
[CmmCpp] -> ShowS
CmmCpp -> String
(Int -> CmmCpp -> ShowS)
-> (CmmCpp -> String) -> ([CmmCpp] -> ShowS) -> Show CmmCpp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmmCpp -> ShowS
showsPrec :: Int -> CmmCpp -> ShowS
$cshow :: CmmCpp -> String
show :: CmmCpp -> String
$cshowList :: [CmmCpp] -> ShowS
showList :: [CmmCpp] -> ShowS
Show, ReadPrec [CmmCpp]
ReadPrec CmmCpp
Int -> ReadS CmmCpp
ReadS [CmmCpp]
(Int -> ReadS CmmCpp)
-> ReadS [CmmCpp]
-> ReadPrec CmmCpp
-> ReadPrec [CmmCpp]
-> Read CmmCpp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CmmCpp
readsPrec :: Int -> ReadS CmmCpp
$creadList :: ReadS [CmmCpp]
readList :: ReadS [CmmCpp]
$creadPrec :: ReadPrec CmmCpp
readPrec :: ReadPrec CmmCpp
$creadListPrec :: ReadPrec [CmmCpp]
readListPrec :: ReadPrec [CmmCpp]
Read, CmmCpp -> CmmCpp -> Bool
(CmmCpp -> CmmCpp -> Bool)
-> (CmmCpp -> CmmCpp -> Bool) -> Eq CmmCpp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmmCpp -> CmmCpp -> Bool
== :: CmmCpp -> CmmCpp -> Bool
$c/= :: CmmCpp -> CmmCpp -> Bool
/= :: CmmCpp -> CmmCpp -> Bool
Eq, Eq CmmCpp
Eq CmmCpp =>
(CmmCpp -> CmmCpp -> Ordering)
-> (CmmCpp -> CmmCpp -> Bool)
-> (CmmCpp -> CmmCpp -> Bool)
-> (CmmCpp -> CmmCpp -> Bool)
-> (CmmCpp -> CmmCpp -> Bool)
-> (CmmCpp -> CmmCpp -> CmmCpp)
-> (CmmCpp -> CmmCpp -> CmmCpp)
-> Ord CmmCpp
CmmCpp -> CmmCpp -> Bool
CmmCpp -> CmmCpp -> Ordering
CmmCpp -> CmmCpp -> CmmCpp
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 :: CmmCpp -> CmmCpp -> Ordering
compare :: CmmCpp -> CmmCpp -> Ordering
$c< :: CmmCpp -> CmmCpp -> Bool
< :: CmmCpp -> CmmCpp -> Bool
$c<= :: CmmCpp -> CmmCpp -> Bool
<= :: CmmCpp -> CmmCpp -> Bool
$c> :: CmmCpp -> CmmCpp -> Bool
> :: CmmCpp -> CmmCpp -> Bool
$c>= :: CmmCpp -> CmmCpp -> Bool
>= :: CmmCpp -> CmmCpp -> Bool
$cmax :: CmmCpp -> CmmCpp -> CmmCpp
max :: CmmCpp -> CmmCpp -> CmmCpp
$cmin :: CmmCpp -> CmmCpp -> CmmCpp
min :: CmmCpp -> CmmCpp -> CmmCpp
Ord)

checkFlag :: String -> Program -> String -> [String] ->  M ()
checkFlag :: String -> Program -> String -> [String] -> M ()
checkFlag String
conftest Program
cpp String
flag [String]
extra_args = String -> M () -> M ()
forall a. Show a => String -> M a -> M a
checking (String
"for "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
flagString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" support") (M () -> M ()) -> M () -> M ()
forall a b. (a -> b) -> a -> b
$
  -- Werror to ensure that unrecognized warnings result in an error
  Program -> [String] -> M ()
callProgram Program
cpp ([String] -> M ()) -> [String] -> M ()
forall a b. (a -> b) -> a -> b
$ [String
"-Werror", String
flag, String
conftest] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_args
-- tryFlag :: String -> Program -> String -> M [String]
-- tryFlag conftest cpp flag =
--   ([flag] <$ checkFlag conftest cpp flag) <|> return []


----- Haskell Preprocessor -----

findHsCpp :: ProgOpt -> Cc -> M HsCpp
findHsCpp :: ProgOpt -> Cc -> M HsCpp
findHsCpp ProgOpt
progOpt Cc
cc = String -> M HsCpp -> M HsCpp
forall a. Show a => String -> M a -> M a
checking String
"for Haskell C preprocessor" (M HsCpp -> M HsCpp) -> M HsCpp -> M HsCpp
forall a b. (a -> b) -> a -> b
$ do
  -- Use the specified Hs Cpp or try to use the c compiler
  foundHsCppProg <- String -> ProgOpt -> [String] -> M Program
findProgram String
"Haskell C preprocessor" ProgOpt
progOpt [] M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgOpt -> String -> [String] -> Program
programFromOpt ProgOpt
progOpt (Program -> String
prgPath (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ Cc -> Program
ccProgram Cc
cc) [])
  -- Always add the -E flag to the CPP, regardless of the user options
  let rawHsCppProgram = String -> Program -> Program
addFlagIfNew String
"-E" Program
foundHsCppProg
  -- Always try to add the Haskell-specific CPP flags, regardless of the user options
  hppArgs <- findHsCppArgs rawHsCppProgram
  let hsCppProgram = Lens Program [String]
-> ([String] -> [String]) -> Program -> Program
forall a b. Lens a b -> (b -> b) -> a -> a
over Lens Program [String]
_prgFlags ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
hppArgs) Program
rawHsCppProgram
  return HsCpp{hsCppProgram}

-- | Given a C preprocessor, figure out how it should be invoked to preprocess
-- Haskell source.
findHsCppArgs :: Program -> M [String]
findHsCppArgs :: Program -> M [String]
findHsCppArgs Program
cpp = (String -> M [String]) -> M [String]
forall a. (String -> M a) -> M a
withTempDir ((String -> M [String]) -> M [String])
-> (String -> M [String]) -> M [String]
forall a b. (a -> b) -> a -> b
$ \String
dir -> do

  let tmp_c :: String
tmp_c = String
dir String -> ShowS
</> String
"tmp.c"
  String -> String -> M ()
writeFile String
tmp_c String
""
  (_, stdout0, stderr0) <- Program -> [String] -> M (ExitCode, String, String)
readProgram Program
cpp [String
"-x", String
"c", String
tmp_c, String
"-dM", String
"-E"]

  if "__clang__" `isInfixOf` stdout0 || "__clang__" `isInfixOf` stderr0
     then return ["-undef", "-traditional", "-Wno-invalid-pp-token", "-Wno-unicode", "-Wno-trigraphs"]
     else do
        (_, stdout1, stderr1) <- readProgram cpp ["-v"]
        if "gcc" `isInfixOf` stdout1 || "gcc" `isInfixOf` stderr1
          then return ["-undef", "-traditional"]
          else do
            logDebug "Can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly"
            return []


{- TODO: We want to just check which flags are accepted rather than branching on which compiler
         we are using but this does not match what ./configure does (#23720)

         When we retire configure then this more precise logic can be reinstated.
  withTmpDir $ \dir -> do
  let tmp_h = dir </> "tmp.h"

  writeFile tmp_h ""
  concat <$> sequence
      [ tryFlag "-undef"
      , ["-traditional"] <$ checkFlag tmp_h cpp "-traditional"
      , tryFlag tmp_h cpp "-Wno-invalid-pp-token"
      , tryFlag tmp_h cpp "-Wno-unicode"
      , tryFlag tmp_h cpp "-Wno-trigraphs"
      ]
      -}

----- JavaScript preprocessor -----

findJsCpp :: ProgOpt -> Cc -> M JsCpp
findJsCpp :: ProgOpt -> Cc -> M JsCpp
findJsCpp ProgOpt
progOpt Cc
cc = String -> M JsCpp -> M JsCpp
forall a. Show a => String -> M a -> M a
checking String
"for JavaScript C preprocessor" (M JsCpp -> M JsCpp) -> M JsCpp -> M JsCpp
forall a b. (a -> b) -> a -> b
$ do
  -- Use the specified Js Cpp
  foundJsCppProg <- String -> ProgOpt -> [String] -> M Program
findProgram String
"JavaScript C preprocessor" ProgOpt
progOpt [String
"emcc"] M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgOpt -> String -> [String] -> Program
programFromOpt ProgOpt
progOpt (Program -> String
prgPath (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ Cc -> Program
ccProgram Cc
cc) [])

  _ <- withTempDir $ \String
tmp_dir -> do
    String -> Program -> M ()
checkIsProcessing String
tmp_dir Program
foundJsCppProg

  let jsCppProgram = (String -> Program -> Program) -> Program -> [String] -> Program
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Program -> Program
addFlagIfNew Program
foundJsCppProg ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
required_flags_to_add)
  return JsCpp{jsCppProgram}
  where
    -- See: https://gcc.gnu.org/onlinedocs/gcc/Preprocessor-Options.html#index-CC
    -- See: https://clang.llvm.org/docs/ClangCommandLineReference.html#cmdoption-clang-CC
    -- Emscripten supports -C and -CC options same as GCC and CLang
    -- Always try to add the JavaScript-specific CPP flags, regardless of the user options
    -- Always add the -E flag, regardless of the user options
    -- We have to use -nostdinc to prevent adding copyright headers in gcc output.
    -- This issue is known and discussed here: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=59566
    required_flags_to_add :: [String]
required_flags_to_add =
      [ String
"-E"
      , String
"-CC"
      , String
"-Wno-unicode"
      , String
"-nostdinc"
      ]

    flags_for_test :: [String]
flags_for_test = [String]
required_flags_to_add [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
      [ String
"-P"
      , String
"-x", String
"assembler-with-cpp"
      ]

    file_source :: String
file_source = String
"conftest.js"
    file_output :: String
file_output = String
"conftest.pp.js"

    trim :: ShowS
trim = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

    checkIsProcessing :: String -> Program -> M ()
checkIsProcessing String
tmp_dir Program
prog = do
      let
        file_source_in_dir :: String
file_source_in_dir = String
tmp_dir String -> ShowS
</> String
file_source
        file_output_in_dir :: String
file_output_in_dir = String
tmp_dir String -> ShowS
</> String
file_output

      String -> String -> M ()
writeFile String
file_source_in_dir String
"#define DEF_TEST\n#ifdef DEF_TEST\n// 1\n#endif\n"

      Program -> [String] -> M ()
callProgram
        (Program
prog{ prgFlags = [] })
        ([String]
flags_for_test [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-o", String
file_output_in_dir, String
file_source_in_dir])

      String -> String -> M ()
expectFileExists String
file_output_in_dir (String
"JavaScript C Preprocessor didn't create the output file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file_output_in_dir)

      file_output_in_dir_content <- String -> M String
readFile String
file_output_in_dir
      unless (trim file_output_in_dir_content == "// 1")
        $ throwE "JavaScript C Preprocessor didn't provide correct output"

----- C-- preprocessor -----

findCmmCpp :: ProgOpt -> Cc -> M CmmCpp
findCmmCpp :: ProgOpt -> Cc -> M CmmCpp
findCmmCpp ProgOpt
progOpt Cc
cc = String -> M CmmCpp -> M CmmCpp
forall a. Show a => String -> M a -> M a
checking String
"for a Cmm preprocessor" (M CmmCpp -> M CmmCpp) -> M CmmCpp -> M CmmCpp
forall a b. (a -> b) -> a -> b
$ do
  -- Use the specified CPP or try to use the c compiler
  foundCppProg <- String -> ProgOpt -> [String] -> M Program
findProgram String
"Cmm preprocessor" ProgOpt
progOpt [] M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgOpt -> String -> [String] -> Program
programFromOpt ProgOpt
progOpt (Program -> String
prgPath (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ Cc -> Program
ccProgram Cc
cc) [])
  -- Check whether the C preprocessor needs -std=gnu99 (only very old toolchains need this)
  Cc cpp <- oneOf "cc doesn't support C99" $ map checkC99Support
        [ Cc foundCppProg
        , Cc (foundCppProg & _prgFlags %++ "-std=gnu99")
        ]

  cmmCppSupportsG0 <- withTempDir $ \String
dir -> do
    let conftest :: String
conftest = String
dir String -> ShowS
</> String
"conftest.c"
    String -> String -> M ()
writeFile String
conftest String
"int main(void) {}"
    Bool
True Bool -> M () -> M Bool
forall a b. a -> M b -> M a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Program -> String -> [String] -> M ()
checkFlag String
conftest Program
cpp String
"-g0" [String
"-o", String
dir String -> ShowS
</> String
"conftest"] M Bool -> M Bool -> M Bool
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> M Bool
forall a. a -> M a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  -- Always add the -E flag to the CPP, regardless of the user options
  let cmmCppProgram = (String -> Program -> Program) -> Program -> [String] -> Program
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Program -> Program
addFlagIfNew Program
cpp [String
"-E"]
  return CmmCpp{cmmCppProgram, cmmCppSupportsG0}

----- C preprocessor -----

findCpp :: ProgOpt -> Cc -> M Cpp
findCpp :: ProgOpt -> Cc -> M Cpp
findCpp ProgOpt
progOpt Cc
cc = String -> M Cpp -> M Cpp
forall a. Show a => String -> M a -> M a
checking String
"for C preprocessor" (M Cpp -> M Cpp) -> M Cpp -> M Cpp
forall a b. (a -> b) -> a -> b
$ do
  -- Use the specified CPP or try to use the c compiler
  foundCppProg <- String -> ProgOpt -> [String] -> M Program
findProgram String
"C preprocessor" ProgOpt
progOpt [] M Program -> M Program -> M Program
forall a. M a -> M a -> M a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Program -> M Program
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgOpt -> String -> [String] -> Program
programFromOpt ProgOpt
progOpt (Program -> String
prgPath (Program -> String) -> Program -> String
forall a b. (a -> b) -> a -> b
$ Cc -> Program
ccProgram Cc
cc) [])
  -- Check whether the C preprocessor needs -std=gnu99 (only very old toolchains need this)
  Cc cpp2 <- oneOf "cc doesn't support C99" $ map checkC99Support
        [ Cc foundCppProg
        , Cc (foundCppProg & _prgFlags %++ "-std=gnu99")
        ]
  -- Always add the -E flag to the CPP, regardless of the user options
  let cppProgram = String -> Program -> Program
addFlagIfNew String
"-E" Program
cpp2
  return Cpp{cppProgram}