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