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