summaryrefslogtreecommitdiff
path: root/compiler/main
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/main')
-rw-r--r--compiler/main/DriverPipeline.hs64
-rw-r--r--compiler/main/DynFlags.hs7
-rw-r--r--compiler/main/SysTools.lhs111
3 files changed, 83 insertions, 99 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index fbc41ca70c..7df823c27d 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -370,7 +370,7 @@ linkingNeeded dflags linkables pkg_deps = do
Left _ -> return True
Right t -> do
-- first check object files and extra_ld_inputs
- let extra_ld_inputs = ldInputs dflags
+ let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
let (errs,extra_times) = splitEithers e_extra_times
let obj_times = map linkableTime linkables ++ extra_times
@@ -820,9 +820,7 @@ runPhase (RealPhase (Unlit sf)) input_fn dflags
= do
output_fn <- phaseOutputFilename (Cpp sf)
- let unlit_flags = getOpts dflags opt_L
- flags = map SysTools.Option unlit_flags ++
- [ -- The -h option passes the file name for unlit to
+ let flags = [ -- The -h option passes the file name for unlit to
-- put in a #line directive
SysTools.Option "-h"
, SysTools.Option $ escape $ normalise input_fn
@@ -869,7 +867,7 @@ runPhase (RealPhase (Cpp sf)) input_fn dflags0
return (RealPhase (HsPp sf), input_fn)
else do
output_fn <- phaseOutputFilename (HsPp sf)
- liftIO $ doCpp dflags1 True{-raw-} False{-no CC opts-}
+ liftIO $ doCpp dflags1 True{-raw-}
input_fn output_fn
-- re-read the pragmas now that we've preprocessed the file
-- See #2464,#3457
@@ -895,7 +893,6 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags
-- to the next phase of the pipeline.
return (RealPhase (Hsc sf), input_fn)
else do
- let hspp_opts = getOpts dflags opt_F
PipeEnv{src_basename, src_suffix} <- getPipeEnv
let orig_fn = src_basename <.> src_suffix
output_fn <- phaseOutputFilename (Hsc sf)
@@ -903,8 +900,7 @@ runPhase (RealPhase (HsPp sf)) input_fn dflags
( [ SysTools.Option orig_fn
, SysTools.Option input_fn
, SysTools.FileOption "" output_fn
- ] ++
- map SysTools.Option hspp_opts
+ ]
)
-- re-read pragmas now that we've parsed the file (see #3674)
@@ -1053,7 +1049,7 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do
runPhase (RealPhase CmmCpp) input_fn dflags
= do
output_fn <- phaseOutputFilename Cmm
- liftIO $ doCpp dflags False{-not raw-} True{-include CC opts-}
+ liftIO $ doCpp dflags False{-not raw-}
input_fn output_fn
return (RealPhase Cmm, output_fn)
@@ -1081,7 +1077,6 @@ runPhase (RealPhase cc_phase) input_fn dflags
| any (cc_phase `eqPhase`) [Cc, Ccpp, HCc, Cobjc, Cobjcpp]
= do
let platform = targetPlatform dflags
- cc_opts = getOpts dflags opt_c
hcc = cc_phase `eqPhase` HCc
let cmdline_include_paths = includePaths dflags
@@ -1195,7 +1190,6 @@ runPhase (RealPhase cc_phase) input_fn dflags
++ [ "-S", cc_opt ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ framework_paths
- ++ cc_opts
++ split_opt
++ include_paths
++ pkg_extra_cc_opts
@@ -1254,8 +1248,7 @@ runPhase (RealPhase As) input_fn dflags
| otherwise = return SysTools.runAs
as_prog <- whichAsProg
- let as_opts = getOpts dflags opt_a
- cmdline_include_paths = includePaths dflags
+ let cmdline_include_paths = includePaths dflags
next_phase <- maybeMergeStub
output_fn <- phaseOutputFilename next_phase
@@ -1266,8 +1259,7 @@ runPhase (RealPhase As) input_fn dflags
let runAssembler inputFilename outputFilename
= liftIO $ as_prog dflags
- (map SysTools.Option as_opts
- ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
+ ([ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
-- We only support SparcV9 and better because V8 lacks an atomic CAS
-- instruction so we have to make sure that the assembler accepts the
@@ -1313,8 +1305,6 @@ runPhase (RealPhase SplitAs) _input_fn dflags
liftIO $ mapM_ removeFile $
map (split_odir </>) $ filter (osuf `isSuffixOf`) fs
- let as_opts = getOpts dflags opt_a
-
let (split_s_prefix, n) = case splitInfo dflags of
Nothing -> panic "No split info"
Just x -> x
@@ -1326,8 +1316,7 @@ runPhase (RealPhase SplitAs) _input_fn dflags
takeFileName base_o ++ "__" ++ show n <.> osuf
let assemble_file n
- = SysTools.runAs dflags
- (map SysTools.Option as_opts ++
+ = SysTools.runAs dflags (
-- We only support SparcV9 and better because V8 lacks an atomic CAS
-- instruction so we have to make sure that the assembler accepts the
@@ -1383,13 +1372,12 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
= do
ver <- liftIO $ readIORef (llvmVersion dflags)
- let lo_opts = getOpts dflags opt_lo
- opt_lvl = max 0 (min 2 $ optLevel dflags)
+ let opt_lvl = max 0 (min 2 $ optLevel dflags)
-- don't specify anything if user has specified commands. We do this
-- for opt but not llc since opt is very specifically for optimisation
-- passes only, so if the user is passing us extra options we assume
-- they know what they are doing and don't get in the way.
- optFlag = if null lo_opts
+ optFlag = if null (getOpts dflags opt_lo)
then [SysTools.Option (llvmOpts !! opt_lvl)]
else []
tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
@@ -1404,8 +1392,7 @@ runPhase (RealPhase LlvmOpt) input_fn dflags
SysTools.Option "-o",
SysTools.FileOption "" output_fn]
++ optFlag
- ++ [SysTools.Option tbaa]
- ++ map SysTools.Option lo_opts)
+ ++ [SysTools.Option tbaa])
return (RealPhase LlvmLlc, output_fn)
where
@@ -1420,8 +1407,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
= do
ver <- liftIO $ readIORef (llvmVersion dflags)
- let lc_opts = getOpts dflags opt_lc
- opt_lvl = max 0 (min 2 $ optLevel dflags)
+ let opt_lvl = max 0 (min 2 $ optLevel dflags)
-- iOS requires external references to be loaded indirectly from the
-- DATA segment or dyld traps at runtime writing into TEXT: see #7722
rmodel | platformOS (targetPlatform dflags) == OSiOS = "dynamic-no-pic"
@@ -1445,7 +1431,6 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
SysTools.Option $ "-relocation-model=" ++ rmodel,
SysTools.FileOption "" input_fn,
SysTools.Option "-o", SysTools.FileOption "" output_fn]
- ++ map SysTools.Option lc_opts
++ [SysTools.Option tbaa]
++ map SysTools.Option fpOpts
++ map SysTools.Option abiOpts
@@ -1598,7 +1583,6 @@ mkExtraObj dflags extn xs
FileOption "" cFile,
Option "-o",
FileOption "" oFile]
- ++ map SysTools.Option (getOpts dflags opt_c) -- see #5528
++ map (FileOption "-I") (includeDirs rtsDetails))
return oFile
@@ -1685,7 +1669,7 @@ getLinkInfo dflags dep_packages = do
rtsOpts dflags,
rtsOptsEnabled dflags,
gopt Opt_NoHsMain dflags,
- extra_ld_inputs,
+ map showOpt extra_ld_inputs,
getOpts dflags opt_l)
--
return (show link_info)
@@ -1857,9 +1841,6 @@ linkBinary dflags o_files dep_packages = do
-- probably _stub.o files
let extra_ld_inputs = ldInputs dflags
- -- opts from -optl-<blah> (including -l<blah> options)
- let extra_ld_opts = getOpts dflags opt_l
-
-- Here are some libs that need to be linked at the *end* of
-- the command line, because they contain symbols that are referred to
-- by the RTS. We can't therefore use the ordinary way opts for these.
@@ -1923,10 +1904,10 @@ linkBinary dflags o_files dep_packages = do
else [])
++ o_files
+ ++ lib_path_opts)
++ extra_ld_inputs
- ++ lib_path_opts
- ++ extra_ld_opts
- ++ rc_objs
+ ++ map SysTools.Option (
+ rc_objs
++ framework_path_opts
++ framework_opts
++ pkg_lib_path_opts
@@ -1997,12 +1978,10 @@ maybeCreateManifest dflags exe_filename
-- show is a bit hackish above, but we need to escape the
-- backslashes in the path.
- let wr_opts = getOpts dflags opt_windres
runWindres dflags $ map SysTools.Option $
["--input="++rc_filename,
"--output="++rc_obj_filename,
"--output-format=coff"]
- ++ wr_opts
-- no FileOptions here: windres doesn't like seeing
-- backslashes, apparently
@@ -2025,9 +2004,9 @@ linkDynLibCheck dflags o_files dep_packages
-- -----------------------------------------------------------------------------
-- Running CPP
-doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
-doCpp dflags raw include_cc_opts input_fn output_fn = do
- let hscpp_opts = getOpts dflags opt_P ++ picPOpts dflags
+doCpp :: DynFlags -> Bool -> FilePath -> FilePath -> IO ()
+doCpp dflags raw input_fn output_fn = do
+ let hscpp_opts = picPOpts dflags
let cmdline_include_paths = includePaths dflags
pkg_include_dirs <- getPackageIncludePath dflags []
@@ -2036,10 +2015,6 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
let verbFlags = getVerbFlags dflags
- let cc_opts
- | include_cc_opts = getOpts dflags opt_c
- | otherwise = []
-
let cpp_prog args | raw = SysTools.runCpp dflags args
| otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
@@ -2066,7 +2041,6 @@ doCpp dflags raw include_cc_opts input_fn output_fn = do
++ map SysTools.Option target_defs
++ map SysTools.Option backend_defs
++ map SysTools.Option hscpp_opts
- ++ map SysTools.Option cc_opts
++ map SysTools.Option sse_defs
++ [ SysTools.Option "-x"
, SysTools.Option "c"
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 946f00bba4..f20609527f 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -631,7 +631,7 @@ data DynFlags = DynFlags {
-- Set by @-ddump-file-prefix@
dumpPrefixForce :: Maybe FilePath,
- ldInputs :: [String],
+ ldInputs :: [Option],
includePaths :: [String],
libraryPaths :: [String],
@@ -2059,7 +2059,7 @@ dynamic_flags = [
------- Libraries ---------------------------------------------------
, Flag "L" (Prefix addLibraryPath)
- , Flag "l" (hasArg (addOptl . ("-l" ++)))
+ , Flag "l" (hasArg (addLdInputs . Option . ("-l" ++)))
------- Frameworks --------------------------------------------------
-- -framework-path should really be -F ...
@@ -3206,6 +3206,9 @@ setMainIs arg
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
+addLdInputs :: Option -> DynFlags -> DynFlags
+addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]}
+
-----------------------------------------------------------------------------
-- Paths & Libraries
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 3df1a9cd87..5926114984 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -371,30 +371,35 @@ findTopDir Nothing
\begin{code}
runUnlit :: DynFlags -> [Option] -> IO ()
runUnlit dflags args = do
- let p = pgm_L dflags
- runSomething dflags "Literate pre-processor" p args
+ let prog = pgm_L dflags
+ opts = getOpts dflags opt_L
+ runSomething dflags "Literate pre-processor" prog
+ (map Option opts ++ args)
runCpp :: DynFlags -> [Option] -> IO ()
runCpp dflags args = do
let (p,args0) = pgm_P dflags
- args1 = args0 ++ args
+ args1 = map Option (getOpts dflags opt_P)
args2 = if gopt Opt_WarnIsError dflags
- then Option "-Werror" : args1
- else args1
+ then [Option "-Werror"]
+ else []
mb_env <- getGccEnv args2
- runSomethingFiltered dflags id "C pre-processor" p args2 mb_env
+ runSomethingFiltered dflags id "C pre-processor" p
+ (args0 ++ args1 ++ args2 ++ args) mb_env
runPp :: DynFlags -> [Option] -> IO ()
runPp dflags args = do
- let p = pgm_F dflags
- runSomething dflags "Haskell pre-processor" p args
+ let prog = pgm_F dflags
+ opts = map Option (getOpts dflags opt_F)
+ runSomething dflags "Haskell pre-processor" prog (opts ++ args)
runCc :: DynFlags -> [Option] -> IO ()
runCc dflags args = do
let (p,args0) = pgm_c dflags
- args1 = args0 ++ args
- mb_env <- getGccEnv args1
- runSomethingFiltered dflags cc_filter "C Compiler" p args1 mb_env
+ args1 = map Option (getOpts dflags opt_c)
+ args2 = args0 ++ args1 ++ args
+ mb_env <- getGccEnv args2
+ runSomethingFiltered dflags cc_filter "C Compiler" p args2 mb_env
where
-- discard some harmless warnings from gcc that we can't turn off
cc_filter = unlines . doFilter . lines
@@ -452,9 +457,10 @@ xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
askCc :: DynFlags -> [Option] -> IO String
askCc dflags args = do
let (p,args0) = pgm_c dflags
- args1 = args0 ++ args
- mb_env <- getGccEnv args1
- runSomethingWith dflags "gcc" p args1 $ \real_args ->
+ args1 = map Option (getOpts dflags opt_c)
+ args2 = args0 ++ args1 ++ args
+ mb_env <- getGccEnv args2
+ runSomethingWith dflags "gcc" p args2 $ \real_args ->
readCreateProcess (proc p real_args){ env = mb_env }
-- Version of System.Process.readProcessWithExitCode that takes an environment
@@ -507,21 +513,24 @@ runSplit dflags args = do
runAs :: DynFlags -> [Option] -> IO ()
runAs dflags args = do
let (p,args0) = pgm_a dflags
- args1 = args0 ++ args
- mb_env <- getGccEnv args1
- runSomethingFiltered dflags id "Assembler" p args1 mb_env
+ args1 = map Option (getOpts dflags opt_a)
+ args2 = args0 ++ args1 ++ args
+ mb_env <- getGccEnv args2
+ runSomethingFiltered dflags id "Assembler" p args2 mb_env
-- | Run the LLVM Optimiser
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt dflags args = do
let (p,args0) = pgm_lo dflags
- runSomething dflags "LLVM Optimiser" p (args0++args)
+ args1 = map Option (getOpts dflags opt_lo)
+ runSomething dflags "LLVM Optimiser" p (args0 ++ args1 ++ args)
-- | Run the LLVM Compiler
runLlvmLlc :: DynFlags -> [Option] -> IO ()
runLlvmLlc dflags args = do
let (p,args0) = pgm_lc dflags
- runSomething dflags "LLVM Compiler" p (args0++args)
+ args1 = map Option (getOpts dflags opt_lc)
+ runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
-- | Run the clang compiler (used as an assembler for the LLVM
-- backend on OS X as LLVM doesn't support the OS X system
@@ -533,10 +542,11 @@ runClang dflags args = do
-- be careful what options we call clang with
-- see #5903 and #7617 for bugs caused by this.
(_,args0) = pgm_a dflags
- args1 = args0 ++ args
- mb_env <- getGccEnv args1
+ args1 = map Option (getOpts dflags opt_a)
+ args2 = args0 ++ args1 ++ args
+ mb_env <- getGccEnv args2
Exception.catch (do
- runSomethingFiltered dflags id "Clang (Assembler)" clang args1 mb_env
+ runSomethingFiltered dflags id "Clang (Assembler)" clang args2 mb_env
)
(\(err :: SomeException) -> do
errorMsg dflags $
@@ -591,9 +601,10 @@ figureLlvmVersion dflags = do
runLink :: DynFlags -> [Option] -> IO ()
runLink dflags args = do
let (p,args0) = pgm_l dflags
- args1 = args0 ++ args
- mb_env <- getGccEnv args1
- runSomethingFiltered dflags id "Linker" p args1 mb_env
+ args1 = map Option (getOpts dflags opt_l)
+ args2 = args0 ++ args1 ++ args
+ mb_env <- getGccEnv args2
+ runSomethingFiltered dflags id "Linker" p args2 mb_env
runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL dflags args = do
@@ -606,6 +617,7 @@ runWindres :: DynFlags -> [Option] -> IO ()
runWindres dflags args = do
let (gcc, gcc_args) = pgm_c dflags
windres = pgm_windres dflags
+ opts = map Option (getOpts dflags opt_windres)
quote x = "\"" ++ x ++ "\""
args' = -- If windres.exe and gcc.exe are in a directory containing
-- spaces then windres fails to run gcc. We therefore need
@@ -613,6 +625,7 @@ runWindres dflags args = do
Option ("--preprocessor=" ++
unwords (map quote (gcc :
map showOpt gcc_args ++
+ map showOpt opts ++
["-E", "-xc", "-DRC_INVOKED"])))
-- ...but if we do that then if windres calls popen then
-- it can't understand the quoting, so we have to use
@@ -1101,8 +1114,6 @@ linkDynLib dflags0 o_files dep_packages
-- probably _stub.o files
let extra_ld_inputs = ldInputs dflags
- let extra_ld_opts = getOpts dflags opt_l
-
case os of
OSMinGW32 -> do
-------------------------------------------------------------
@@ -1122,15 +1133,14 @@ linkDynLib dflags0 o_files dep_packages
| gopt Opt_SharedImplib dflags
]
++ map (FileOption "") o_files
- ++ map Option (
-- Permit the linker to auto link _symbol to _imp_symbol
-- This lets us link against DLLs without needing an "import library"
- ["-Wl,--enable-auto-import"]
+ ++ [Option "-Wl,--enable-auto-import"]
++ extra_ld_inputs
- ++ lib_path_opts
- ++ extra_ld_opts
+ ++ map Option (
+ lib_path_opts
++ pkg_lib_path_opts
++ pkg_link_opts
))
@@ -1181,19 +1191,19 @@ linkDynLib dflags0 o_files dep_packages
, Option "-o"
, FileOption "" output_fn
]
- ++ map Option (
- o_files
- ++ [ "-undefined", "dynamic_lookup", "-single_module" ]
+ ++ map Option o_files
+ ++ [ Option "-undefined",
+ Option "dynamic_lookup",
+ Option "-single_module" ]
++ (if platformArch platform == ArchX86_64
then [ ]
- else [ "-Wl,-read_only_relocs,suppress" ])
- ++ [ "-install_name", instName ]
+ else [ Option "-Wl,-read_only_relocs,suppress" ])
+ ++ [ Option "-install_name", Option instName ]
+ ++ map Option lib_path_opts
++ extra_ld_inputs
- ++ lib_path_opts
- ++ extra_ld_opts
- ++ pkg_lib_path_opts
- ++ pkg_link_opts
- ))
+ ++ map Option pkg_lib_path_opts
+ ++ map Option pkg_link_opts
+ )
_ -> do
-------------------------------------------------------------------
-- Making a DSO
@@ -1214,18 +1224,15 @@ linkDynLib dflags0 o_files dep_packages
++ [ Option "-o"
, FileOption "" output_fn
]
- ++ map Option (
- o_files
- ++ [ "-shared" ]
- ++ bsymbolicFlag
+ ++ map Option o_files
+ ++ [ Option "-shared" ]
+ ++ map Option bsymbolicFlag
-- Set the library soname. We use -h rather than -soname as
-- Solaris 10 doesn't support the latter:
- ++ [ "-Wl,-h," ++ takeFileName output_fn ]
+ ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
+ ++ map Option lib_path_opts
++ extra_ld_inputs
- ++ lib_path_opts
- ++ extra_ld_opts
- ++ pkg_lib_path_opts
- ++ pkg_link_opts
- ))
-
+ ++ map Option pkg_lib_path_opts
+ ++ map Option pkg_link_opts
+ )
\end{code}