Improve suggestion for misspelled flag including '=' (fixes #11789)
[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 #ifdef GHCI
29 import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings )
30 #endif
31
32 -- Frontend plugins
33 #ifdef 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 StaticFlags
50 import DynFlags
51 import ErrUtils
52 import FastString
53 import Outputable
54 import SrcLoc
55 import Util
56 import Panic
57 import UniqSupply
58 import MonadUtils ( liftIO )
59
60 -- Imports for --abi-hash
61 import LoadIface ( loadUserInterface )
62 import Module ( mkModuleName )
63 import Finder ( findImportedModule, cannotFindModule )
64 import TcRnMonad ( initIfaceCheck )
65 import Binary ( openBinMem, put_ )
66 import BinFingerprint ( fingerprintBinMem )
67
68 -- Standard Haskell libraries
69 import System.IO
70 import System.Environment
71 import System.Exit
72 import System.FilePath
73 import Control.Monad
74 import Data.Char
75 import Data.List
76 import Data.Maybe
77
78 -----------------------------------------------------------------------------
79 -- ToDo:
80
81 -- time commands when run with -v
82 -- user ways
83 -- Win32 support: proper signal handling
84 -- reading the package configuration file is too slow
85 -- -K<size>
86
87 -----------------------------------------------------------------------------
88 -- GHC's command-line interface
89
90 main :: IO ()
91 main = do
92 initGCStatistics -- See Note [-Bsymbolic and hooks]
93 hSetBuffering stdout LineBuffering
94 hSetBuffering stderr LineBuffering
95
96 -- Handle GHC-specific character encoding flags, allowing us to control how
97 -- GHC produces output regardless of OS.
98 env <- getEnvironment
99 case lookup "GHC_CHARENC" env of
100 Just "UTF-8" -> do
101 hSetEncoding stdout utf8
102 hSetEncoding stderr utf8
103 _ -> do
104 -- Avoid GHC erroring out when trying to display unhandled characters
105 hSetTranslit stdout
106 hSetTranslit stderr
107
108 GHC.defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
109 -- 1. extract the -B flag from the args
110 argv0 <- getArgs
111
112 let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
113 mbMinusB | null minusB_args = Nothing
114 | otherwise = Just (drop 2 (last minusB_args))
115
116 let argv1' = map (mkGeneralLocated "on the commandline") argv1
117 (argv2, staticFlagWarnings) <- parseStaticFlags argv1'
118
119 -- 2. Parse the "mode" flags (--make, --interactive etc.)
120 (mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
121
122 let flagWarnings = staticFlagWarnings ++ modeFlagWarnings
123
124 -- If all we want to do is something like showing the version number
125 -- then do it now, before we start a GHC session etc. This makes
126 -- getting basic information much more resilient.
127
128 -- In particular, if we wait until later before giving the version
129 -- number then bootstrapping gets confused, as it tries to find out
130 -- what version of GHC it's using before package.conf exists, so
131 -- starting the session fails.
132 case mode of
133 Left preStartupMode ->
134 do case preStartupMode of
135 ShowSupportedExtensions -> showSupportedExtensions
136 ShowVersion -> showVersion
137 ShowNumVersion -> putStrLn cProjectVersion
138 ShowOptions isInteractive -> showOptions isInteractive
139 Right postStartupMode ->
140 -- start our GHC session
141 GHC.runGhc mbMinusB $ do
142
143 dflags <- GHC.getSessionDynFlags
144
145 case postStartupMode of
146 Left preLoadMode ->
147 liftIO $ do
148 case preLoadMode of
149 ShowInfo -> showInfo dflags
150 ShowGhcUsage -> showGhcUsage dflags
151 ShowGhciUsage -> showGhciUsage dflags
152 PrintWithDynFlags f -> putStrLn (f dflags)
153 Right postLoadMode ->
154 main' postLoadMode dflags argv3 flagWarnings
155
156 main' :: PostLoadMode -> DynFlags -> [Located String] -> [Located String]
157 -> Ghc ()
158 main' postLoadMode dflags0 args flagWarnings = do
159 -- set the default GhcMode, HscTarget and GhcLink. The HscTarget
160 -- can be further adjusted on a module by module basis, using only
161 -- the -fvia-C and -fasm flags. If the default HscTarget is not
162 -- HscC or HscAsm, -fvia-C and -fasm have no effect.
163 let dflt_target = hscTarget dflags0
164 (mode, lang, link)
165 = case postLoadMode of
166 DoInteractive -> (CompManager, HscInterpreted, LinkInMemory)
167 DoEval _ -> (CompManager, HscInterpreted, LinkInMemory)
168 DoMake -> (CompManager, dflt_target, LinkBinary)
169 DoBackpack _ -> (CompManager, dflt_target, LinkBinary)
170 DoMkDependHS -> (MkDepend, dflt_target, LinkBinary)
171 DoAbiHash -> (OneShot, dflt_target, LinkBinary)
172 _ -> (OneShot, dflt_target, LinkBinary)
173
174 let dflags1 = dflags0{ ghcMode = mode,
175 hscTarget = lang,
176 ghcLink = link,
177 verbosity = case postLoadMode of
178 DoEval _ -> 0
179 _other -> 1
180 }
181
182 -- turn on -fimplicit-import-qualified for GHCi now, so that it
183 -- can be overriden from the command-line
184 -- XXX: this should really be in the interactive DynFlags, but
185 -- we don't set that until later in interactiveUI
186 dflags2 | DoInteractive <- postLoadMode = imp_qual_enabled
187 | DoEval _ <- postLoadMode = imp_qual_enabled
188 | otherwise = dflags1
189 where imp_qual_enabled = dflags1 `gopt_set` Opt_ImplicitImportQualified
190
191 -- The rest of the arguments are "dynamic"
192 -- Leftover ones are presumably files
193 (dflags3, fileish_args, dynamicFlagWarnings) <-
194 GHC.parseDynamicFlags dflags2 args
195
196 let dflags4 = case lang of
197 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
198 let platform = targetPlatform dflags3
199 dflags3a = updateWays $ dflags3 { ways = interpWays }
200 dflags3b = foldl gopt_set dflags3a
201 $ concatMap (wayGeneralFlags platform)
202 interpWays
203 dflags3c = foldl gopt_unset dflags3b
204 $ concatMap (wayUnsetGeneralFlags platform)
205 interpWays
206 in dflags3c
207 _ ->
208 dflags3
209
210 GHC.prettyPrintGhcErrors dflags4 $ do
211
212 let flagWarnings' = flagWarnings ++ dynamicFlagWarnings
213
214 handleSourceError (\e -> do
215 GHC.printException e
216 liftIO $ exitWith (ExitFailure 1)) $ do
217 liftIO $ handleFlagWarnings dflags4 flagWarnings'
218
219 liftIO $ showBanner postLoadMode dflags4
220
221 let
222 -- To simplify the handling of filepaths, we normalise all filepaths right
223 -- away - e.g., for win32 platforms, backslashes are converted
224 -- into forward slashes.
225 normal_fileish_paths = map (normalise . unLoc) fileish_args
226 (srcs, objs) = partition_args normal_fileish_paths [] []
227
228 dflags5 = dflags4 { ldInputs = map (FileOption "") objs
229 ++ ldInputs dflags4 }
230
231 -- we've finished manipulating the DynFlags, update the session
232 _ <- GHC.setSessionDynFlags dflags5
233 dflags6 <- GHC.getSessionDynFlags
234 hsc_env <- GHC.getSession
235
236 ---------------- Display configuration -----------
237 case verbosity dflags6 of
238 v | v == 4 -> liftIO $ dumpPackagesSimple dflags6
239 | v >= 5 -> liftIO $ dumpPackages dflags6
240 | otherwise -> return ()
241
242 when (verbosity dflags6 >= 3) $ do
243 liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags)
244
245
246 liftIO $ initUniqSupply (initialUnique dflags6) (uniqueIncrement dflags6)
247 ---------------- Final sanity checking -----------
248 liftIO $ checkOptions postLoadMode dflags6 srcs objs
249
250 ---------------- Do the business -----------
251 handleSourceError (\e -> do
252 GHC.printException e
253 liftIO $ exitWith (ExitFailure 1)) $ do
254 case postLoadMode of
255 ShowInterface f -> liftIO $ doShowIface dflags6 f
256 DoMake -> doMake srcs
257 DoMkDependHS -> doMkDependHS (map fst srcs)
258 StopBefore p -> liftIO (oneShot hsc_env p srcs)
259 DoInteractive -> ghciUI srcs Nothing
260 DoEval exprs -> ghciUI srcs $ Just $ reverse exprs
261 DoAbiHash -> abiHash (map fst srcs)
262 ShowPackages -> liftIO $ showPackages dflags6
263 DoFrontend f -> doFrontend f srcs
264 DoBackpack b -> doBackpack b
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 | DoBackpack String -- ghc --backpack foo.bkp
467 | DoInteractive -- ghc --interactive
468 | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
469 | DoAbiHash -- ghc --abi-hash
470 | ShowPackages -- ghc --show-packages
471 | DoFrontend ModuleName -- ghc --frontend Plugin.Module
472
473 doMkDependHSMode, doMakeMode, doInteractiveMode,
474 doAbiHashMode, showPackagesMode :: Mode
475 doMkDependHSMode = mkPostLoadMode DoMkDependHS
476 doMakeMode = mkPostLoadMode DoMake
477 doInteractiveMode = mkPostLoadMode DoInteractive
478 doAbiHashMode = mkPostLoadMode DoAbiHash
479 showPackagesMode = mkPostLoadMode ShowPackages
480
481 showInterfaceMode :: FilePath -> Mode
482 showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
483
484 stopBeforeMode :: Phase -> Mode
485 stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
486
487 doEvalMode :: String -> Mode
488 doEvalMode str = mkPostLoadMode (DoEval [str])
489
490 doFrontendMode :: String -> Mode
491 doFrontendMode str = mkPostLoadMode (DoFrontend (mkModuleName str))
492
493 doBackpackMode :: String -> Mode
494 doBackpackMode str = mkPostLoadMode (DoBackpack str)
495
496 mkPostLoadMode :: PostLoadMode -> Mode
497 mkPostLoadMode = Right . Right
498
499 isDoInteractiveMode :: Mode -> Bool
500 isDoInteractiveMode (Right (Right DoInteractive)) = True
501 isDoInteractiveMode _ = False
502
503 isStopLnMode :: Mode -> Bool
504 isStopLnMode (Right (Right (StopBefore StopLn))) = True
505 isStopLnMode _ = False
506
507 isDoMakeMode :: Mode -> Bool
508 isDoMakeMode (Right (Right DoMake)) = True
509 isDoMakeMode _ = False
510
511 isDoEvalMode :: Mode -> Bool
512 isDoEvalMode (Right (Right (DoEval _))) = True
513 isDoEvalMode _ = False
514
515 #ifdef GHCI
516 isInteractiveMode :: PostLoadMode -> Bool
517 isInteractiveMode DoInteractive = True
518 isInteractiveMode _ = False
519 #endif
520
521 -- isInterpretiveMode: byte-code compiler involved
522 isInterpretiveMode :: PostLoadMode -> Bool
523 isInterpretiveMode DoInteractive = True
524 isInterpretiveMode (DoEval _) = True
525 isInterpretiveMode _ = False
526
527 needsInputsMode :: PostLoadMode -> Bool
528 needsInputsMode DoMkDependHS = True
529 needsInputsMode (StopBefore _) = True
530 needsInputsMode DoMake = True
531 needsInputsMode _ = False
532
533 -- True if we are going to attempt to link in this mode.
534 -- (we might not actually link, depending on the GhcLink flag)
535 isLinkMode :: PostLoadMode -> Bool
536 isLinkMode (StopBefore StopLn) = True
537 isLinkMode DoMake = True
538 isLinkMode DoInteractive = True
539 isLinkMode (DoEval _) = True
540 isLinkMode _ = False
541
542 isCompManagerMode :: PostLoadMode -> Bool
543 isCompManagerMode DoMake = True
544 isCompManagerMode DoInteractive = True
545 isCompManagerMode (DoEval _) = True
546 isCompManagerMode _ = False
547
548 -- -----------------------------------------------------------------------------
549 -- Parsing the mode flag
550
551 parseModeFlags :: [Located String]
552 -> IO (Mode,
553 [Located String],
554 [Located String])
555 parseModeFlags args = do
556 let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =
557 runCmdLine (processArgs mode_flags args)
558 (Nothing, [], [])
559 mode = case mModeFlag of
560 Nothing -> doMakeMode
561 Just (m, _) -> m
562
563 -- See Note [Handling errors when parsing commandline flags]
564 unless (null errs1 && null errs2) $ throwGhcException $ errorsToGhcException $
565 map (("on the commandline", )) $ map unLoc errs1 ++ errs2
566
567 return (mode, flags' ++ leftover, warns)
568
569 type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
570 -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
571 -- so we collect the new ones and return them.
572
573 mode_flags :: [Flag ModeM]
574 mode_flags =
575 [ ------- help / version ----------------------------------------------
576 defFlag "?" (PassFlag (setMode showGhcUsageMode))
577 , defFlag "-help" (PassFlag (setMode showGhcUsageMode))
578 , defFlag "V" (PassFlag (setMode showVersionMode))
579 , defFlag "-version" (PassFlag (setMode showVersionMode))
580 , defFlag "-numeric-version" (PassFlag (setMode showNumVersionMode))
581 , defFlag "-info" (PassFlag (setMode showInfoMode))
582 , defFlag "-show-options" (PassFlag (setMode showOptionsMode))
583 , defFlag "-supported-languages" (PassFlag (setMode showSupportedExtensionsMode))
584 , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
585 , defFlag "-show-packages" (PassFlag (setMode showPackagesMode))
586 ] ++
587 [ defFlag k' (PassFlag (setMode (printSetting k)))
588 | k <- ["Project version",
589 "Project Git commit id",
590 "Booter version",
591 "Stage",
592 "Build platform",
593 "Host platform",
594 "Target platform",
595 "Have interpreter",
596 "Object splitting supported",
597 "Have native code generator",
598 "Support SMP",
599 "Unregisterised",
600 "Tables next to code",
601 "RTS ways",
602 "Leading underscore",
603 "Debug on",
604 "LibDir",
605 "Global Package DB",
606 "C compiler flags",
607 "C compiler link flags",
608 "ld flags"],
609 let k' = "-print-" ++ map (replaceSpace . toLower) k
610 replaceSpace ' ' = '-'
611 replaceSpace c = c
612 ] ++
613 ------- interfaces ----------------------------------------------------
614 [ defFlag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
615 "--show-iface"))
616
617 ------- primary modes ------------------------------------------------
618 , defFlag "c" (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
619 addFlag "-no-link" f))
620 , defFlag "M" (PassFlag (setMode doMkDependHSMode))
621 , defFlag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
622 , defFlag "C" (PassFlag (setMode (stopBeforeMode HCc)))
623 , defFlag "S" (PassFlag (setMode (stopBeforeMode (As False))))
624 , defFlag "-make" (PassFlag (setMode doMakeMode))
625 , defFlag "-backpack" (SepArg (\s -> setMode (doBackpackMode s) "-backpack"))
626 , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
627 , defFlag "-abi-hash" (PassFlag (setMode doAbiHashMode))
628 , defFlag "e" (SepArg (\s -> setMode (doEvalMode s) "-e"))
629 , defFlag "-frontend" (SepArg (\s -> setMode (doFrontendMode s) "-frontend"))
630 ]
631
632 setMode :: Mode -> String -> EwM ModeM ()
633 setMode newMode newFlag = liftEwM $ do
634 (mModeFlag, errs, flags') <- getCmdLineState
635 let (modeFlag', errs') =
636 case mModeFlag of
637 Nothing -> ((newMode, newFlag), errs)
638 Just (oldMode, oldFlag) ->
639 case (oldMode, newMode) of
640 -- -c/--make are allowed together, and mean --make -no-link
641 _ | isStopLnMode oldMode && isDoMakeMode newMode
642 || isStopLnMode newMode && isDoMakeMode oldMode ->
643 ((doMakeMode, "--make"), [])
644
645 -- If we have both --help and --interactive then we
646 -- want showGhciUsage
647 _ | isShowGhcUsageMode oldMode &&
648 isDoInteractiveMode newMode ->
649 ((showGhciUsageMode, oldFlag), [])
650 | isShowGhcUsageMode newMode &&
651 isDoInteractiveMode oldMode ->
652 ((showGhciUsageMode, newFlag), [])
653
654 -- If we have both -e and --interactive then -e always wins
655 _ | isDoEvalMode oldMode &&
656 isDoInteractiveMode newMode ->
657 ((oldMode, oldFlag), [])
658 | isDoEvalMode newMode &&
659 isDoInteractiveMode oldMode ->
660 ((newMode, newFlag), [])
661
662 -- Otherwise, --help/--version/--numeric-version always win
663 | isDominantFlag oldMode -> ((oldMode, oldFlag), [])
664 | isDominantFlag newMode -> ((newMode, newFlag), [])
665 -- We need to accumulate eval flags like "-e foo -e bar"
666 (Right (Right (DoEval esOld)),
667 Right (Right (DoEval [eNew]))) ->
668 ((Right (Right (DoEval (eNew : esOld))), oldFlag),
669 errs)
670 -- Saying e.g. --interactive --interactive is OK
671 _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
672
673 -- --interactive and --show-options are used together
674 (Right (Right DoInteractive), Left (ShowOptions _)) ->
675 ((Left (ShowOptions True),
676 "--interactive --show-options"), errs)
677 (Left (ShowOptions _), (Right (Right DoInteractive))) ->
678 ((Left (ShowOptions True),
679 "--show-options --interactive"), errs)
680 -- Otherwise, complain
681 _ -> let err = flagMismatchErr oldFlag newFlag
682 in ((oldMode, oldFlag), err : errs)
683 putCmdLineState (Just modeFlag', errs', flags')
684 where isDominantFlag f = isShowGhcUsageMode f ||
685 isShowGhciUsageMode f ||
686 isShowVersionMode f ||
687 isShowNumVersionMode f
688
689 flagMismatchErr :: String -> String -> String
690 flagMismatchErr oldFlag newFlag
691 = "cannot use `" ++ oldFlag ++ "' with `" ++ newFlag ++ "'"
692
693 addFlag :: String -> String -> EwM ModeM ()
694 addFlag s flag = liftEwM $ do
695 (m, e, flags') <- getCmdLineState
696 putCmdLineState (m, e, mkGeneralLocated loc s : flags')
697 where loc = "addFlag by " ++ flag ++ " on the commandline"
698
699 -- ----------------------------------------------------------------------------
700 -- Run --make mode
701
702 doMake :: [(String,Maybe Phase)] -> Ghc ()
703 doMake srcs = do
704 let (hs_srcs, non_hs_srcs) = partition isHaskellishTarget srcs
705
706 hsc_env <- GHC.getSession
707
708 -- if we have no haskell sources from which to do a dependency
709 -- analysis, then just do one-shot compilation and/or linking.
710 -- This means that "ghc Foo.o Bar.o -o baz" links the program as
711 -- we expect.
712 if (null hs_srcs)
713 then liftIO (oneShot hsc_env StopLn srcs)
714 else do
715
716 o_files <- mapM (\x -> liftIO $ compileFile hsc_env StopLn x)
717 non_hs_srcs
718 dflags <- GHC.getSessionDynFlags
719 let dflags' = dflags { ldInputs = map (FileOption "") o_files
720 ++ ldInputs dflags }
721 _ <- GHC.setSessionDynFlags dflags'
722
723 targets <- mapM (uncurry GHC.guessTarget) hs_srcs
724 GHC.setTargets targets
725 ok_flag <- GHC.load LoadAllTargets
726
727 when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
728 return ()
729
730
731 -- ---------------------------------------------------------------------------
732 -- --show-iface mode
733
734 doShowIface :: DynFlags -> FilePath -> IO ()
735 doShowIface dflags file = do
736 hsc_env <- newHscEnv dflags
737 showIface hsc_env file
738
739 -- ---------------------------------------------------------------------------
740 -- Various banners and verbosity output.
741
742 showBanner :: PostLoadMode -> DynFlags -> IO ()
743 showBanner _postLoadMode dflags = do
744 let verb = verbosity dflags
745
746 #ifdef GHCI
747 -- Show the GHCi banner
748 when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
749 #endif
750
751 -- Display details of the configuration in verbose mode
752 when (verb >= 2) $
753 do hPutStr stderr "Glasgow Haskell Compiler, Version "
754 hPutStr stderr cProjectVersion
755 hPutStr stderr ", stage "
756 hPutStr stderr cStage
757 hPutStr stderr " booted by GHC version "
758 hPutStrLn stderr cBooterVersion
759
760 -- We print out a Read-friendly string, but a prettier one than the
761 -- Show instance gives us
762 showInfo :: DynFlags -> IO ()
763 showInfo dflags = do
764 let sq x = " [" ++ x ++ "\n ]"
765 putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
766
767 showSupportedExtensions :: IO ()
768 showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
769
770 showVersion :: IO ()
771 showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
772
773 showOptions :: Bool -> IO ()
774 showOptions isInteractive = putStr (unlines availableOptions)
775 where
776 availableOptions = concat [
777 flagsForCompletion isInteractive,
778 map ('-':) (concat [
779 getFlagNames mode_flags
780 , (filterUnwantedStatic . getFlagNames $ flagsStatic)
781 , flagsStaticNames
782 ])
783 ]
784 getFlagNames opts = map flagName opts
785 -- this is a hack to get rid of two unwanted entries that get listed
786 -- as static flags. Hopefully this hack will disappear one day together
787 -- with static flags
788 filterUnwantedStatic = filter (`notElem`["f", "fno-"])
789
790 showGhcUsage :: DynFlags -> IO ()
791 showGhcUsage = showUsage False
792
793 showGhciUsage :: DynFlags -> IO ()
794 showGhciUsage = showUsage True
795
796 showUsage :: Bool -> DynFlags -> IO ()
797 showUsage ghci dflags = do
798 let usage_path = if ghci then ghciUsagePath dflags
799 else ghcUsagePath dflags
800 usage <- readFile usage_path
801 dump usage
802 where
803 dump "" = return ()
804 dump ('$':'$':s) = putStr progName >> dump s
805 dump (c:s) = putChar c >> dump s
806
807 dumpFinalStats :: DynFlags -> IO ()
808 dumpFinalStats dflags =
809 when (gopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
810
811 dumpFastStringStats :: DynFlags -> IO ()
812 dumpFastStringStats dflags = do
813 buckets <- getFastStringTable
814 let (entries, longest, has_z) = countFS 0 0 0 buckets
815 msg = text "FastString stats:" $$
816 nest 4 (vcat [text "size: " <+> int (length buckets),
817 text "entries: " <+> int entries,
818 text "longest chain: " <+> int longest,
819 text "has z-encoding: " <+> (has_z `pcntOf` entries)
820 ])
821 -- we usually get more "has z-encoding" than "z-encoded", because
822 -- when we z-encode a string it might hash to the exact same string,
823 -- which will is not counted as "z-encoded". Only strings whose
824 -- Z-encoding is different from the original string are counted in
825 -- the "z-encoded" total.
826 putMsg dflags msg
827 where
828 x `pcntOf` y = int ((x * 100) `quot` y) <> char '%'
829
830 countFS :: Int -> Int -> Int -> [[FastString]] -> (Int, Int, Int)
831 countFS entries longest has_z [] = (entries, longest, has_z)
832 countFS entries longest has_z (b:bs) =
833 let
834 len = length b
835 longest' = max len longest
836 entries' = entries + len
837 has_zs = length (filter hasZEncoding b)
838 in
839 countFS entries' longest' (has_z + has_zs) bs
840
841 showPackages, dumpPackages, dumpPackagesSimple :: DynFlags -> IO ()
842 showPackages dflags = putStrLn (showSDoc dflags (pprPackages dflags))
843 dumpPackages dflags = putMsg dflags (pprPackages dflags)
844 dumpPackagesSimple dflags = putMsg dflags (pprPackagesSimple dflags)
845
846 -- -----------------------------------------------------------------------------
847 -- Frontend plugin support
848
849 doFrontend :: ModuleName -> [(String, Maybe Phase)] -> Ghc ()
850 #ifndef GHCI
851 doFrontend modname _ = pluginError [modname]
852 #else
853 doFrontend modname srcs = do
854 hsc_env <- getSession
855 frontend_plugin <- liftIO $ loadFrontendPlugin hsc_env modname
856 frontend frontend_plugin (frontendPluginOpts (hsc_dflags hsc_env)) srcs
857 #endif
858
859 -- -----------------------------------------------------------------------------
860 -- ABI hash support
861
862 {-
863 ghc --abi-hash Data.Foo System.Bar
864
865 Generates a combined hash of the ABI for modules Data.Foo and
866 System.Bar. The modules must already be compiled, and appropriate -i
867 options may be necessary in order to find the .hi files.
868
869 This is used by Cabal for generating the ComponentId for a
870 package. The ComponentId must change when the visible ABI of
871 the package chagnes, so during registration Cabal calls ghc --abi-hash
872 to get a hash of the package's ABI.
873 -}
874
875 -- | Print ABI hash of input modules.
876 --
877 -- The resulting hash is the MD5 of the GHC version used (Trac #5328,
878 -- see 'hiVersion') and of the existing ABI hash from each module (see
879 -- 'mi_mod_hash').
880 abiHash :: [String] -- ^ List of module names
881 -> Ghc ()
882 abiHash strs = do
883 hsc_env <- getSession
884 let dflags = hsc_dflags hsc_env
885
886 liftIO $ do
887
888 let find_it str = do
889 let modname = mkModuleName str
890 r <- findImportedModule hsc_env modname Nothing
891 case r of
892 Found _ m -> return m
893 _error -> throwGhcException $ CmdLineError $ showSDoc dflags $
894 cannotFindModule dflags modname r
895
896 mods <- mapM find_it strs
897
898 let get_iface modl = loadUserInterface False (text "abiHash") modl
899 ifaces <- initIfaceCheck (text "abiHash") hsc_env $ mapM get_iface mods
900
901 bh <- openBinMem (3*1024) -- just less than a block
902 put_ bh hiVersion
903 -- package hashes change when the compiler version changes (for now)
904 -- see #5328
905 mapM_ (put_ bh . mi_mod_hash) ifaces
906 f <- fingerprintBinMem bh
907
908 putStrLn (showPpr dflags f)
909
910 -- -----------------------------------------------------------------------------
911 -- Util
912
913 unknownFlagsErr :: [String] -> a
914 unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs
915 where
916 oneError f =
917 "unrecognised flag: " ++ f ++ "\n" ++
918 (case match f (nubSort allNonDeprecatedFlags) of
919 [] -> ""
920 suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs))
921 -- fixes #11789
922 -- If the flag contains '=',
923 -- this uses both the whole and the left side of '=' for comparing.
924 match f allFlags
925 | elem '=' f =
926 let (flagsWithEq, flagsWithoutEq) = partition (elem '=') allFlags
927 fName = takeWhile (/= '=') f
928 in (fuzzyMatch f flagsWithEq) ++ (fuzzyMatch fName flagsWithoutEq)
929 | otherwise = fuzzyMatch f allFlags
930
931 {- Note [-Bsymbolic and hooks]
932 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
933 -Bsymbolic is a flag that prevents the binding of references to global
934 symbols to symbols outside the shared library being compiled (see `man
935 ld`). When dynamically linking, we don't use -Bsymbolic on the RTS
936 package: that is because we want hooks to be overridden by the user,
937 we don't want to constrain them to the RTS package.
938
939 Unfortunately this seems to have broken somehow on OS X: as a result,
940 defaultHooks (in hschooks.c) is not called, which does not initialize
941 the GC stats. As a result, this breaks things like `:set +s` in GHCi
942 (#8754). As a hacky workaround, we instead call 'defaultHooks'
943 directly to initalize the flags in the RTS.
944
945 A byproduct of this, I believe, is that hooks are likely broken on OS
946 X when dynamically linking. But this probably doesn't affect most
947 people since we're linking GHC dynamically, but most things themselves
948 link statically.
949 -}
950
951 foreign import ccall safe "initGCStatistics"
952 initGCStatistics :: IO ()