No relative inclusion of HsVersions.h
[ghc.git] / ghc / Main.hs
1 {-# LANGUAGE CPP, NondecreasingIndentation, TupleSections #-}
2 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
3
4 -----------------------------------------------------------------------------
5 --
6 -- GHC Driver program
7 --
8 -- (c) The University of Glasgow 2005
9 --
10 -----------------------------------------------------------------------------
11
12 module Main (main) where
13
14 -- The official GHC API
15 import qualified GHC
16 import GHC ( -- DynFlags(..), HscTarget(..),
17 -- GhcMode(..), GhcLink(..),
18 Ghc, GhcMonad(..),
19 LoadHowMuch(..) )
20 import CmdLineParser
21
22 -- Implementations of the various modes (--show-iface, mkdependHS. etc.)
23 import LoadIface ( showIface )
24 import HscMain ( newHscEnv )
25 import DriverPipeline ( oneShot, compileFile )
26 import DriverMkDepend ( doMkDependHS )
27 import DriverBkp ( doBackpack )
28 #if defined(GHCI)
29 import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
30 #endif
31
32 -- Frontend plugins
33 #if defined(GHCI)
34 import DynamicLoading ( loadFrontendPlugin )
35 import Plugins
36 #else
37 import DynamicLoading ( pluginError )
38 #endif
39 import Module ( ModuleName )
40
41
42 -- Various other random stuff that we need
43 import Config
44 import Constants
45 import HscTypes
46 import Packages ( pprPackages, pprPackagesSimple )
47 import DriverPhases
48 import BasicTypes ( failed )
49 import DynFlags hiding (WarnReason(..))
50 import ErrUtils
51 import FastString
52 import Outputable
53 import SrcLoc
54 import Util
55 import Panic
56 import UniqSupply
57 import MonadUtils ( liftIO )
58
59 -- Imports for --abi-hash
60 import LoadIface ( loadUserInterface )
61 import Module ( mkModuleName )
62 import Finder ( findImportedModule, cannotFindModule )
63 import TcRnMonad ( initIfaceCheck )
64 import Binary ( openBinMem, put_ )
65 import BinFingerprint ( fingerprintBinMem )
66
67 -- Standard Haskell libraries
68 import System.IO
69 import System.Environment
70 import System.Exit
71 import System.FilePath
72 import Control.Monad
73 import Data.Char
74 import Data.List
75 import Data.Maybe
76
77 -----------------------------------------------------------------------------
78 -- ToDo:
79
80 -- time commands when run with -v
81 -- user ways
82 -- Win32 support: proper signal handling
83 -- reading the package configuration file is too slow
84 -- -K<size>
85
86 -----------------------------------------------------------------------------
87 -- GHC's command-line interface
88
89 main :: IO ()
90 main = do
91 initGCStatistics -- See Note [-Bsymbolic and hooks]
92 hSetBuffering stdout LineBuffering
93 hSetBuffering stderr LineBuffering
94
95 -- Handle GHC-specific character encoding flags, allowing us to control how
96 -- GHC produces output regardless of OS.
97 env <- getEnvironment
98 case lookup "GHC_CHARENC" env of
99 Just "UTF-8" -> do
100 hSetEncoding stdout utf8
101 hSetEncoding stderr utf8
102 _ -> do
103 -- Avoid GHC erroring out when trying to display unhandled characters
104 hSetTranslit stdout
105 hSetTranslit stderr
106
107 GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
108 -- 1. extract the -B flag from the args
109 argv0 <- getArgs
110
111 let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
112 mbMinusB | null minusB_args = Nothing
113 | otherwise = Just (drop 2 (last minusB_args))
114
115 let argv2 = map (mkGeneralLocated "on the commandline") argv1
116
117 -- 2. Parse the "mode" flags (--make, --interactive etc.)
118 (mode, argv3, flagWarnings) <- parseModeFlags argv2
119
120 -- If all we want to do is something like showing the version number
121 -- then do it now, before we start a GHC session etc. This makes
122 -- getting basic information much more resilient.
123
124 -- In particular, if we wait until later before giving the version
125 -- number then bootstrapping gets confused, as it tries to find out
126 -- what version of GHC it's using before package.conf exists, so
127 -- starting the session fails.
128 case mode of
129 Left preStartupMode ->
130 do case preStartupMode of
131 ShowSupportedExtensions -> showSupportedExtensions
132 ShowVersion -> showVersion
133 ShowNumVersion -> putStrLn cProjectVersion
134 ShowOptions isInteractive -> showOptions isInteractive
135 Right postStartupMode ->
136 -- start our GHC session
137 GHC.runGhc mbMinusB $ do
138
139 dflags <- GHC.getSessionDynFlags
140
141 case postStartupMode of
142 Left preLoadMode ->
143 liftIO $ do
144 case preLoadMode of
145 ShowInfo -> showInfo dflags
146 ShowGhcUsage -> showGhcUsage dflags
147 ShowGhciUsage -> showGhciUsage dflags
148 PrintWithDynFlags f -> putStrLn (f dflags)
149 Right postLoadMode ->
150 main' postLoadMode dflags argv3 flagWarnings
151
152 main' :: PostLoadMode -> DynFlags -> [Located String] -> [Warn]
153 -> Ghc ()
154 main' postLoadMode dflags0 args flagWarnings = do
155 -- set the default GhcMode, HscTarget and GhcLink. The HscTarget
156 -- can be further adjusted on a module by module basis, using only
157 -- the -fvia-C and -fasm flags. If the default HscTarget is not
158 -- HscC or HscAsm, -fvia-C and -fasm have no effect.
159 let dflt_target = hscTarget dflags0
160 (mode, lang, link)
161 = case postLoadMode of
162 DoInteractive -> (CompManager, HscInterpreted, LinkInMemory)
163 DoEval _ -> (CompManager, HscInterpreted, LinkInMemory)
164 DoMake -> (CompManager, dflt_target, LinkBinary)
165 DoBackpack -> (CompManager, dflt_target, LinkBinary)
166 DoMkDependHS -> (MkDepend, dflt_target, LinkBinary)
167 DoAbiHash -> (OneShot, dflt_target, LinkBinary)
168 _ -> (OneShot, dflt_target, LinkBinary)
169
170 let dflags1 = dflags0{ ghcMode = mode,
171 hscTarget = lang,
172 ghcLink = link,
173 verbosity = case postLoadMode of
174 DoEval _ -> 0
175 _other -> 1
176 }
177
178 -- turn on -fimplicit-import-qualified for GHCi now, so that it
179 -- can be overriden from the command-line
180 -- XXX: this should really be in the interactive DynFlags, but
181 -- we don't set that until later in interactiveUI
182 -- We also set -fignore-optim-changes and -fignore-hpc-changes,
183 -- which are program-level options. Again, this doesn't really
184 -- feel like the right place to handle this, but we don't have
185 -- a great story for the moment.
186 dflags2 | DoInteractive <- postLoadMode = def_ghci_flags
187 | DoEval _ <- postLoadMode = def_ghci_flags
188 | otherwise = dflags1
189 where def_ghci_flags = dflags1 `gopt_set` Opt_ImplicitImportQualified
190 `gopt_set` Opt_IgnoreOptimChanges
191 `gopt_set` Opt_IgnoreHpcChanges
192
193 -- The rest of the arguments are "dynamic"
194 -- Leftover ones are presumably files
195 (dflags3, fileish_args, dynamicFlagWarnings) <-
196 GHC.parseDynamicFlags dflags2 args
197
198 let dflags4 = case lang of
199 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
200 let platform = targetPlatform dflags3
201 dflags3a = updateWays $ dflags3 { ways = interpWays }
202 dflags3b = foldl gopt_set dflags3a
203 $ concatMap (wayGeneralFlags platform)
204 interpWays
205 dflags3c = foldl gopt_unset dflags3b
206 $ concatMap (wayUnsetGeneralFlags platform)
207 interpWays
208 in dflags3c
209 _ ->
210 dflags3
211
212 GHC.prettyPrintGhcErrors dflags4 $ do
213
214 let flagWarnings' = flagWarnings ++ dynamicFlagWarnings
215
216 handleSourceError (\e -> do
217 GHC.printException e
218 liftIO $ exitWith (ExitFailure 1)) $ do
219 liftIO $ handleFlagWarnings dflags4 flagWarnings'
220
221 liftIO $ showBanner postLoadMode dflags4
222
223 let
224 -- To simplify the handling of filepaths, we normalise all filepaths right
225 -- away - e.g., for win32 platforms, backslashes are converted
226 -- into forward slashes.
227 normal_fileish_paths = map (normalise . unLoc) fileish_args
228 (srcs, objs) = partition_args normal_fileish_paths [] []
229
230 dflags5 = dflags4 { ldInputs = map (FileOption "") objs
231 ++ ldInputs dflags4 }
232
233 -- we've finished manipulating the DynFlags, update the session
234 _ <- GHC.setSessionDynFlags dflags5
235 dflags6 <- GHC.getSessionDynFlags
236 hsc_env <- GHC.getSession
237
238 ---------------- Display configuration -----------
239 case verbosity dflags6 of
240 v | v == 4 -> liftIO $ dumpPackagesSimple dflags6
241 | v >= 5 -> liftIO $ dumpPackages dflags6
242 | otherwise -> return ()
243
244 liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
245 ---------------- Final sanity checking -----------
246 liftIO $ checkOptions postLoadMode dflags6 srcs objs
247
248 ---------------- Do the business -----------
249 handleSourceError (\e -> do
250 GHC.printException e
251 liftIO $ exitWith (ExitFailure 1)) $ do
252 case postLoadMode of
253 ShowInterface f -> liftIO $ doShowIface dflags6 f
254 DoMake -> doMake srcs
255 DoMkDependHS -> doMkDependHS (map fst srcs)
256 StopBefore p -> liftIO (oneShot hsc_env p srcs)
257 DoInteractive -> ghciUI srcs Nothing
258 DoEval exprs -> ghciUI srcs $ Just $ reverse exprs
259 DoAbiHash -> abiHash (map fst srcs)
260 ShowPackages -> liftIO $ showPackages dflags6
261 DoFrontend f -> doFrontend f srcs
262 DoBackpack -> doBackpack (map fst srcs)
263
264 liftIO $ dumpFinalStats dflags6
265
266 ghciUI :: [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc ()
267 #if !defined(GHCI)
268 ghciUI _ _ = throwGhcException (CmdLineError "not built for interactive use")
269 #else
270 ghciUI = interactiveUI defaultGhciSettings
271 #endif
272
273 -- -----------------------------------------------------------------------------
274 -- Splitting arguments into source files and object files. This is where we
275 -- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
276 -- file indicating the phase specified by the -x option in force, if any.
277
278 partition_args :: [String] -> [(String, Maybe Phase)] -> [String]
279 -> ([(String, Maybe Phase)], [String])
280 partition_args [] srcs objs = (reverse srcs, reverse objs)
281 partition_args ("-x":suff:args) srcs objs
282 | "none" <- suff = partition_args args srcs objs
283 | StopLn <- phase = partition_args args srcs (slurp ++ objs)
284 | otherwise = partition_args rest (these_srcs ++ srcs) objs
285 where phase = startPhase suff
286 (slurp,rest) = break (== "-x") args
287 these_srcs = zip slurp (repeat (Just phase))
288 partition_args (arg:args) srcs objs
289 | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
290 | otherwise = partition_args args srcs (arg:objs)
291
292 {-
293 We split out the object files (.o, .dll) and add them
294 to ldInputs for use by the linker.
295
296 The following things should be considered compilation manager inputs:
297
298 - haskell source files (strings ending in .hs, .lhs or other
299 haskellish extension),
300
301 - module names (not forgetting hierarchical module names),
302
303 - things beginning with '-' are flags that were not recognised by
304 the flag parser, and we want them to generate errors later in
305 checkOptions, so we class them as source files (#5921)
306
307 - and finally we consider everything without an extension to be
308 a comp manager input, as shorthand for a .hs or .lhs filename.
309
310 Everything else is considered to be a linker object, and passed
311 straight through to the linker.
312 -}
313 looks_like_an_input :: String -> Bool
314 looks_like_an_input m = isSourceFilename m
315 || looksLikeModuleName m
316 || "-" `isPrefixOf` m
317 || not (hasExtension m)
318
319 -- -----------------------------------------------------------------------------
320 -- Option sanity checks
321
322 -- | Ensure sanity of options.
323 --
324 -- Throws 'UsageError' or 'CmdLineError' if not.
325 checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
326 -- Final sanity checking before kicking off a compilation (pipeline).
327 checkOptions mode dflags srcs objs = do
328 -- Complain about any unknown flags
329 let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
330 when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
331
332 when (notNull (filter wayRTSOnly (ways dflags))
333 && isInterpretiveMode mode) $
334 hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
335
336 -- -prof and --interactive are not a good combination
337 when ((filter (not . wayRTSOnly) (ways dflags) /= interpWays)
338 && isInterpretiveMode mode
339 && not (gopt Opt_ExternalInterpreter dflags)) $
340 do throwGhcException (UsageError
341 "-fexternal-interpreter is required when using --interactive with a non-standard way (-prof, -static, or -dynamic).")
342 -- -ohi sanity check
343 if (isJust (outputHi dflags) &&
344 (isCompManagerMode mode || srcs `lengthExceeds` 1))
345 then throwGhcException (UsageError "-ohi can only be used when compiling a single source file")
346 else do
347
348 -- -o sanity checking
349 if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
350 && not (isLinkMode mode))
351 then throwGhcException (UsageError "can't apply -o to multiple source files")
352 else do
353
354 let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
355
356 when (not_linking && not (null objs)) $
357 hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
358
359 -- Check that there are some input files
360 -- (except in the interactive case)
361 if null srcs && (null objs || not_linking) && needsInputsMode mode
362 then throwGhcException (UsageError "no input files")
363 else do
364
365 case mode of
366 StopBefore HCc | hscTarget dflags /= HscC
367 -> throwGhcException $ UsageError $
368 "the option -C is only available with an unregisterised GHC"
369 _ -> return ()
370
371 -- Verify that output files point somewhere sensible.
372 verifyOutputFiles dflags
373
374 -- Compiler output options
375
376 -- Called to verify that the output files point somewhere valid.
377 --
378 -- The assumption is that the directory portion of these output
379 -- options will have to exist by the time 'verifyOutputFiles'
380 -- is invoked.
381 --
382 -- We create the directories for -odir, -hidir, -outputdir etc. ourselves if
383 -- they don't exist, so don't check for those here (#2278).
384 verifyOutputFiles :: DynFlags -> IO ()
385 verifyOutputFiles dflags = do
386 let ofile = outputFile dflags
387 when (isJust ofile) $ do
388 let fn = fromJust ofile
389 flg <- doesDirNameExist fn
390 when (not flg) (nonExistentDir "-o" fn)
391 let ohi = outputHi dflags
392 when (isJust ohi) $ do
393 let hi = fromJust ohi
394 flg <- doesDirNameExist hi
395 when (not flg) (nonExistentDir "-ohi" hi)
396 where
397 nonExistentDir flg dir =
398 throwGhcException (CmdLineError ("error: directory portion of " ++
399 show dir ++ " does not exist (used with " ++
400 show flg ++ " option.)"))
401
402 -----------------------------------------------------------------------------
403 -- GHC modes of operation
404
405 type Mode = Either PreStartupMode PostStartupMode
406 type PostStartupMode = Either PreLoadMode PostLoadMode
407
408 data PreStartupMode
409 = ShowVersion -- ghc -V/--version
410 | ShowNumVersion -- ghc --numeric-version
411 | ShowSupportedExtensions -- ghc --supported-extensions
412 | ShowOptions Bool {- isInteractive -} -- ghc --show-options
413
414 showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
415 showVersionMode = mkPreStartupMode ShowVersion
416 showNumVersionMode = mkPreStartupMode ShowNumVersion
417 showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
418 showOptionsMode = mkPreStartupMode (ShowOptions False)
419
420 mkPreStartupMode :: PreStartupMode -> Mode
421 mkPreStartupMode = Left
422
423 isShowVersionMode :: Mode -> Bool
424 isShowVersionMode (Left ShowVersion) = True
425 isShowVersionMode _ = False
426
427 isShowNumVersionMode :: Mode -> Bool
428 isShowNumVersionMode (Left ShowNumVersion) = True
429 isShowNumVersionMode _ = False
430
431 data PreLoadMode
432 = ShowGhcUsage -- ghc -?
433 | ShowGhciUsage -- ghci -?
434 | ShowInfo -- ghc --info
435 | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
436
437 showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
438 showGhcUsageMode = mkPreLoadMode ShowGhcUsage
439 showGhciUsageMode = mkPreLoadMode ShowGhciUsage
440 showInfoMode = mkPreLoadMode ShowInfo
441
442 printSetting :: String -> Mode
443 printSetting k = mkPreLoadMode (PrintWithDynFlags f)
444 where f dflags = fromMaybe (panic ("Setting not found: " ++ show k))
445 $ lookup k (compilerInfo dflags)
446
447 mkPreLoadMode :: PreLoadMode -> Mode
448 mkPreLoadMode = Right . Left
449
450 isShowGhcUsageMode :: Mode -> Bool
451 isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
452 isShowGhcUsageMode _ = False
453
454 isShowGhciUsageMode :: Mode -> Bool
455 isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
456 isShowGhciUsageMode _ = False
457
458 data PostLoadMode
459 = ShowInterface FilePath -- ghc --show-iface
460 | DoMkDependHS -- ghc -M
461 | StopBefore Phase -- ghc -E | -C | -S
462 -- StopBefore StopLn is the default
463 | DoMake -- ghc --make
464 | DoBackpack -- ghc --backpack foo.bkp
465 | DoInteractive -- ghc --interactive
466 | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
467 | DoAbiHash -- ghc --abi-hash
468 | ShowPackages -- ghc --show-packages
469 | DoFrontend ModuleName -- ghc --frontend Plugin.Module
470
471 doMkDependHSMode, doMakeMode, doInteractiveMode,
472 doAbiHashMode, showPackagesMode :: Mode
473 doMkDependHSMode = mkPostLoadMode DoMkDependHS
474 doMakeMode = mkPostLoadMode DoMake
475 doInteractiveMode = mkPostLoadMode DoInteractive
476 doAbiHashMode = mkPostLoadMode DoAbiHash
477 showPackagesMode = mkPostLoadMode ShowPackages
478
479 showInterfaceMode :: FilePath -> Mode
480 showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
481
482 stopBeforeMode :: Phase -> Mode
483 stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
484
485 doEvalMode :: String -> Mode
486 doEvalMode str = mkPostLoadMode (DoEval [str])
487
488 doFrontendMode :: String -> Mode
489 doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
490
491 doBackpackMode :: Mode
492 doBackpackMode = mkPostLoadMode DoBackpack
493
494 mkPostLoadMode :: PostLoadMode -> Mode
495 mkPostLoadMode = Right . Right
496
497 isDoInteractiveMode :: Mode -> Bool
498 isDoInteractiveMode (Right (Right DoInteractive)) = True
499 isDoInteractiveMode _ = False
500
501 isStopLnMode :: Mode -> Bool
502 isStopLnMode (Right (Right (StopBefore StopLn))) = True
503 isStopLnMode _ = False
504
505 isDoMakeMode :: Mode -> Bool
506 isDoMakeMode (Right (Right DoMake)) = True
507 isDoMakeMode _ = False
508
509 isDoEvalMode :: Mode -> Bool
510 isDoEvalMode (Right (Right (DoEval _))) = True
511 isDoEvalMode _ = False
512
513 #if defined(GHCI)
514 isInteractiveMode :: PostLoadMode -> Bool
515 isInteractiveMode DoInteractive = True
516 isInteractiveMode _ = False
517 #endif
518
519 -- isInterpretiveMode: byte-code compiler involved
520 isInterpretiveMode :: PostLoadMode -> Bool
521 isInterpretiveMode DoInteractive = True
522 isInterpretiveMode (DoEval _) = True
523 isInterpretiveMode _ = False
524
525 needsInputsMode :: PostLoadMode -> Bool
526 needsInputsMode DoMkDependHS = True
527 needsInputsMode (StopBefore _) = True
528 needsInputsMode DoMake = True
529 needsInputsMode _ = False
530
531 -- True if we are going to attempt to link in this mode.
532 -- (we might not actually link, depending on the GhcLink flag)
533 isLinkMode :: PostLoadMode -> Bool
534 isLinkMode (StopBefore StopLn) = True
535 isLinkMode DoMake = True
536 isLinkMode DoInteractive = True
537 isLinkMode (DoEval _) = True
538 isLinkMode _ = False
539
540 isCompManagerMode :: PostLoadMode -> Bool
541 isCompManagerMode DoMake = True
542 isCompManagerMode DoInteractive = True
543 isCompManagerMode (DoEval _) = True
544 isCompManagerMode _ = False
545
546 -- -----------------------------------------------------------------------------
547 -- Parsing the mode flag
548
549 parseModeFlags :: [Located String]
550 -> IO (Mode,
551 [Located String],
552 [Warn])
553 parseModeFlags args = do
554 let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =
555 runCmdLine (processArgs mode_flags args)
556 (Nothing, [], [])
557 mode = case mModeFlag of
558 Nothing -> doMakeMode
559 Just (m, _) -> m
560
561 -- See Note [Handling errors when parsing commandline flags]
562 unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
563 map (("on the commandline", )) $ map (unLoc . errMsg) errs1 ++ errs2
564
565 return (mode, flags' ++ leftover, warns)
566
567 type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
568 -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
569 -- so we collect the new ones and return them.
570
571 mode_flags :: [Flag ModeM]
572 mode_flags =
573 [ ------- help / version ----------------------------------------------
574 defFlag "?" (PassFlag (setMode showGhcUsageMode))
575 , defFlag "-help" (PassFlag (setMode showGhcUsageMode))
576 , defFlag "V" (PassFlag (setMode showVersionMode))
577 , defFlag "-version" (PassFlag (setMode showVersionMode))
578 , defFlag "-numeric-version" (PassFlag (setMode showNumVersionMode))
579 , defFlag "-info" (PassFlag (setMode showInfoMode))
580 , defFlag "-show-options" (PassFlag (setMode showOptionsMode))
581 , defFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
582 , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
583 , defFlag "-show-packages" (PassFlag (setMode showPackagesMode))
584 ] ++
585 [ defFlag k' (PassFlag (setMode (printSetting k)))
586 | k <- ["Project version",
587 "Project Git commit id",
588 "Booter version",
589 "Stage",
590 "Build platform",
591 "Host platform",
592 "Target platform",
593 "Have interpreter",
594 "Object splitting supported",
595 "Have native code generator",
596 "Support SMP",
597 "Unregisterised",
598 "Tables next to code",
599 "RTS ways",
600 "Leading underscore",
601 "Debug on",
602 "LibDir",
603 "Global Package DB",
604 "C compiler flags",
605 "C compiler link flags",
606 "ld flags"],
607 let k' = "-print-" ++ map (replaceSpace . toLower) k
608 replaceSpace ' ' = '-'
609 replaceSpace c = c
610 ] ++
611 ------- interfaces ----------------------------------------------------
612 [ defFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
613 "--show-iface"))
614
615 ------- primary modes ------------------------------------------------
616 , defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
617 addFlag "-no-link" f))
618 , defFlag "M" (PassFlag (setMode doMkDependHSMode))
619 , defFlag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
620 , defFlag "C" (PassFlag (setMode (stopBeforeMode HCc)))
621 , defFlag "S" (PassFlag (setMode (stopBeforeMode (As False))))
622 , defFlag "-make" (PassFlag (setMode doMakeMode))
623 , defFlag "-backpack" (PassFlag (setMode doBackpackMode))
624 , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
625 , defFlag "-abi-hash" (PassFlag (setMode doAbiHashMode))
626 , defFlag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
627 , defFlag "-frontend" (SepArg (\s -> setMode (doFrontendMode s) "-frontend"))
628 ]
629
630 setMode :: Mode -> String -> EwM ModeM ()
631 setMode newMode newFlag = liftEwM $ do
632 (mModeFlag, errs, flags') <- getCmdLineState
633 let (modeFlag', errs') =
634 case mModeFlag of
635 Nothing -> ((newMode, newFlag), errs)
636 Just (oldMode, oldFlag) ->
637 case (oldMode, newMode) of
638 -- -c/--make are allowed together, and mean --make -no-link
639 _ | isStopLnMode oldMode && isDoMakeMode newMode
640 || isStopLnMode newMode && isDoMakeMode oldMode ->
641 ((doMakeMode, "--make"), [])
642
643 -- If we have both --help and --interactive then we
644 -- want showGhciUsage
645 _ | isShowGhcUsageMode oldMode &&
646 isDoInteractiveMode newMode ->
647 ((showGhciUsageMode, oldFlag), [])
648 | isShowGhcUsageMode newMode &&
649 isDoInteractiveMode oldMode ->
650 ((showGhciUsageMode, newFlag), [])
651
652 -- If we have both -e and --interactive then -e always wins
653 _ | isDoEvalMode oldMode &&
654 isDoInteractiveMode newMode ->
655 ((oldMode, oldFlag), [])
656 | isDoEvalMode newMode &&
657 isDoInteractiveMode oldMode ->
658 ((newMode, newFlag), [])
659
660 -- Otherwise, --help/--version/--numeric-version always win
661 | isDominantFlag oldMode -> ((oldMode, oldFlag), [])
662 | isDominantFlag newMode -> ((newMode, newFlag), [])
663 -- We need to accumulate eval flags like "-e foo -e bar"
664 (Right (Right (DoEval esOld)),
665 Right (Right (DoEval [eNew]))) ->
666 ((Right (Right (DoEval (eNew : esOld))), oldFlag),
667 errs)
668 -- Saying e.g. --interactive --interactive is OK
669 _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
670
671 -- --interactive and --show-options are used together
672 (Right (Right DoInteractive), Left (ShowOptions _)) ->
673 ((Left (ShowOptions True),
674 "--interactive --show-options"), errs)
675 (Left (ShowOptions _), (Right (Right DoInteractive))) ->
676 ((Left (ShowOptions True),
677 "--show-options --interactive"), errs)
678 -- Otherwise, complain
679 _ -> let err = flagMismatchErr oldFlag newFlag
680 in ((oldMode, oldFlag), err : errs)
681 putCmdLineState (Just modeFlag', errs', flags')
682 where isDominantFlag f = isShowGhcUsageMode f ||
683 isShowGhciUsageMode f ||
684 isShowVersionMode f ||
685 isShowNumVersionMode f
686
687 flagMismatchErr :: String -> String -> String
688 flagMismatchErr oldFlag newFlag
689 = "cannot use `" ++ oldFlag ++ "' with `" ++ newFlag ++ "'"
690
691 addFlag :: String -> String -> EwM ModeM ()
692 addFlag s flag = liftEwM $ do
693 (m, e, flags') <- getCmdLineState
694 putCmdLineState (m, e, mkGeneralLocated loc s : flags')
695 where loc = "addFlag by " ++ flag ++ " on the commandline"
696
697 -- ----------------------------------------------------------------------------
698 -- Run --make mode
699
700 doMake :: [(String,Maybe Phase)] -> Ghc ()
701 doMake srcs = do
702 let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
703
704 hsc_env <- GHC.getSession
705
706 -- if we have no haskell sources from which to do a dependency
707 -- analysis, then just do one-shot compilation and/or linking.
708 -- This means that "ghc Foo.o Bar.o -o baz" links the program as
709 -- we expect.
710 if (null hs_srcs)
711 then liftIO (oneShot hsc_env StopLn srcs)
712 else do
713
714 o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x)
715 non_hs_srcs
716 dflags <- GHC.getSessionDynFlags
717 let dflags' = dflags { ldInputs = map (FileOption "") o_files
718 ++ ldInputs dflags }
719 _ <- GHC.setSessionDynFlags dflags'
720
721 targets <- mapM (uncurry GHC.guessTarget) hs_srcs
722 GHC.setTargets targets
723 ok_flag <- GHC.load LoadAllTargets
724
725 when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
726 return ()
727
728
729 -- ---------------------------------------------------------------------------
730 -- --show-iface mode
731
732 doShowIface :: DynFlags -> FilePath -> IO ()
733 doShowIface dflags file = do
734 hsc_env <- newHscEnv dflags
735 showIface hsc_env file
736
737 -- ---------------------------------------------------------------------------
738 -- Various banners and verbosity output.
739
740 showBanner :: PostLoadMode -> DynFlags -> IO ()
741 showBanner _postLoadMode dflags = do
742 let verb = verbosity dflags
743
744 #if defined(GHCI)
745 -- Show the GHCi banner
746 when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
747 #endif
748
749 -- Display details of the configuration in verbose mode
750 when (verb >= 2) $
751 do hPutStr stderr "Glasgow Haskell Compiler, Version "
752 hPutStr stderr cProjectVersion
753 hPutStr stderr ", stage "
754 hPutStr stderr cStage
755 hPutStr stderr " booted by GHC version "
756 hPutStrLn stderr cBooterVersion
757
758 -- We print out a Read-friendly string, but a prettier one than the
759 -- Show instance gives us
760 showInfo :: DynFlags -> IO ()
761 showInfo dflags = do
762 let sq x = " [" ++ x ++ "\n ]"
763 putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
764
765 showSupportedExtensions :: IO ()
766 showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
767
768 showVersion :: IO ()
769 showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
770
771 showOptions :: Bool -> IO ()
772 showOptions isInteractive = putStr (unlines availableOptions)
773 where
774 availableOptions = concat [
775 flagsForCompletion isInteractive,
776 map ('-':) (getFlagNames mode_flags)
777 ]
778 getFlagNames opts = map flagName opts
779
780 showGhcUsage :: DynFlags -> IO ()
781 showGhcUsage = showUsage False
782
783 showGhciUsage :: DynFlags -> IO ()
784 showGhciUsage = showUsage True
785
786 showUsage :: Bool -> DynFlags -> IO ()
787 showUsage ghci dflags = do
788 let usage_path = if ghci then ghciUsagePath dflags
789 else ghcUsagePath dflags
790 usage <- readFile usage_path
791 dump usage
792 where
793 dump "" = return ()
794 dump ('$':'$':s) = putStr progName >> dump s
795 dump (c:s) = putChar c >> dump s
796
797 dumpFinalStats :: DynFlags -> IO ()
798 dumpFinalStats dflags =
799 when (gopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
800
801 dumpFastStringStats :: DynFlags -> IO ()
802 dumpFastStringStats dflags = do
803 buckets <- getFastStringTable
804 let (entries, longest, has_z) = countFS 0 0 0 buckets
805 msg = text "FastString stats:" $$
806 nest 4 (vcat [text "size: " <+> int (length buckets),
807 text "entries: " <+> int entries,
808 text "longest chain: " <+> int longest,
809 text "has z-encoding: " <+> (has_z `pcntOf` entries)
810 ])
811 -- we usually get more "has z-encoding" than "z-encoded", because
812 -- when we z-encode a string it might hash to the exact same string,
813 -- which is not counted as "z-encoded". Only strings whose
814 -- Z-encoding is different from the original string are counted in
815 -- the "z-encoded" total.
816 putMsg dflags msg
817 where
818 x `pcntOf` y = int ((x * 100) `quot` y) Outputable.<> char '%'
819
820 countFS :: Int -> Int -> Int -> [[FastString]] -> (Int, Int, Int)
821 countFS entries longest has_z [] = (entries, longest, has_z)
822 countFS entries longest has_z (b:bs) =
823 let
824 len = length b
825 longest' = max len longest
826 entries' = entries + len
827 has_zs = length (filter hasZEncoding b)
828 in
829 countFS entries' longest' (has_z + has_zs) bs
830
831 showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO ()
832 showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags))
833 dumpPackages dflags = putMsg dflags (pprPackages dflags)
834 dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags)
835
836 -- -----------------------------------------------------------------------------
837 -- Frontend plugin support
838
839 doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
840 #if !defined(GHCI)
841 doFrontend modname _ = pluginError [modname]
842 #else
843 doFrontend modname srcs = do
844 hsc_env <- getSession
845 frontend_plugin <- liftIO $ loadFrontendPlugin hsc_env modname
846 frontend frontend_plugin
847 (reverse $ frontendPluginOpts (hsc_dflags hsc_env)) srcs
848 #endif
849
850 -- -----------------------------------------------------------------------------
851 -- ABI hash support
852
853 {-
854 ghc --abi-hash Data.Foo System.Bar
855
856 Generates a combined hash of the ABI for modules Data.Foo and
857 System.Bar. The modules must already be compiled, and appropriate -i
858 options may be necessary in order to find the .hi files.
859
860 This is used by Cabal for generating the ComponentId for a
861 package. The ComponentId must change when the visible ABI of
862 the package chagnes, so during registration Cabal calls ghc --abi-hash
863 to get a hash of the package's ABI.
864 -}
865
866 -- | Print ABI hash of input modules.
867 --
868 -- The resulting hash is the MD5 of the GHC version used (Trac #5328,
869 -- see 'hiVersion') and of the existing ABI hash from each module (see
870 -- 'mi_mod_hash').
871 abiHash :: [String] -- ^ List of module names
872 -> Ghc ()
873 abiHash strs = do
874 hsc_env <- getSession
875 let dflags = hsc_dflags hsc_env
876
877 liftIO $ do
878
879 let find_it str = do
880 let modname = mkModuleName str
881 r <- findImportedModule hsc_env modname Nothing
882 case r of
883 Found _ m -> return m
884 _error -> throwGhcException $ CmdLineError $ showSDoc dflags $
885 cannotFindModule dflags modname r
886
887 mods <- mapM find_it strs
888
889 let get_iface modl = loadUserInterface False (text "abiHash") modl
890 ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
891
892 bh <- openBinMem (3*1024) -- just less than a block
893 put_ bh hiVersion
894 -- package hashes change when the compiler version changes (for now)
895 -- see #5328
896 mapM_ (put_ bh . mi_mod_hash) ifaces
897 f <- fingerprintBinMem bh
898
899 putStrLn (showPpr dflags f)
900
901 -- -----------------------------------------------------------------------------
902 -- Util
903
904 unknownFlagsErr :: [String] -> a
905 unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
906 where
907 oneError f =
908 "unrecognised flag: " ++ f ++ "\n" ++
909 (case match f (nubSort allNonDeprecatedFlags) of
910 [] -> ""
911 suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs))
912 -- fixes #11789
913 -- If the flag contains '=',
914 -- this uses both the whole and the left side of '=' for comparing.
915 match f allFlags
916 | elem '=' f =
917 let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags
918 fName = takeWhile (/= '=') f
919 in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq)
920 | otherwise = fuzzyMatch f allFlags
921
922 {- Note [-Bsymbolic and hooks]
923 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
924 -Bsymbolic is a flag that prevents the binding of references to global
925 symbols to symbols outside the shared library being compiled (see `man
926 ld`). When dynamically linking, we don't use -Bsymbolic on the RTS
927 package: that is because we want hooks to be overridden by the user,
928 we don't want to constrain them to the RTS package.
929
930 Unfortunately this seems to have broken somehow on OS X: as a result,
931 defaultHooks (in hschooks.c) is not called, which does not initialize
932 the GC stats. As a result, this breaks things like `:set +s` in GHCi
933 (#8754). As a hacky workaround, we instead call 'defaultHooks'
934 directly to initalize the flags in the RTS.
935
936 A byproduct of this, I believe, is that hooks are likely broken on OS
937 X when dynamically linking. But this probably doesn't affect most
938 people since we're linking GHC dynamically, but most things themselves
939 link statically.
940 -}
941
942 foreign import ccall safe "initGCStatistics"
943 initGCStatistics :: IO ()