diff options
Diffstat (limited to 'compiler/main')
-rw-r--r-- | compiler/main/DriverPipeline.hs | 64 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 7 | ||||
-rw-r--r-- | compiler/main/SysTools.lhs | 111 |
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} |