Prefer #if defined to #ifdef
[ghc.git] / compiler / main / SysTools.hs
1 {-
2 -----------------------------------------------------------------------------
3 --
4 -- (c) The University of Glasgow 2001-2003
5 --
6 -- Access to system tools: gcc, cp, rm etc
7 --
8 -----------------------------------------------------------------------------
9 -}
10
11 {-# LANGUAGE CPP, ScopedTypeVariables #-}
12
13 module SysTools (
14 -- Initialisation
15 initSysTools,
16
17 -- Interface to system tools
18 runUnlit, runCpp, runCc, -- [Option] -> IO ()
19 runPp, -- [Option] -> IO ()
20 runSplit, -- [Option] -> IO ()
21 runAs, runLink, runLibtool, -- [Option] -> IO ()
22 runMkDLL,
23 runWindres,
24 runLlvmOpt,
25 runLlvmLlc,
26 runClang,
27 figureLlvmVersion,
28
29 getLinkerInfo,
30 getCompilerInfo,
31
32 linkDynLib,
33
34 askLd,
35
36 touch, -- String -> String -> IO ()
37 copy,
38 copyWithHeader,
39
40 -- Temporary-file management
41 setTmpDir,
42 newTempName, newTempLibName,
43 cleanTempDirs, cleanTempFiles, cleanTempFilesExcept,
44 addFilesToClean,
45
46 Option(..),
47
48 -- frameworks
49 getPkgFrameworkOpts,
50 getFrameworkOpts
51
52
53 ) where
54
55 #include "HsVersions.h"
56
57 import DriverPhases
58 import Module
59 import Packages
60 import Config
61 import Outputable
62 import ErrUtils
63 import Panic
64 import Platform
65 import Util
66 import DynFlags
67 import Exception
68
69 import LlvmCodeGen.Base (llvmVersionStr, supportedLlvmVersion)
70
71 import Data.IORef
72 import Control.Monad
73 import System.Exit
74 import System.Environment
75 import System.FilePath
76 import System.IO
77 import System.IO.Error as IO
78 import System.Directory
79 import Data.Char
80 import Data.List
81 import qualified Data.Map as Map
82 import qualified Data.Set as Set
83
84 #if !defined(mingw32_HOST_OS)
85 import qualified System.Posix.Internals
86 #else /* Must be Win32 */
87 import Foreign
88 import Foreign.C.String
89 #if MIN_VERSION_Win32(2,5,0)
90 import qualified System.Win32.Types as Win32
91 #else
92 import qualified System.Win32.Info as Win32
93 #endif
94 import System.Win32.Types (DWORD, LPTSTR, HANDLE)
95 import System.Win32.Types (failIfNull, failIf, iNVALID_HANDLE_VALUE)
96 import System.Win32.File (createFile,closeHandle, gENERIC_READ, fILE_SHARE_READ, oPEN_EXISTING, fILE_ATTRIBUTE_NORMAL, fILE_FLAG_BACKUP_SEMANTICS )
97 import System.Win32.DLL (loadLibrary, getProcAddress)
98 #endif
99
100 import System.Process
101 import Control.Concurrent
102 import FastString
103 import SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
104
105 #if defined(mingw32_HOST_OS)
106 # if defined(i386_HOST_ARCH)
107 # define WINDOWS_CCONV stdcall
108 # elif defined(x86_64_HOST_ARCH)
109 # define WINDOWS_CCONV ccall
110 # else
111 # error Unknown mingw32 arch
112 # endif
113 #endif
114
115 {-
116 How GHC finds its files
117 ~~~~~~~~~~~~~~~~~~~~~~~
118
119 [Note topdir]
120
121 GHC needs various support files (library packages, RTS etc), plus
122 various auxiliary programs (cp, gcc, etc). It starts by finding topdir,
123 the root of GHC's support files
124
125 On Unix:
126 - ghc always has a shell wrapper that passes a -B<dir> option
127
128 On Windows:
129 - ghc never has a shell wrapper.
130 - we can find the location of the ghc binary, which is
131 $topdir/<foo>/<something>.exe
132 where <something> may be "ghc", "ghc-stage2", or similar
133 - we strip off the "<foo>/<something>.exe" to leave $topdir.
134
135 from topdir we can find package.conf, ghc-asm, etc.
136
137
138 SysTools.initSysProgs figures out exactly where all the auxiliary programs
139 are, and initialises mutable variables to make it easy to call them.
140 To to this, it makes use of definitions in Config.hs, which is a Haskell
141 file containing variables whose value is figured out by the build system.
142
143 Config.hs contains two sorts of things
144
145 cGCC, The *names* of the programs
146 cCPP e.g. cGCC = gcc
147 cUNLIT cCPP = gcc -E
148 etc They do *not* include paths
149
150
151 cUNLIT_DIR The *path* to the directory containing unlit, split etc
152 cSPLIT_DIR *relative* to the root of the build tree,
153 for use when running *in-place* in a build tree (only)
154
155
156
157 ---------------------------------------------
158 NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
159
160 Another hair-brained scheme for simplifying the current tool location
161 nightmare in GHC: Simon originally suggested using another
162 configuration file along the lines of GCC's specs file - which is fine
163 except that it means adding code to read yet another configuration
164 file. What I didn't notice is that the current package.conf is
165 general enough to do this:
166
167 Package
168 {name = "tools", import_dirs = [], source_dirs = [],
169 library_dirs = [], hs_libraries = [], extra_libraries = [],
170 include_dirs = [], c_includes = [], package_deps = [],
171 extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
172 extra_cc_opts = [], extra_ld_opts = []}
173
174 Which would have the advantage that we get to collect together in one
175 place the path-specific package stuff with the path-specific tool
176 stuff.
177 End of NOTES
178 ---------------------------------------------
179
180 ************************************************************************
181 * *
182 \subsection{Initialisation}
183 * *
184 ************************************************************************
185 -}
186
187 initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix)
188 -> IO Settings -- Set all the mutable variables above, holding
189 -- (a) the system programs
190 -- (b) the package-config file
191 -- (c) the GHC usage message
192 initSysTools mbMinusB
193 = do top_dir <- findTopDir mbMinusB
194 -- see [Note topdir]
195 -- NB: top_dir is assumed to be in standard Unix
196 -- format, '/' separated
197
198 let settingsFile = top_dir </> "settings"
199 platformConstantsFile = top_dir </> "platformConstants"
200 installed :: FilePath -> FilePath
201 installed file = top_dir </> file
202 libexec :: FilePath -> FilePath
203 libexec file = top_dir </> "bin" </> file
204
205 settingsStr <- readFile settingsFile
206 platformConstantsStr <- readFile platformConstantsFile
207 mySettings <- case maybeReadFuzzy settingsStr of
208 Just s ->
209 return s
210 Nothing ->
211 pgmError ("Can't parse " ++ show settingsFile)
212 platformConstants <- case maybeReadFuzzy platformConstantsStr of
213 Just s ->
214 return s
215 Nothing ->
216 pgmError ("Can't parse " ++
217 show platformConstantsFile)
218 let getSetting key = case lookup key mySettings of
219 Just xs ->
220 return $ case stripPrefix "$topdir" xs of
221 Just [] ->
222 top_dir
223 Just xs'@(c:_)
224 | isPathSeparator c ->
225 top_dir ++ xs'
226 _ ->
227 xs
228 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
229 getBooleanSetting key = case lookup key mySettings of
230 Just "YES" -> return True
231 Just "NO" -> return False
232 Just xs -> pgmError ("Bad value for " ++ show key ++ ": " ++ show xs)
233 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
234 readSetting key = case lookup key mySettings of
235 Just xs ->
236 case maybeRead xs of
237 Just v -> return v
238 Nothing -> pgmError ("Failed to read " ++ show key ++ " value " ++ show xs)
239 Nothing -> pgmError ("No entry for " ++ show key ++ " in " ++ show settingsFile)
240 crossCompiling <- getBooleanSetting "cross compiling"
241 targetArch <- readSetting "target arch"
242 targetOS <- readSetting "target os"
243 targetWordSize <- readSetting "target word size"
244 targetUnregisterised <- getBooleanSetting "Unregisterised"
245 targetHasGnuNonexecStack <- readSetting "target has GNU nonexec stack"
246 targetHasIdentDirective <- readSetting "target has .ident directive"
247 targetHasSubsectionsViaSymbols <- readSetting "target has subsections via symbols"
248 myExtraGccViaCFlags <- getSetting "GCC extra via C opts"
249 -- On Windows, mingw is distributed with GHC,
250 -- so we look in TopDir/../mingw/bin
251 -- It would perhaps be nice to be able to override this
252 -- with the settings file, but it would be a little fiddly
253 -- to make that possible, so for now you can't.
254 gcc_prog <- getSetting "C compiler command"
255 gcc_args_str <- getSetting "C compiler flags"
256 gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie"
257 cpp_prog <- getSetting "Haskell CPP command"
258 cpp_args_str <- getSetting "Haskell CPP flags"
259 let unreg_gcc_args = if targetUnregisterised
260 then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
261 else []
262 -- TABLES_NEXT_TO_CODE affects the info table layout.
263 tntc_gcc_args
264 | mkTablesNextToCode targetUnregisterised
265 = ["-DTABLES_NEXT_TO_CODE"]
266 | otherwise = []
267 cpp_args= map Option (words cpp_args_str)
268 gcc_args = map Option (words gcc_args_str
269 ++ unreg_gcc_args
270 ++ tntc_gcc_args)
271 ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind"
272 ldSupportsBuildId <- getBooleanSetting "ld supports build-id"
273 ldSupportsFilelist <- getBooleanSetting "ld supports filelist"
274 ldIsGnuLd <- getBooleanSetting "ld is GNU ld"
275 perl_path <- getSetting "perl command"
276
277 let pkgconfig_path = installed "package.conf.d"
278 ghc_usage_msg_path = installed "ghc-usage.txt"
279 ghci_usage_msg_path = installed "ghci-usage.txt"
280
281 -- For all systems, unlit, split, mangle are GHC utilities
282 -- architecture-specific stuff is done when building Config.hs
283 unlit_path = libexec cGHC_UNLIT_PGM
284
285 -- split is a Perl script
286 split_script = libexec cGHC_SPLIT_PGM
287
288 windres_path <- getSetting "windres command"
289 libtool_path <- getSetting "libtool command"
290
291 tmpdir <- getTemporaryDirectory
292
293 touch_path <- getSetting "touch command"
294
295 let -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
296 -- a call to Perl to get the invocation of split.
297 -- On Unix, scripts are invoked using the '#!' method. Binary
298 -- installations of GHC on Unix place the correct line on the
299 -- front of the script at installation time, so we don't want
300 -- to wire-in our knowledge of $(PERL) on the host system here.
301 (split_prog, split_args)
302 | isWindowsHost = (perl_path, [Option split_script])
303 | otherwise = (split_script, [])
304 mkdll_prog <- getSetting "dllwrap command"
305 let mkdll_args = []
306
307 -- cpp is derived from gcc on all platforms
308 -- HACK, see setPgmP below. We keep 'words' here to remember to fix
309 -- Config.hs one day.
310
311
312 -- Other things being equal, as and ld are simply gcc
313 gcc_link_args_str <- getSetting "C compiler link flags"
314 let as_prog = gcc_prog
315 as_args = gcc_args
316 ld_prog = gcc_prog
317 ld_args = gcc_args ++ map Option (words gcc_link_args_str)
318
319 -- We just assume on command line
320 lc_prog <- getSetting "LLVM llc command"
321 lo_prog <- getSetting "LLVM opt command"
322
323 let iserv_prog = libexec "ghc-iserv"
324
325 let platform = Platform {
326 platformArch = targetArch,
327 platformOS = targetOS,
328 platformWordSize = targetWordSize,
329 platformUnregisterised = targetUnregisterised,
330 platformHasGnuNonexecStack = targetHasGnuNonexecStack,
331 platformHasIdentDirective = targetHasIdentDirective,
332 platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols,
333 platformIsCrossCompiling = crossCompiling
334 }
335
336 return $ Settings {
337 sTargetPlatform = platform,
338 sTmpDir = normalise tmpdir,
339 sGhcUsagePath = ghc_usage_msg_path,
340 sGhciUsagePath = ghci_usage_msg_path,
341 sTopDir = top_dir,
342 sRawSettings = mySettings,
343 sExtraGccViaCFlags = words myExtraGccViaCFlags,
344 sSystemPackageConfig = pkgconfig_path,
345 sLdSupportsCompactUnwind = ldSupportsCompactUnwind,
346 sLdSupportsBuildId = ldSupportsBuildId,
347 sLdSupportsFilelist = ldSupportsFilelist,
348 sLdIsGnuLd = ldIsGnuLd,
349 sGccSupportsNoPie = gccSupportsNoPie,
350 sProgramName = "ghc",
351 sProjectVersion = cProjectVersion,
352 sPgm_L = unlit_path,
353 sPgm_P = (cpp_prog, cpp_args),
354 sPgm_F = "",
355 sPgm_c = (gcc_prog, gcc_args),
356 sPgm_s = (split_prog,split_args),
357 sPgm_a = (as_prog, as_args),
358 sPgm_l = (ld_prog, ld_args),
359 sPgm_dll = (mkdll_prog,mkdll_args),
360 sPgm_T = touch_path,
361 sPgm_windres = windres_path,
362 sPgm_libtool = libtool_path,
363 sPgm_lo = (lo_prog,[]),
364 sPgm_lc = (lc_prog,[]),
365 sPgm_i = iserv_prog,
366 sOpt_L = [],
367 sOpt_P = [],
368 sOpt_F = [],
369 sOpt_c = [],
370 sOpt_a = [],
371 sOpt_l = [],
372 sOpt_windres = [],
373 sOpt_lo = [],
374 sOpt_lc = [],
375 sOpt_i = [],
376 sPlatformConstants = platformConstants
377 }
378
379 -- returns a Unix-format path (relying on getBaseDir to do so too)
380 findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
381 -> IO String -- TopDir (in Unix format '/' separated)
382 findTopDir (Just minusb) = return (normalise minusb)
383 findTopDir Nothing
384 = do -- Get directory of executable
385 maybe_exec_dir <- getBaseDir
386 case maybe_exec_dir of
387 -- "Just" on Windows, "Nothing" on unix
388 Nothing -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
389 Just dir -> return dir
390
391 {-
392 ************************************************************************
393 * *
394 \subsection{Running an external program}
395 * *
396 ************************************************************************
397 -}
398
399 runUnlit :: DynFlags -> [Option] -> IO ()
400 runUnlit dflags args = do
401 let prog = pgm_L dflags
402 opts = getOpts dflags opt_L
403 runSomething dflags "Literate pre-processor" prog
404 (map Option opts ++ args)
405
406 runCpp :: DynFlags -> [Option] -> IO ()
407 runCpp dflags args = do
408 let (p,args0) = pgm_P dflags
409 args1 = map Option (getOpts dflags opt_P)
410 args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
411 ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
412 mb_env <- getGccEnv args2
413 runSomethingFiltered dflags id "C pre-processor" p
414 (args0 ++ args1 ++ args2 ++ args) mb_env
415
416 runPp :: DynFlags -> [Option] -> IO ()
417 runPp dflags args = do
418 let prog = pgm_F dflags
419 opts = map Option (getOpts dflags opt_F)
420 runSomething dflags "Haskell pre-processor" prog (args ++ opts)
421
422 runCc :: DynFlags -> [Option] -> IO ()
423 runCc dflags args = do
424 let (p,args0) = pgm_c dflags
425 args1 = map Option (getOpts dflags opt_c)
426 args2 = args0 ++ args1 ++ args
427 mb_env <- getGccEnv args2
428 runSomethingResponseFile dflags cc_filter "C Compiler" p args2 mb_env
429 where
430 -- discard some harmless warnings from gcc that we can't turn off
431 cc_filter = unlines . doFilter . lines
432
433 {-
434 gcc gives warnings in chunks like so:
435 In file included from /foo/bar/baz.h:11,
436 from /foo/bar/baz2.h:22,
437 from wibble.c:33:
438 /foo/flibble:14: global register variable ...
439 /foo/flibble:15: warning: call-clobbered r...
440 We break it up into its chunks, remove any call-clobbered register
441 warnings from each chunk, and then delete any chunks that we have
442 emptied of warnings.
443 -}
444 doFilter = unChunkWarnings . filterWarnings . chunkWarnings []
445 -- We can't assume that the output will start with an "In file inc..."
446 -- line, so we start off expecting a list of warnings rather than a
447 -- location stack.
448 chunkWarnings :: [String] -- The location stack to use for the next
449 -- list of warnings
450 -> [String] -- The remaining lines to look at
451 -> [([String], [String])]
452 chunkWarnings loc_stack [] = [(loc_stack, [])]
453 chunkWarnings loc_stack xs
454 = case break loc_stack_start xs of
455 (warnings, lss:xs') ->
456 case span loc_start_continuation xs' of
457 (lsc, xs'') ->
458 (loc_stack, warnings) : chunkWarnings (lss : lsc) xs''
459 _ -> [(loc_stack, xs)]
460
461 filterWarnings :: [([String], [String])] -> [([String], [String])]
462 filterWarnings [] = []
463 -- If the warnings are already empty then we are probably doing
464 -- something wrong, so don't delete anything
465 filterWarnings ((xs, []) : zs) = (xs, []) : filterWarnings zs
466 filterWarnings ((xs, ys) : zs) = case filter wantedWarning ys of
467 [] -> filterWarnings zs
468 ys' -> (xs, ys') : filterWarnings zs
469
470 unChunkWarnings :: [([String], [String])] -> [String]
471 unChunkWarnings [] = []
472 unChunkWarnings ((xs, ys) : zs) = xs ++ ys ++ unChunkWarnings zs
473
474 loc_stack_start s = "In file included from " `isPrefixOf` s
475 loc_start_continuation s = " from " `isPrefixOf` s
476 wantedWarning w
477 | "warning: call-clobbered register used" `isContainedIn` w = False
478 | otherwise = True
479
480 isContainedIn :: String -> String -> Bool
481 xs `isContainedIn` ys = any (xs `isPrefixOf`) (tails ys)
482
483 -- | Run the linker with some arguments and return the output
484 askLd :: DynFlags -> [Option] -> IO String
485 askLd dflags args = do
486 let (p,args0) = pgm_l dflags
487 args1 = map Option (getOpts dflags opt_l)
488 args2 = args0 ++ args1 ++ args
489 mb_env <- getGccEnv args2
490 runSomethingWith dflags "gcc" p args2 $ \real_args ->
491 readCreateProcessWithExitCode' (proc p real_args){ env = mb_env }
492
493 -- Similar to System.Process.readCreateProcessWithExitCode, but stderr is
494 -- inherited from the parent process, and output to stderr is not captured.
495 readCreateProcessWithExitCode'
496 :: CreateProcess
497 -> IO (ExitCode, String) -- ^ stdout
498 readCreateProcessWithExitCode' proc = do
499 (_, Just outh, _, pid) <-
500 createProcess proc{ std_out = CreatePipe }
501
502 -- fork off a thread to start consuming the output
503 output <- hGetContents outh
504 outMVar <- newEmptyMVar
505 _ <- forkIO $ evaluate (length output) >> putMVar outMVar ()
506
507 -- wait on the output
508 takeMVar outMVar
509 hClose outh
510
511 -- wait on the process
512 ex <- waitForProcess pid
513
514 return (ex, output)
515
516 replaceVar :: (String, String) -> [(String, String)] -> [(String, String)]
517 replaceVar (var, value) env =
518 (var, value) : filter (\(var',_) -> var /= var') env
519
520 -- | Version of @System.Process.readProcessWithExitCode@ that takes a
521 -- key-value tuple to insert into the environment.
522 readProcessEnvWithExitCode
523 :: String -- ^ program path
524 -> [String] -- ^ program args
525 -> (String, String) -- ^ addition to the environment
526 -> IO (ExitCode, String, String) -- ^ (exit_code, stdout, stderr)
527 readProcessEnvWithExitCode prog args env_update = do
528 current_env <- getEnvironment
529 readCreateProcessWithExitCode (proc prog args) {
530 env = Just (replaceVar env_update current_env) } ""
531
532 -- Don't let gcc localize version info string, #8825
533 c_locale_env :: (String, String)
534 c_locale_env = ("LANGUAGE", "C")
535
536 -- If the -B<dir> option is set, add <dir> to PATH. This works around
537 -- a bug in gcc on Windows Vista where it can't find its auxiliary
538 -- binaries (see bug #1110).
539 getGccEnv :: [Option] -> IO (Maybe [(String,String)])
540 getGccEnv opts =
541 if null b_dirs
542 then return Nothing
543 else do env <- getEnvironment
544 return (Just (map mangle_path env))
545 where
546 (b_dirs, _) = partitionWith get_b_opt opts
547
548 get_b_opt (Option ('-':'B':dir)) = Left dir
549 get_b_opt other = Right other
550
551 mangle_path (path,paths) | map toUpper path == "PATH"
552 = (path, '\"' : head b_dirs ++ "\";" ++ paths)
553 mangle_path other = other
554
555 runSplit :: DynFlags -> [Option] -> IO ()
556 runSplit dflags args = do
557 let (p,args0) = pgm_s dflags
558 runSomething dflags "Splitter" p (args0++args)
559
560 runAs :: DynFlags -> [Option] -> IO ()
561 runAs dflags args = do
562 let (p,args0) = pgm_a dflags
563 args1 = map Option (getOpts dflags opt_a)
564 args2 = args0 ++ args1 ++ args
565 mb_env <- getGccEnv args2
566 runSomethingFiltered dflags id "Assembler" p args2 mb_env
567
568 -- | Run the LLVM Optimiser
569 runLlvmOpt :: DynFlags -> [Option] -> IO ()
570 runLlvmOpt dflags args = do
571 let (p,args0) = pgm_lo dflags
572 args1 = map Option (getOpts dflags opt_lo)
573 runSomething dflags "LLVM Optimiser" p (args0 ++ args1 ++ args)
574
575 -- | Run the LLVM Compiler
576 runLlvmLlc :: DynFlags -> [Option] -> IO ()
577 runLlvmLlc dflags args = do
578 let (p,args0) = pgm_lc dflags
579 args1 = map Option (getOpts dflags opt_lc)
580 runSomething dflags "LLVM Compiler" p (args0 ++ args1 ++ args)
581
582 -- | Run the clang compiler (used as an assembler for the LLVM
583 -- backend on OS X as LLVM doesn't support the OS X system
584 -- assembler)
585 runClang :: DynFlags -> [Option] -> IO ()
586 runClang dflags args = do
587 -- we simply assume its available on the PATH
588 let clang = "clang"
589 -- be careful what options we call clang with
590 -- see #5903 and #7617 for bugs caused by this.
591 (_,args0) = pgm_a dflags
592 args1 = map Option (getOpts dflags opt_a)
593 args2 = args0 ++ args1 ++ args
594 mb_env <- getGccEnv args2
595 Exception.catch (do
596 runSomethingFiltered dflags id "Clang (Assembler)" clang args2 mb_env
597 )
598 (\(err :: SomeException) -> do
599 errorMsg dflags $
600 text ("Error running clang! you need clang installed to use the" ++
601 " LLVM backend") $+$
602 text "(or GHC tried to execute clang incorrectly)"
603 throwIO err
604 )
605
606 -- | Figure out which version of LLVM we are running this session
607 figureLlvmVersion :: DynFlags -> IO (Maybe (Int, Int))
608 figureLlvmVersion dflags = do
609 let (pgm,opts) = pgm_lc dflags
610 args = filter notNull (map showOpt opts)
611 -- we grab the args even though they should be useless just in
612 -- case the user is using a customised 'llc' that requires some
613 -- of the options they've specified. llc doesn't care what other
614 -- options are specified when '-version' is used.
615 args' = args ++ ["-version"]
616 ver <- catchIO (do
617 (pin, pout, perr, _) <- runInteractiveProcess pgm args'
618 Nothing Nothing
619 {- > llc -version
620 LLVM (http://llvm.org/):
621 LLVM version 3.5.2
622 ...
623 -}
624 hSetBinaryMode pout False
625 _ <- hGetLine pout
626 vline <- dropWhile (not . isDigit) `fmap` hGetLine pout
627 v <- case span (/= '.') vline of
628 ("",_) -> fail "no digits!"
629 (x,y) -> return (read x
630 , read $ takeWhile isDigit $ drop 1 y)
631
632 hClose pin
633 hClose pout
634 hClose perr
635 return $ Just v
636 )
637 (\err -> do
638 debugTraceMsg dflags 2
639 (text "Error (figuring out LLVM version):" <+>
640 text (show err))
641 errorMsg dflags $ vcat
642 [ text "Warning:", nest 9 $
643 text "Couldn't figure out LLVM version!" $$
644 text ("Make sure you have installed LLVM " ++
645 llvmVersionStr supportedLlvmVersion) ]
646 return Nothing)
647 return ver
648
649 {- Note [Windows stack usage]
650
651 See: Trac #8870 (and #8834 for related info) and #12186
652
653 On Windows, occasionally we need to grow the stack. In order to do
654 this, we would normally just bump the stack pointer - but there's a
655 catch on Windows.
656
657 If the stack pointer is bumped by more than a single page, then the
658 pages between the initial pointer and the resulting location must be
659 properly committed by the Windows virtual memory subsystem. This is
660 only needed in the event we bump by more than one page (i.e 4097 bytes
661 or more).
662
663 Windows compilers solve this by emitting a call to a special function
664 called _chkstk, which does this committing of the pages for you.
665
666 The reason this was causing a segfault was because due to the fact the
667 new code generator tends to generate larger functions, we needed more
668 stack space in GHC itself. In the x86 codegen, we needed approximately
669 ~12kb of stack space in one go, which caused the process to segfault,
670 as the intervening pages were not committed.
671
672 GCC can emit such a check for us automatically but only when the flag
673 -fstack-check is used.
674
675 See https://gcc.gnu.org/onlinedocs/gnat_ugn/Stack-Overflow-Checking.html
676 for more information.
677
678 -}
679
680 {- Note [Run-time linker info]
681
682 See also: Trac #5240, Trac #6063, Trac #10110
683
684 Before 'runLink', we need to be sure to get the relevant information
685 about the linker we're using at runtime to see if we need any extra
686 options. For example, GNU ld requires '--reduce-memory-overheads' and
687 '--hash-size=31' in order to use reasonable amounts of memory (see
688 trac #5240.) But this isn't supported in GNU gold.
689
690 Generally, the linker changing from what was detected at ./configure
691 time has always been possible using -pgml, but on Linux it can happen
692 'transparently' by installing packages like binutils-gold, which
693 change what /usr/bin/ld actually points to.
694
695 Clang vs GCC notes:
696
697 For gcc, 'gcc -Wl,--version' gives a bunch of output about how to
698 invoke the linker before the version information string. For 'clang',
699 the version information for 'ld' is all that's output. For this
700 reason, we typically need to slurp up all of the standard error output
701 and look through it.
702
703 Other notes:
704
705 We cache the LinkerInfo inside DynFlags, since clients may link
706 multiple times. The definition of LinkerInfo is there to avoid a
707 circular dependency.
708
709 -}
710
711 {- Note [ELF needed shared libs]
712
713 Some distributions change the link editor's default handling of
714 ELF DT_NEEDED tags to include only those shared objects that are
715 needed to resolve undefined symbols. For Template Haskell we need
716 the last temporary shared library also if it is not needed for the
717 currently linked temporary shared library. We specify --no-as-needed
718 to override the default. This flag exists in GNU ld and GNU gold.
719
720 The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
721 (Mach-O) the flag is not needed.
722
723 -}
724
725 {- Note [Windows static libGCC]
726
727 The GCC versions being upgraded to in #10726 are configured with
728 dynamic linking of libgcc supported. This results in libgcc being
729 linked dynamically when a shared library is created.
730
731 This introduces thus an extra dependency on GCC dll that was not
732 needed before by shared libraries created with GHC. This is a particular
733 issue on Windows because you get a non-obvious error due to this missing
734 dependency. This dependent dll is also not commonly on your path.
735
736 For this reason using the static libgcc is preferred as it preserves
737 the same behaviour that existed before. There are however some very good
738 reasons to have the shared version as well as described on page 181 of
739 https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :
740
741 "There are several situations in which an application should use the
742 shared ‘libgcc’ instead of the static version. The most common of these
743 is when the application wishes to throw and catch exceptions across different
744 shared libraries. In that case, each of the libraries as well as the application
745 itself should use the shared ‘libgcc’. "
746
747 -}
748
749 neededLinkArgs :: LinkerInfo -> [Option]
750 neededLinkArgs (GnuLD o) = o
751 neededLinkArgs (GnuGold o) = o
752 neededLinkArgs (DarwinLD o) = o
753 neededLinkArgs (SolarisLD o) = o
754 neededLinkArgs (AixLD o) = o
755 neededLinkArgs UnknownLD = []
756
757 -- Grab linker info and cache it in DynFlags.
758 getLinkerInfo :: DynFlags -> IO LinkerInfo
759 getLinkerInfo dflags = do
760 info <- readIORef (rtldInfo dflags)
761 case info of
762 Just v -> return v
763 Nothing -> do
764 v <- getLinkerInfo' dflags
765 writeIORef (rtldInfo dflags) (Just v)
766 return v
767
768 -- See Note [Run-time linker info].
769 getLinkerInfo' :: DynFlags -> IO LinkerInfo
770 getLinkerInfo' dflags = do
771 let platform = targetPlatform dflags
772 os = platformOS platform
773 (pgm,args0) = pgm_l dflags
774 args1 = map Option (getOpts dflags opt_l)
775 args2 = args0 ++ args1
776 args3 = filter notNull (map showOpt args2)
777
778 -- Try to grab the info from the process output.
779 parseLinkerInfo stdo _stde _exitc
780 | any ("GNU ld" `isPrefixOf`) stdo =
781 -- GNU ld specifically needs to use less memory. This especially
782 -- hurts on small object files. Trac #5240.
783 -- Set DT_NEEDED for all shared libraries. Trac #10110.
784 -- TODO: Investigate if these help or hurt when using split sections.
785 return (GnuLD $ map Option ["-Wl,--hash-size=31",
786 "-Wl,--reduce-memory-overheads",
787 -- ELF specific flag
788 -- see Note [ELF needed shared libs]
789 "-Wl,--no-as-needed"])
790
791 | any ("GNU gold" `isPrefixOf`) stdo =
792 -- GNU gold only needs --no-as-needed. Trac #10110.
793 -- ELF specific flag, see Note [ELF needed shared libs]
794 return (GnuGold [Option "-Wl,--no-as-needed"])
795
796 -- Unknown linker.
797 | otherwise = fail "invalid --version output, or linker is unsupported"
798
799 -- Process the executable call
800 info <- catchIO (do
801 case os of
802 OSSolaris2 ->
803 -- Solaris uses its own Solaris linker. Even all
804 -- GNU C are recommended to configure with Solaris
805 -- linker instead of using GNU binutils linker. Also
806 -- all GCC distributed with Solaris follows this rule
807 -- precisely so we assume here, the Solaris linker is
808 -- used.
809 return $ SolarisLD []
810 OSAIX ->
811 -- IBM AIX uses its own non-binutils linker as well
812 return $ AixLD []
813 OSDarwin ->
814 -- Darwin has neither GNU Gold or GNU LD, but a strange linker
815 -- that doesn't support --version. We can just assume that's
816 -- what we're using.
817 return $ DarwinLD []
818 OSiOS ->
819 -- Ditto for iOS
820 return $ DarwinLD []
821 OSMinGW32 ->
822 -- GHC doesn't support anything but GNU ld on Windows anyway.
823 -- Process creation is also fairly expensive on win32, so
824 -- we short-circuit here.
825 return $ GnuLD $ map Option
826 [ -- Reduce ld memory usage
827 "-Wl,--hash-size=31"
828 , "-Wl,--reduce-memory-overheads"
829 -- Emit gcc stack checks
830 -- Note [Windows stack usage]
831 , "-fstack-check"
832 -- Force static linking of libGCC
833 -- Note [Windows static libGCC]
834 , "-static-libgcc" ]
835 _ -> do
836 -- In practice, we use the compiler as the linker here. Pass
837 -- -Wl,--version to get linker version info.
838 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
839 (["-Wl,--version"] ++ args3)
840 c_locale_env
841 -- Split the output by lines to make certain kinds
842 -- of processing easier. In particular, 'clang' and 'gcc'
843 -- have slightly different outputs for '-Wl,--version', but
844 -- it's still easy to figure out.
845 parseLinkerInfo (lines stdo) (lines stde) exitc
846 )
847 (\err -> do
848 debugTraceMsg dflags 2
849 (text "Error (figuring out linker information):" <+>
850 text (show err))
851 errorMsg dflags $ hang (text "Warning:") 9 $
852 text "Couldn't figure out linker information!" $$
853 text "Make sure you're using GNU ld, GNU gold" <+>
854 text "or the built in OS X linker, etc."
855 return UnknownLD)
856 return info
857
858 -- Grab compiler info and cache it in DynFlags.
859 getCompilerInfo :: DynFlags -> IO CompilerInfo
860 getCompilerInfo dflags = do
861 info <- readIORef (rtccInfo dflags)
862 case info of
863 Just v -> return v
864 Nothing -> do
865 v <- getCompilerInfo' dflags
866 writeIORef (rtccInfo dflags) (Just v)
867 return v
868
869 -- See Note [Run-time linker info].
870 getCompilerInfo' :: DynFlags -> IO CompilerInfo
871 getCompilerInfo' dflags = do
872 let (pgm,_) = pgm_c dflags
873 -- Try to grab the info from the process output.
874 parseCompilerInfo _stdo stde _exitc
875 -- Regular GCC
876 | any ("gcc version" `isInfixOf`) stde =
877 return GCC
878 -- Regular clang
879 | any ("clang version" `isInfixOf`) stde =
880 return Clang
881 -- XCode 5.1 clang
882 | any ("Apple LLVM version 5.1" `isPrefixOf`) stde =
883 return AppleClang51
884 -- XCode 5 clang
885 | any ("Apple LLVM version" `isPrefixOf`) stde =
886 return AppleClang
887 -- XCode 4.1 clang
888 | any ("Apple clang version" `isPrefixOf`) stde =
889 return AppleClang
890 -- Unknown linker.
891 | otherwise = fail "invalid -v output, or compiler is unsupported"
892
893 -- Process the executable call
894 info <- catchIO (do
895 (exitc, stdo, stde) <-
896 readProcessEnvWithExitCode pgm ["-v"] c_locale_env
897 -- Split the output by lines to make certain kinds
898 -- of processing easier.
899 parseCompilerInfo (lines stdo) (lines stde) exitc
900 )
901 (\err -> do
902 debugTraceMsg dflags 2
903 (text "Error (figuring out C compiler information):" <+>
904 text (show err))
905 errorMsg dflags $ hang (text "Warning:") 9 $
906 text "Couldn't figure out C compiler information!" $$
907 text "Make sure you're using GNU gcc, or clang"
908 return UnknownCC)
909 return info
910
911 runLink :: DynFlags -> [Option] -> IO ()
912 runLink dflags args = do
913 -- See Note [Run-time linker info]
914 linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
915 let (p,args0) = pgm_l dflags
916 args1 = map Option (getOpts dflags opt_l)
917 args2 = args0 ++ linkargs ++ args1 ++ args
918 mb_env <- getGccEnv args2
919 runSomethingResponseFile dflags ld_filter "Linker" p args2 mb_env
920 where
921 ld_filter = case (platformOS (targetPlatform dflags)) of
922 OSSolaris2 -> sunos_ld_filter
923 _ -> id
924 {-
925 SunOS/Solaris ld emits harmless warning messages about unresolved
926 symbols in case of compiling into shared library when we do not
927 link against all the required libs. That is the case of GHC which
928 does not link against RTS library explicitly in order to be able to
929 choose the library later based on binary application linking
930 parameters. The warnings look like:
931
932 Undefined first referenced
933 symbol in file
934 stg_ap_n_fast ./T2386_Lib.o
935 stg_upd_frame_info ./T2386_Lib.o
936 templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
937 templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
938 templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
939 templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
940 newCAF ./T2386_Lib.o
941 stg_bh_upd_frame_info ./T2386_Lib.o
942 stg_ap_ppp_fast ./T2386_Lib.o
943 templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
944 stg_ap_p_fast ./T2386_Lib.o
945 stg_ap_pp_fast ./T2386_Lib.o
946 ld: warning: symbol referencing errors
947
948 this is actually coming from T2386 testcase. The emitting of those
949 warnings is also a reason why so many TH testcases fail on Solaris.
950
951 Following filter code is SunOS/Solaris linker specific and should
952 filter out only linker warnings. Please note that the logic is a
953 little bit more complex due to the simple reason that we need to preserve
954 any other linker emitted messages. If there are any. Simply speaking
955 if we see "Undefined" and later "ld: warning:..." then we omit all
956 text between (including) the marks. Otherwise we copy the whole output.
957 -}
958 sunos_ld_filter :: String -> String
959 sunos_ld_filter = unlines . sunos_ld_filter' . lines
960 sunos_ld_filter' x = if (undefined_found x && ld_warning_found x)
961 then (ld_prefix x) ++ (ld_postfix x)
962 else x
963 breakStartsWith x y = break (isPrefixOf x) y
964 ld_prefix = fst . breakStartsWith "Undefined"
965 undefined_found = not . null . snd . breakStartsWith "Undefined"
966 ld_warn_break = breakStartsWith "ld: warning: symbol referencing errors"
967 ld_postfix = tail . snd . ld_warn_break
968 ld_warning_found = not . null . snd . ld_warn_break
969
970
971 runLibtool :: DynFlags -> [Option] -> IO ()
972 runLibtool dflags args = do
973 linkargs <- neededLinkArgs `fmap` getLinkerInfo dflags
974 let args1 = map Option (getOpts dflags opt_l)
975 args2 = [Option "-static"] ++ args1 ++ args ++ linkargs
976 libtool = pgm_libtool dflags
977 mb_env <- getGccEnv args2
978 runSomethingFiltered dflags id "Linker" libtool args2 mb_env
979
980 runMkDLL :: DynFlags -> [Option] -> IO ()
981 runMkDLL dflags args = do
982 let (p,args0) = pgm_dll dflags
983 args1 = args0 ++ args
984 mb_env <- getGccEnv (args0++args)
985 runSomethingFiltered dflags id "Make DLL" p args1 mb_env
986
987 runWindres :: DynFlags -> [Option] -> IO ()
988 runWindres dflags args = do
989 let (gcc, gcc_args) = pgm_c dflags
990 windres = pgm_windres dflags
991 opts = map Option (getOpts dflags opt_windres)
992 quote x = "\"" ++ x ++ "\""
993 args' = -- If windres.exe and gcc.exe are in a directory containing
994 -- spaces then windres fails to run gcc. We therefore need
995 -- to tell it what command to use...
996 Option ("--preprocessor=" ++
997 unwords (map quote (gcc :
998 map showOpt gcc_args ++
999 map showOpt opts ++
1000 ["-E", "-xc", "-DRC_INVOKED"])))
1001 -- ...but if we do that then if windres calls popen then
1002 -- it can't understand the quoting, so we have to use
1003 -- --use-temp-file so that it interprets it correctly.
1004 -- See #1828.
1005 : Option "--use-temp-file"
1006 : args
1007 mb_env <- getGccEnv gcc_args
1008 runSomethingFiltered dflags id "Windres" windres args' mb_env
1009
1010 touch :: DynFlags -> String -> String -> IO ()
1011 touch dflags purpose arg =
1012 runSomething dflags purpose (pgm_T dflags) [FileOption "" arg]
1013
1014 copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
1015 copy dflags purpose from to = copyWithHeader dflags purpose Nothing from to
1016
1017 copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
1018 -> IO ()
1019 copyWithHeader dflags purpose maybe_header from to = do
1020 showPass dflags purpose
1021
1022 hout <- openBinaryFile to WriteMode
1023 hin <- openBinaryFile from ReadMode
1024 ls <- hGetContents hin -- inefficient, but it'll do for now. ToDo: speed up
1025 maybe (return ()) (header hout) maybe_header
1026 hPutStr hout ls
1027 hClose hout
1028 hClose hin
1029 where
1030 -- write the header string in UTF-8. The header is something like
1031 -- {-# LINE "foo.hs" #-}
1032 -- and we want to make sure a Unicode filename isn't mangled.
1033 header h str = do
1034 hSetEncoding h utf8
1035 hPutStr h str
1036 hSetBinaryMode h True
1037
1038
1039
1040 {-
1041 ************************************************************************
1042 * *
1043 \subsection{Managing temporary files
1044 * *
1045 ************************************************************************
1046 -}
1047
1048 cleanTempDirs :: DynFlags -> IO ()
1049 cleanTempDirs dflags
1050 = unless (gopt Opt_KeepTmpFiles dflags)
1051 $ mask_
1052 $ do let ref = dirsToClean dflags
1053 ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds)
1054 removeTmpDirs dflags (Map.elems ds)
1055
1056 cleanTempFiles :: DynFlags -> IO ()
1057 cleanTempFiles dflags
1058 = unless (gopt Opt_KeepTmpFiles dflags)
1059 $ mask_
1060 $ do let ref = filesToClean dflags
1061 fs <- atomicModifyIORef' ref $ \fs -> ([],fs)
1062 removeTmpFiles dflags fs
1063
1064 cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
1065 cleanTempFilesExcept dflags dont_delete
1066 = unless (gopt Opt_KeepTmpFiles dflags)
1067 $ mask_
1068 $ do let ref = filesToClean dflags
1069 to_delete <- atomicModifyIORef' ref $ \files ->
1070 let res@(_to_keep, _to_delete) =
1071 partition (`Set.member` dont_delete_set) files
1072 in res
1073 removeTmpFiles dflags to_delete
1074 where dont_delete_set = Set.fromList dont_delete
1075
1076
1077 -- Return a unique numeric temp file suffix
1078 newTempSuffix :: DynFlags -> IO Int
1079 newTempSuffix dflags = atomicModifyIORef' (nextTempSuffix dflags) $ \n -> (n+1,n)
1080
1081 -- Find a temporary name that doesn't already exist.
1082 newTempName :: DynFlags -> Suffix -> IO FilePath
1083 newTempName dflags extn
1084 = do d <- getTempDir dflags
1085 findTempName (d </> "ghc_") -- See Note [Deterministic base name]
1086 where
1087 findTempName :: FilePath -> IO FilePath
1088 findTempName prefix
1089 = do n <- newTempSuffix dflags
1090 let filename = prefix ++ show n <.> extn
1091 b <- doesFileExist filename
1092 if b then findTempName prefix
1093 else do -- clean it up later
1094 consIORef (filesToClean dflags) filename
1095 return filename
1096
1097 newTempLibName :: DynFlags -> Suffix -> IO (FilePath, FilePath, String)
1098 newTempLibName dflags extn
1099 = do d <- getTempDir dflags
1100 findTempName d ("ghc_")
1101 where
1102 findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
1103 findTempName dir prefix
1104 = do n <- newTempSuffix dflags -- See Note [Deterministic base name]
1105 let libname = prefix ++ show n
1106 filename = dir </> "lib" ++ libname <.> extn
1107 b <- doesFileExist filename
1108 if b then findTempName dir prefix
1109 else do -- clean it up later
1110 consIORef (filesToClean dflags) filename
1111 return (filename, dir, libname)
1112
1113
1114 -- Return our temporary directory within tmp_dir, creating one if we
1115 -- don't have one yet.
1116 getTempDir :: DynFlags -> IO FilePath
1117 getTempDir dflags = do
1118 mapping <- readIORef dir_ref
1119 case Map.lookup tmp_dir mapping of
1120 Nothing -> do
1121 pid <- getProcessID
1122 let prefix = tmp_dir </> "ghc" ++ show pid ++ "_"
1123 mask_ $ mkTempDir prefix
1124 Just dir -> return dir
1125 where
1126 tmp_dir = tmpDir dflags
1127 dir_ref = dirsToClean dflags
1128
1129 mkTempDir :: FilePath -> IO FilePath
1130 mkTempDir prefix = do
1131 n <- newTempSuffix dflags
1132 let our_dir = prefix ++ show n
1133
1134 -- 1. Speculatively create our new directory.
1135 createDirectory our_dir
1136
1137 -- 2. Update the dirsToClean mapping unless an entry already exists
1138 -- (i.e. unless another thread beat us to it).
1139 their_dir <- atomicModifyIORef' dir_ref $ \mapping ->
1140 case Map.lookup tmp_dir mapping of
1141 Just dir -> (mapping, Just dir)
1142 Nothing -> (Map.insert tmp_dir our_dir mapping, Nothing)
1143
1144 -- 3. If there was an existing entry, return it and delete the
1145 -- directory we created. Otherwise return the directory we created.
1146 case their_dir of
1147 Nothing -> do
1148 debugTraceMsg dflags 2 $
1149 text "Created temporary directory:" <+> text our_dir
1150 return our_dir
1151 Just dir -> do
1152 removeDirectory our_dir
1153 return dir
1154 `catchIO` \e -> if isAlreadyExistsError e
1155 then mkTempDir prefix else ioError e
1156
1157 -- Note [Deterministic base name]
1158 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1159 --
1160 -- The filename of temporary files, especially the basename of C files, can end
1161 -- up in the output in some form, e.g. as part of linker debug information. In the
1162 -- interest of bit-wise exactly reproducible compilation (#4012), the basename of
1163 -- the temporary file no longer contains random information (it used to contain
1164 -- the process id).
1165 --
1166 -- This is ok, as the temporary directory used contains the pid (see getTempDir).
1167
1168 addFilesToClean :: DynFlags -> [FilePath] -> IO ()
1169 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
1170 addFilesToClean dflags new_files
1171 = atomicModifyIORef' (filesToClean dflags) $ \files -> (new_files++files, ())
1172
1173 removeTmpDirs :: DynFlags -> [FilePath] -> IO ()
1174 removeTmpDirs dflags ds
1175 = traceCmd dflags "Deleting temp dirs"
1176 ("Deleting: " ++ unwords ds)
1177 (mapM_ (removeWith dflags removeDirectory) ds)
1178
1179 removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
1180 removeTmpFiles dflags fs
1181 = warnNon $
1182 traceCmd dflags "Deleting temp files"
1183 ("Deleting: " ++ unwords deletees)
1184 (mapM_ (removeWith dflags removeFile) deletees)
1185 where
1186 -- Flat out refuse to delete files that are likely to be source input
1187 -- files (is there a worse bug than having a compiler delete your source
1188 -- files?)
1189 --
1190 -- Deleting source files is a sign of a bug elsewhere, so prominently flag
1191 -- the condition.
1192 warnNon act
1193 | null non_deletees = act
1194 | otherwise = do
1195 putMsg dflags (text "WARNING - NOT deleting source files:" <+> hsep (map text non_deletees))
1196 act
1197
1198 (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
1199
1200 removeWith :: DynFlags -> (FilePath -> IO ()) -> FilePath -> IO ()
1201 removeWith dflags remover f = remover f `catchIO`
1202 (\e ->
1203 let msg = if isDoesNotExistError e
1204 then text "Warning: deleting non-existent" <+> text f
1205 else text "Warning: exception raised when deleting"
1206 <+> text f <> colon
1207 $$ text (show e)
1208 in debugTraceMsg dflags 2 msg
1209 )
1210
1211 -----------------------------------------------------------------------------
1212 -- Running an external program
1213
1214 runSomething :: DynFlags
1215 -> String -- For -v message
1216 -> String -- Command name (possibly a full path)
1217 -- assumed already dos-ified
1218 -> [Option] -- Arguments
1219 -- runSomething will dos-ify them
1220 -> IO ()
1221
1222 runSomething dflags phase_name pgm args =
1223 runSomethingFiltered dflags id phase_name pgm args Nothing
1224
1225 -- | Run a command, placing the arguments in an external response file.
1226 --
1227 -- This command is used in order to avoid overlong command line arguments on
1228 -- Windows. The command line arguments are first written to an external,
1229 -- temporary response file, and then passed to the linker via @filepath.
1230 -- response files for passing them in. See:
1231 --
1232 -- https://gcc.gnu.org/wiki/Response_Files
1233 -- https://ghc.haskell.org/trac/ghc/ticket/10777
1234 runSomethingResponseFile
1235 :: DynFlags -> (String->String) -> String -> String -> [Option]
1236 -> Maybe [(String,String)] -> IO ()
1237
1238 runSomethingResponseFile dflags filter_fn phase_name pgm args mb_env =
1239 runSomethingWith dflags phase_name pgm args $ \real_args -> do
1240 fp <- getResponseFile real_args
1241 let args = ['@':fp]
1242 r <- builderMainLoop dflags filter_fn pgm args mb_env
1243 return (r,())
1244 where
1245 getResponseFile args = do
1246 fp <- newTempName dflags "rsp"
1247 withFile fp WriteMode $ \h -> do
1248 #if defined(mingw32_HOST_OS)
1249 hSetEncoding h latin1
1250 #else
1251 hSetEncoding h utf8
1252 #endif
1253 hPutStr h $ unlines $ map escape args
1254 return fp
1255
1256 -- Note: Response files have backslash-escaping, double quoting, and are
1257 -- whitespace separated (some implementations use newline, others any
1258 -- whitespace character). Therefore, escape any backslashes, newlines, and
1259 -- double quotes in the argument, and surround the content with double
1260 -- quotes.
1261 --
1262 -- Another possibility that could be considered would be to convert
1263 -- backslashes in the argument to forward slashes. This would generally do
1264 -- the right thing, since backslashes in general only appear in arguments
1265 -- as part of file paths on Windows, and the forward slash is accepted for
1266 -- those. However, escaping is more reliable, in case somehow a backslash
1267 -- appears in a non-file.
1268 escape x = concat
1269 [ "\""
1270 , concatMap
1271 (\c ->
1272 case c of
1273 '\\' -> "\\\\"
1274 '\n' -> "\\n"
1275 '\"' -> "\\\""
1276 _ -> [c])
1277 x
1278 , "\""
1279 ]
1280
1281 runSomethingFiltered
1282 :: DynFlags -> (String->String) -> String -> String -> [Option]
1283 -> Maybe [(String,String)] -> IO ()
1284
1285 runSomethingFiltered dflags filter_fn phase_name pgm args mb_env = do
1286 runSomethingWith dflags phase_name pgm args $ \real_args -> do
1287 r <- builderMainLoop dflags filter_fn pgm real_args mb_env
1288 return (r,())
1289
1290 runSomethingWith
1291 :: DynFlags -> String -> String -> [Option]
1292 -> ([String] -> IO (ExitCode, a))
1293 -> IO a
1294
1295 runSomethingWith dflags phase_name pgm args io = do
1296 let real_args = filter notNull (map showOpt args)
1297 cmdLine = showCommandForUser pgm real_args
1298 traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
1299
1300 handleProc :: String -> String -> IO (ExitCode, r) -> IO r
1301 handleProc pgm phase_name proc = do
1302 (rc, r) <- proc `catchIO` handler
1303 case rc of
1304 ExitSuccess{} -> return r
1305 ExitFailure n -> throwGhcExceptionIO (
1306 ProgramError ("`" ++ takeFileName pgm ++ "'" ++
1307 " failed in phase `" ++ phase_name ++ "'." ++
1308 " (Exit code: " ++ show n ++ ")"))
1309 where
1310 handler err =
1311 if IO.isDoesNotExistError err
1312 then does_not_exist
1313 else throwGhcExceptionIO (ProgramError $ show err)
1314
1315 does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
1316
1317
1318 builderMainLoop :: DynFlags -> (String -> String) -> FilePath
1319 -> [String] -> Maybe [(String, String)]
1320 -> IO ExitCode
1321 builderMainLoop dflags filter_fn pgm real_args mb_env = do
1322 chan <- newChan
1323 (hStdIn, hStdOut, hStdErr, hProcess) <- runInteractiveProcess pgm real_args Nothing mb_env
1324
1325 -- and run a loop piping the output from the compiler to the log_action in DynFlags
1326 hSetBuffering hStdOut LineBuffering
1327 hSetBuffering hStdErr LineBuffering
1328 _ <- forkIO (readerProc chan hStdOut filter_fn)
1329 _ <- forkIO (readerProc chan hStdErr filter_fn)
1330 -- we don't want to finish until 2 streams have been completed
1331 -- (stdout and stderr)
1332 -- nor until 1 exit code has been retrieved.
1333 rc <- loop chan hProcess (2::Integer) (1::Integer) ExitSuccess
1334 -- after that, we're done here.
1335 hClose hStdIn
1336 hClose hStdOut
1337 hClose hStdErr
1338 return rc
1339 where
1340 -- status starts at zero, and increments each time either
1341 -- a reader process gets EOF, or the build proc exits. We wait
1342 -- for all of these to happen (status==3).
1343 -- ToDo: we should really have a contingency plan in case any of
1344 -- the threads dies, such as a timeout.
1345 loop _ _ 0 0 exitcode = return exitcode
1346 loop chan hProcess t p exitcode = do
1347 mb_code <- if p > 0
1348 then getProcessExitCode hProcess
1349 else return Nothing
1350 case mb_code of
1351 Just code -> loop chan hProcess t (p-1) code
1352 Nothing
1353 | t > 0 -> do
1354 msg <- readChan chan
1355 case msg of
1356 BuildMsg msg -> do
1357 putLogMsg dflags NoReason SevInfo noSrcSpan
1358 (defaultUserStyle dflags) msg
1359 loop chan hProcess t p exitcode
1360 BuildError loc msg -> do
1361 putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)
1362 (defaultUserStyle dflags) msg
1363 loop chan hProcess t p exitcode
1364 EOF ->
1365 loop chan hProcess (t-1) p exitcode
1366 | otherwise -> loop chan hProcess t p exitcode
1367
1368 readerProc :: Chan BuildMessage -> Handle -> (String -> String) -> IO ()
1369 readerProc chan hdl filter_fn =
1370 (do str <- hGetContents hdl
1371 loop (linesPlatform (filter_fn str)) Nothing)
1372 `finally`
1373 writeChan chan EOF
1374 -- ToDo: check errors more carefully
1375 -- ToDo: in the future, the filter should be implemented as
1376 -- a stream transformer.
1377 where
1378 loop [] Nothing = return ()
1379 loop [] (Just err) = writeChan chan err
1380 loop (l:ls) in_err =
1381 case in_err of
1382 Just err@(BuildError srcLoc msg)
1383 | leading_whitespace l -> do
1384 loop ls (Just (BuildError srcLoc (msg $$ text l)))
1385 | otherwise -> do
1386 writeChan chan err
1387 checkError l ls
1388 Nothing -> do
1389 checkError l ls
1390 _ -> panic "readerProc/loop"
1391
1392 checkError l ls
1393 = case parseError l of
1394 Nothing -> do
1395 writeChan chan (BuildMsg (text l))
1396 loop ls Nothing
1397 Just (file, lineNum, colNum, msg) -> do
1398 let srcLoc = mkSrcLoc (mkFastString file) lineNum colNum
1399 loop ls (Just (BuildError srcLoc (text msg)))
1400
1401 leading_whitespace [] = False
1402 leading_whitespace (x:_) = isSpace x
1403
1404 parseError :: String -> Maybe (String, Int, Int, String)
1405 parseError s0 = case breakColon s0 of
1406 Just (filename, s1) ->
1407 case breakIntColon s1 of
1408 Just (lineNum, s2) ->
1409 case breakIntColon s2 of
1410 Just (columnNum, s3) ->
1411 Just (filename, lineNum, columnNum, s3)
1412 Nothing ->
1413 Just (filename, lineNum, 0, s2)
1414 Nothing -> Nothing
1415 Nothing -> Nothing
1416
1417 breakColon :: String -> Maybe (String, String)
1418 breakColon xs = case break (':' ==) xs of
1419 (ys, _:zs) -> Just (ys, zs)
1420 _ -> Nothing
1421
1422 breakIntColon :: String -> Maybe (Int, String)
1423 breakIntColon xs = case break (':' ==) xs of
1424 (ys, _:zs)
1425 | not (null ys) && all isAscii ys && all isDigit ys ->
1426 Just (read ys, zs)
1427 _ -> Nothing
1428
1429 data BuildMessage
1430 = BuildMsg !SDoc
1431 | BuildError !SrcLoc !SDoc
1432 | EOF
1433
1434 traceCmd :: DynFlags -> String -> String -> IO a -> IO a
1435 -- trace the command (at two levels of verbosity)
1436 traceCmd dflags phase_name cmd_line action
1437 = do { let verb = verbosity dflags
1438 ; showPass dflags phase_name
1439 ; debugTraceMsg dflags 3 (text cmd_line)
1440 ; case flushErr dflags of
1441 FlushErr io -> io
1442
1443 -- And run it!
1444 ; action `catchIO` handle_exn verb
1445 }
1446 where
1447 handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
1448 ; debugTraceMsg dflags 2 (text "Failed:" <+> text cmd_line <+> text (show exn))
1449 ; throwGhcExceptionIO (ProgramError (show exn))}
1450
1451 {-
1452 ************************************************************************
1453 * *
1454 \subsection{Support code}
1455 * *
1456 ************************************************************************
1457 -}
1458
1459 -----------------------------------------------------------------------------
1460 -- Define getBaseDir :: IO (Maybe String)
1461
1462 getBaseDir :: IO (Maybe String)
1463 #if defined(mingw32_HOST_OS)
1464 -- Assuming we are running ghc, accessed by path $(stuff)/<foo>/ghc.exe,
1465 -- return the path $(stuff)/lib.
1466 getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
1467 where
1468 try_size size = allocaArray (fromIntegral size) $ \buf -> do
1469 ret <- c_GetModuleFileName nullPtr buf size
1470 case ret of
1471 0 -> return Nothing
1472 _ | ret < size -> do
1473 path <- peekCWString buf
1474 real <- getFinalPath path -- try to resolve symlinks paths
1475 let libdir = (rootDir . sanitize . maybe path id) real
1476 exists <- doesDirectoryExist libdir
1477 if exists
1478 then return $ Just libdir
1479 else fail path
1480 | otherwise -> try_size (size * 2)
1481
1482 -- getFinalPath returns paths in full raw form.
1483 -- Unfortunately GHC isn't set up to handle these
1484 -- So if the call succeeded, we need to drop the
1485 -- \\?\ prefix.
1486 sanitize s = if "\\\\?\\" `isPrefixOf` s
1487 then drop 4 s
1488 else s
1489
1490 rootDir s = case splitFileName $ normalise s of
1491 (d, ghc_exe)
1492 | lower ghc_exe `elem` ["ghc.exe",
1493 "ghc-stage1.exe",
1494 "ghc-stage2.exe",
1495 "ghc-stage3.exe"] ->
1496 case splitFileName $ takeDirectory d of
1497 -- ghc is in $topdir/bin/ghc.exe
1498 (d', _) -> takeDirectory d' </> "lib"
1499 _ -> fail s
1500
1501 fail s = panic ("can't decompose ghc.exe path: " ++ show s)
1502 lower = map toLower
1503
1504 foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW"
1505 c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
1506
1507 -- Attempt to resolve symlinks in order to find the actual location GHC
1508 -- is located at. See Trac #11759.
1509 getFinalPath :: FilePath -> IO (Maybe FilePath)
1510 getFinalPath name = do
1511 dllHwnd <- failIfNull "LoadLibray" $ loadLibrary "kernel32.dll"
1512 -- Note: The API GetFinalPathNameByHandleW is only available starting from Windows Vista.
1513 -- This means that we can't bind directly to it since it may be missing.
1514 -- Instead try to find it's address at runtime and if we don't succeed consider the
1515 -- function failed.
1516 addr_m <- (fmap Just $ failIfNull "getProcAddress" $ getProcAddress dllHwnd "GetFinalPathNameByHandleW")
1517 `catch` (\(_ :: SomeException) -> return Nothing)
1518 case addr_m of
1519 Nothing -> return Nothing
1520 Just addr -> do handle <- failIf (==iNVALID_HANDLE_VALUE) "CreateFile"
1521 $ createFile name
1522 gENERIC_READ
1523 fILE_SHARE_READ
1524 Nothing
1525 oPEN_EXISTING
1526 (fILE_ATTRIBUTE_NORMAL .|. fILE_FLAG_BACKUP_SEMANTICS)
1527 Nothing
1528 let fnPtr = makeGetFinalPathNameByHandle $ castPtrToFunPtr addr
1529 path <- Win32.try "GetFinalPathName"
1530 (\buf len -> fnPtr handle buf len 0) 512
1531 `finally` closeHandle handle
1532 return $ Just path
1533
1534 type GetFinalPath = HANDLE -> LPTSTR -> DWORD -> DWORD -> IO DWORD
1535
1536 foreign import WINDOWS_CCONV unsafe "dynamic"
1537 makeGetFinalPathNameByHandle :: FunPtr GetFinalPath -> GetFinalPath
1538 #else
1539 getBaseDir = return Nothing
1540 #endif
1541
1542 #if defined(mingw32_HOST_OS)
1543 foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
1544 #else
1545 getProcessID :: IO Int
1546 getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
1547 #endif
1548
1549 -- Divvy up text stream into lines, taking platform dependent
1550 -- line termination into account.
1551 linesPlatform :: String -> [String]
1552 #if !defined(mingw32_HOST_OS)
1553 linesPlatform ls = lines ls
1554 #else
1555 linesPlatform "" = []
1556 linesPlatform xs =
1557 case lineBreak xs of
1558 (as,xs1) -> as : linesPlatform xs1
1559 where
1560 lineBreak "" = ("","")
1561 lineBreak ('\r':'\n':xs) = ([],xs)
1562 lineBreak ('\n':xs) = ([],xs)
1563 lineBreak (x:xs) = let (as,bs) = lineBreak xs in (x:as,bs)
1564
1565 #endif
1566
1567 {-
1568 Note [No PIE eating while linking]
1569 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1570 As of 2016 some Linux distributions (e.g. Debian) have started enabling -pie by
1571 default in their gcc builds. This is incompatible with -r as it implies that we
1572 are producing an executable. Consequently, we must manually pass -no-pie to gcc
1573 when joining object files or linking dynamic libraries. See #12759.
1574 -}
1575
1576 linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
1577 linkDynLib dflags0 o_files dep_packages
1578 = do
1579 let -- This is a rather ugly hack to fix dynamically linked
1580 -- GHC on Windows. If GHC is linked with -threaded, then
1581 -- it links against libHSrts_thr. But if base is linked
1582 -- against libHSrts, then both end up getting loaded,
1583 -- and things go wrong. We therefore link the libraries
1584 -- with the same RTS flags that we link GHC with.
1585 dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0
1586 else dflags0
1587 dflags2 = if cGhcDebugged then addWay' WayDebug dflags1
1588 else dflags1
1589 dflags = updateWays dflags2
1590
1591 verbFlags = getVerbFlags dflags
1592 o_file = outputFile dflags
1593
1594 pkgs <- getPreloadPackagesAnd dflags dep_packages
1595
1596 let pkg_lib_paths = collectLibraryPaths dflags pkgs
1597 let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
1598 get_pkg_lib_path_opts l
1599 | ( osElfTarget (platformOS (targetPlatform dflags)) ||
1600 osMachOTarget (platformOS (targetPlatform dflags)) ) &&
1601 dynLibLoader dflags == SystemDependent &&
1602 WayDyn `elem` ways dflags
1603 = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
1604 -- See Note [-Xlinker -rpath vs -Wl,-rpath]
1605 | otherwise = ["-L" ++ l]
1606
1607 let lib_paths = libraryPaths dflags
1608 let lib_path_opts = map ("-L"++) lib_paths
1609
1610 -- We don't want to link our dynamic libs against the RTS package,
1611 -- because the RTS lib comes in several flavours and we want to be
1612 -- able to pick the flavour when a binary is linked.
1613 -- On Windows we need to link the RTS import lib as Windows does
1614 -- not allow undefined symbols.
1615 -- The RTS library path is still added to the library search path
1616 -- above in case the RTS is being explicitly linked in (see #3807).
1617 let platform = targetPlatform dflags
1618 os = platformOS platform
1619 pkgs_no_rts = case os of
1620 OSMinGW32 ->
1621 pkgs
1622 _ ->
1623 filter ((/= rtsUnitId) . packageConfigId) pkgs
1624 let pkg_link_opts = let (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs_no_rts
1625 in package_hs_libs ++ extra_libs ++ other_flags
1626
1627 -- probably _stub.o files
1628 -- and last temporary shared object file
1629 let extra_ld_inputs = ldInputs dflags
1630
1631 -- frameworks
1632 pkg_framework_opts <- getPkgFrameworkOpts dflags platform
1633 (map unitId pkgs)
1634 let framework_opts = getFrameworkOpts dflags platform
1635
1636 case os of
1637 OSMinGW32 -> do
1638 -------------------------------------------------------------
1639 -- Making a DLL
1640 -------------------------------------------------------------
1641 let output_fn = case o_file of
1642 Just s -> s
1643 Nothing -> "HSdll.dll"
1644
1645 runLink dflags (
1646 map Option verbFlags
1647 ++ [ Option "-o"
1648 , FileOption "" output_fn
1649 , Option "-shared"
1650 ] ++
1651 [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
1652 | gopt Opt_SharedImplib dflags
1653 ]
1654 ++ map (FileOption "") o_files
1655
1656 -- Permit the linker to auto link _symbol to _imp_symbol
1657 -- This lets us link against DLLs without needing an "import library"
1658 ++ [Option "-Wl,--enable-auto-import"]
1659
1660 ++ extra_ld_inputs
1661 ++ map Option (
1662 lib_path_opts
1663 ++ pkg_lib_path_opts
1664 ++ pkg_link_opts
1665 ))
1666 _ | os `elem` [OSDarwin, OSiOS] -> do
1667 -------------------------------------------------------------------
1668 -- Making a darwin dylib
1669 -------------------------------------------------------------------
1670 -- About the options used for Darwin:
1671 -- -dynamiclib
1672 -- Apple's way of saying -shared
1673 -- -undefined dynamic_lookup:
1674 -- Without these options, we'd have to specify the correct
1675 -- dependencies for each of the dylibs. Note that we could
1676 -- (and should) do without this for all libraries except
1677 -- the RTS; all we need to do is to pass the correct
1678 -- HSfoo_dyn.dylib files to the link command.
1679 -- This feature requires Mac OS X 10.3 or later; there is
1680 -- a similar feature, -flat_namespace -undefined suppress,
1681 -- which works on earlier versions, but it has other
1682 -- disadvantages.
1683 -- -single_module
1684 -- Build the dynamic library as a single "module", i.e. no
1685 -- dynamic binding nonsense when referring to symbols from
1686 -- within the library. The NCG assumes that this option is
1687 -- specified (on i386, at least).
1688 -- -install_name
1689 -- Mac OS/X stores the path where a dynamic library is (to
1690 -- be) installed in the library itself. It's called the
1691 -- "install name" of the library. Then any library or
1692 -- executable that links against it before it's installed
1693 -- will search for it in its ultimate install location.
1694 -- By default we set the install name to the absolute path
1695 -- at build time, but it can be overridden by the
1696 -- -dylib-install-name option passed to ghc. Cabal does
1697 -- this.
1698 -------------------------------------------------------------------
1699
1700 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1701
1702 instName <- case dylibInstallName dflags of
1703 Just n -> return n
1704 Nothing -> return $ "@rpath" `combine` (takeFileName output_fn)
1705 runLink dflags (
1706 map Option verbFlags
1707 ++ [ Option "-dynamiclib"
1708 , Option "-o"
1709 , FileOption "" output_fn
1710 ]
1711 ++ map Option o_files
1712 ++ [ Option "-undefined",
1713 Option "dynamic_lookup",
1714 Option "-single_module" ]
1715 ++ (if platformArch platform == ArchX86_64
1716 then [ ]
1717 else [ Option "-Wl,-read_only_relocs,suppress" ])
1718 ++ [ Option "-install_name", Option instName ]
1719 ++ map Option lib_path_opts
1720 ++ extra_ld_inputs
1721 ++ map Option framework_opts
1722 ++ map Option pkg_lib_path_opts
1723 ++ map Option pkg_link_opts
1724 ++ map Option pkg_framework_opts
1725 )
1726 _ -> do
1727 -------------------------------------------------------------------
1728 -- Making a DSO
1729 -------------------------------------------------------------------
1730
1731 let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
1732 let bsymbolicFlag = -- we need symbolic linking to resolve
1733 -- non-PIC intra-package-relocations
1734 ["-Wl,-Bsymbolic"]
1735
1736 runLink dflags (
1737 map Option verbFlags
1738 ++ [ Option "-o"
1739 , FileOption "" output_fn
1740 ]
1741 -- See Note [No PIE eating when linking]
1742 ++ (if sGccSupportsNoPie (settings dflags)
1743 then [Option "-no-pie"]
1744 else [])
1745 ++ map Option o_files
1746 ++ [ Option "-shared" ]
1747 ++ map Option bsymbolicFlag
1748 -- Set the library soname. We use -h rather than -soname as
1749 -- Solaris 10 doesn't support the latter:
1750 ++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
1751 ++ extra_ld_inputs
1752 ++ map Option lib_path_opts
1753 ++ map Option pkg_lib_path_opts
1754 ++ map Option pkg_link_opts
1755 )
1756
1757 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
1758 getPkgFrameworkOpts dflags platform dep_packages
1759 | platformUsesFrameworks platform = do
1760 pkg_framework_path_opts <- do
1761 pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
1762 return $ map ("-F" ++) pkg_framework_paths
1763
1764 pkg_framework_opts <- do
1765 pkg_frameworks <- getPackageFrameworks dflags dep_packages
1766 return $ concat [ ["-framework", fw] | fw <- pkg_frameworks ]
1767
1768 return (pkg_framework_path_opts ++ pkg_framework_opts)
1769
1770 | otherwise = return []
1771
1772 getFrameworkOpts :: DynFlags -> Platform -> [String]
1773 getFrameworkOpts dflags platform
1774 | platformUsesFrameworks platform = framework_path_opts ++ framework_opts
1775 | otherwise = []
1776 where
1777 framework_paths = frameworkPaths dflags
1778 framework_path_opts = map ("-F" ++) framework_paths
1779
1780 frameworks = cmdlineFrameworks dflags
1781 -- reverse because they're added in reverse order from the cmd line:
1782 framework_opts = concat [ ["-framework", fw]
1783 | fw <- reverse frameworks ]