summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/DriverPhases.hs1
-rw-r--r--compiler/main/DriverPipeline.hs15
-rw-r--r--compiler/main/DynFlags.hs11
-rw-r--r--compiler/main/HscTypes.hs14
-rw-r--r--compiler/main/SysTools.hs1
-rw-r--r--compiler/main/SysTools/ExtraObj.hs2
-rw-r--r--compiler/main/SysTools/Tasks.hs25
7 files changed, 49 insertions, 20 deletions
diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs
index 12e12ca321..d4392c4c37 100644
--- a/compiler/main/DriverPhases.hs
+++ b/compiler/main/DriverPhases.hs
@@ -369,4 +369,3 @@ isHaskellSigFilename f = isHaskellSigSuffix (drop 1 $ takeExtension f)
isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool
isObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)
isDynLibFilename platform f = isDynLibSuffix platform (drop 1 $ takeExtension f)
-
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 458a118912..83e6bfde59 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1218,17 +1218,8 @@ runPhase (RealPhase cc_phase) input_fn dflags
ghcVersionH <- liftIO $ getGhcVersionPathName dflags
- let gcc_lang_opt | cc_phase `eqPhase` Ccxx = "c++"
- | cc_phase `eqPhase` Cobjc = "objective-c"
- | cc_phase `eqPhase` Cobjcxx = "objective-c++"
- | otherwise = "c"
- liftIO $ SysTools.runCc dflags (
- -- force the C compiler to interpret this file as C when
- -- compiling .hc files, by adding the -x c option.
- -- Also useful for plain .c files, just in case GHC saw a
- -- -x c option.
- [ SysTools.Option "-x", SysTools.Option gcc_lang_opt
- , SysTools.FileOption "" input_fn
+ liftIO $ SysTools.runCc (phaseForeignLanguage cc_phase) dflags (
+ [ SysTools.FileOption "" input_fn
, SysTools.Option "-o"
, SysTools.FileOption "" output_fn
]
@@ -1917,7 +1908,7 @@ doCpp dflags raw input_fn output_fn = do
let verbFlags = getVerbFlags dflags
let cpp_prog args | raw = SysTools.runCpp dflags args
- | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
+ | otherwise = SysTools.runCc Nothing dflags (SysTools.Option "-E" : args)
let target_defs =
[ "-D" ++ HOST_OS ++ "_BUILD_OS",
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0783189aaf..66a5335db6 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -92,7 +92,8 @@ module DynFlags (
extraGccViaCFlags, systemPackageConfig,
pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T,
pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc,
- pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i,
+ pgm_lcc, pgm_i,
+ opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_i,
opt_P_signature,
opt_windres, opt_lo, opt_lc, opt_lcc,
@@ -1340,6 +1341,7 @@ data Settings = Settings {
-- See Note [Repeated -optP hashing]
sOpt_F :: [String],
sOpt_c :: [String],
+ sOpt_cxx :: [String],
sOpt_a :: [String],
sOpt_l :: [String],
sOpt_windres :: [String],
@@ -1423,6 +1425,8 @@ opt_F dflags = sOpt_F (settings dflags)
opt_c :: DynFlags -> [String]
opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
++ sOpt_c (settings dflags)
+opt_cxx :: DynFlags -> [String]
+opt_cxx dflags = sOpt_cxx (settings dflags)
opt_a :: DynFlags -> [String]
opt_a dflags = sOpt_a (settings dflags)
opt_l :: DynFlags -> [String]
@@ -2520,7 +2524,7 @@ setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,
setDynObjectSuf, setDynHiSuf,
setDylibInstallName,
setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,
- setPgmP, addOptl, addOptc, addOptP,
+ setPgmP, addOptl, addOptc, addOptcxx, addOptP,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
@@ -2636,6 +2640,7 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
+addOptcxx f = alterSettings (\s -> s { sOpt_cxx = f : sOpt_cxx s})
addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s
, sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s)
})
@@ -3038,6 +3043,8 @@ dynamic_flags_deps = [
(hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
, make_ord_flag defFlag "optc"
(hasArg addOptc)
+ , make_ord_flag defFlag "optcxx"
+ (hasArg addOptcxx)
, make_ord_flag defFlag "opta"
(hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, make_ord_flag defFlag "optl"
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 6772668420..f4306f3d16 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -30,6 +30,7 @@ module HscTypes (
ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),
ForeignSrcLang(..),
+ phaseForeignLanguage,
ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
msHsFilePath, msHiFilePath, msObjFilePath,
@@ -182,6 +183,7 @@ import CmdLineParser
import DynFlags
import DriverPhases ( Phase, HscSource(..), hscSourceString
, isHsBootOrSig, isHsigFile )
+import qualified DriverPhases as Phase
import BasicTypes
import IfaceSyn
import Maybes
@@ -3136,3 +3138,15 @@ Also see Note [Typechecking Complete Matches] in TcBinds for a more detailed
explanation for how GHC ensures that all the conlikes in a COMPLETE set are
consistent.
-}
+
+-- | Foreign language of the phase if the phase deals with a foreign code
+phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang
+phaseForeignLanguage phase = case phase of
+ Phase.Cc -> Just LangC
+ Phase.Ccxx -> Just LangCxx
+ Phase.Cobjc -> Just LangObjc
+ Phase.Cobjcxx -> Just LangObjcxx
+ Phase.HCc -> Just LangC
+ Phase.As _ -> Just LangAsm
+ Phase.MergeForeign -> Just RawObject
+ _ -> Nothing
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index fddc4ac30f..ca30e4aae3 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -301,6 +301,7 @@ initSysTools top_dir
sOpt_P_fingerprint = fingerprint0,
sOpt_F = [],
sOpt_c = [],
+ sOpt_cxx = [],
sOpt_a = [],
sOpt_l = [],
sOpt_windres = [],
diff --git a/compiler/main/SysTools/ExtraObj.hs b/compiler/main/SysTools/ExtraObj.hs
index 774884a0d7..149d3a678a 100644
--- a/compiler/main/SysTools/ExtraObj.hs
+++ b/compiler/main/SysTools/ExtraObj.hs
@@ -40,7 +40,7 @@ mkExtraObj dflags extn xs
oFile <- newTempName dflags TFL_GhcSession "o"
writeFile cFile xs
ccInfo <- liftIO $ getCompilerInfo dflags
- runCc dflags
+ runCc Nothing dflags
([Option "-c",
FileOption "" cFile,
Option "-o",
diff --git a/compiler/main/SysTools/Tasks.hs b/compiler/main/SysTools/Tasks.hs
index 9e3df26877..a3d312e30e 100644
--- a/compiler/main/SysTools/Tasks.hs
+++ b/compiler/main/SysTools/Tasks.hs
@@ -10,6 +10,7 @@ module SysTools.Tasks where
import Exception
import ErrUtils
+import HscTypes
import DynFlags
import Outputable
import Platform
@@ -58,11 +59,12 @@ runPp dflags args = do
opts = map Option (getOpts dflags opt_F)
runSomething dflags "Haskell pre-processor" prog (args ++ opts)
-runCc :: DynFlags -> [Option] -> IO ()
-runCc dflags args = do
+-- | Run compiler of C-like languages and raw objects (such as gcc or clang).
+runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
+runCc mLanguage dflags args = do
let (p,args0) = pgm_c dflags
- args1 = map Option (getOpts dflags opt_c)
- args2 = args0 ++ args ++ args1
+ args1 = map Option userOpts
+ args2 = args0 ++ languageOptions ++ args ++ args1
-- We take care to pass -optc flags in args1 last to ensure that the
-- user can override flags passed by GHC. See #14452.
mb_env <- getGccEnv args2
@@ -118,6 +120,21 @@ runCc dflags args = do
| "warning: call-clobbered register used" `isContainedIn` w = False
| otherwise = True
+ -- force the C compiler to interpret this file as C when
+ -- compiling .hc files, by adding the -x c option.
+ -- Also useful for plain .c files, just in case GHC saw a
+ -- -x c option.
+ (languageOptions, userOpts) = case mLanguage of
+ Nothing -> ([], userOpts_c)
+ Just language -> ([Option "-x", Option languageName], opts) where
+ (languageName, opts) = case language of
+ LangCxx -> ("c++", userOpts_cxx)
+ LangObjc -> ("objective-c", userOpts_c)
+ LangObjcxx -> ("objective-c++", userOpts_cxx)
+ _ -> ("c", userOpts_c)
+ userOpts_c = getOpts dflags opt_c
+ userOpts_cxx = getOpts dflags opt_cxx
+
isContainedIn :: String -> String -> Bool
xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
View Lorry Controller Status