1 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
3 -----------------------------------------------------------------------------
7 -- (c) The University of Glasgow 2005
9 -----------------------------------------------------------------------------
11 module Main (main) where
13 -- The official GHC API
15 import GHC ( -- DynFlags(..), HscTarget(..),
16 -- GhcMode(..), GhcLink(..),
17 LoadHowMuch(..), -- dopt, DynFlag(..),
21 -- Implementations of the various modes (--show-iface, mkdependHS. etc.)
22 import LoadIface ( showIface )
23 import HscMain ( newHscEnv )
24 import DriverPipeline ( oneShot, compileFile )
25 import DriverMkDepend ( doMkDependHS )
27 import InteractiveUI ( interactiveUI, ghciWelcomeMsg )
31 -- Various other random stuff that we need
34 import Packages ( dumpPackages )
35 import DriverPhases ( Phase(..), isSourceFilename, anyHsc,
36 startPhase, isHaskellSrcFilename )
37 import BasicTypes ( failed )
39 import StaticFlagParser
47 -- import MonadUtils ( liftIO )
49 -- Imports for --abi-hash
50 import LoadIface ( loadUserInterface )
51 import Module ( mkModuleName )
52 import Finder ( findImportedModule, cannotFindInterface )
53 import TcRnMonad ( initIfaceCheck )
54 import Binary ( openBinMem, put_, fingerprintBinMem )
56 -- Standard Haskell libraries
58 import System.Environment
60 import System.FilePath
66 -----------------------------------------------------------------------------
69 -- time commands when run with -v
71 -- Win32 support: proper signal handling
72 -- reading the package configuration file is too slow
75 -----------------------------------------------------------------------------
76 -- GHC's command-line interface
80 GHC.defaultErrorHandler defaultDynFlags $ do
81 -- 1. extract the -B flag from the args
84 let (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
85 mbMinusB | null minusB_args = Nothing
86 | otherwise = Just (drop 2 (last minusB_args))
88 let argv1' = map (mkGeneralLocated "on the commandline") argv1
89 (argv2, staticFlagWarnings) <- parseStaticFlags argv1'
91 -- 2. Parse the "mode" flags (--make, --interactive etc.)
92 (mode, argv3, modeFlagWarnings) <- parseModeFlags argv2
94 let flagWarnings = staticFlagWarnings ++ modeFlagWarnings
96 -- If all we want to do is something like showing the version number
97 -- then do it now, before we start a GHC session etc. This makes
98 -- getting basic information much more resilient.
100 -- In particular, if we wait until later before giving the version
101 -- number then bootstrapping gets confused, as it tries to find out
102 -- what version of GHC it's using before package.conf exists, so
103 -- starting the session fails.
105 Left preStartupMode ->
106 do case preStartupMode of
107 ShowSupportedLanguages -> showSupportedLanguages
108 ShowVersion -> showVersion
109 ShowNumVersion -> putStrLn cProjectVersion
110 Print str -> putStrLn str
111 Right postStartupMode ->
112 -- start our GHC session
113 GHC.runGhc mbMinusB $ do
115 dflags <- GHC.getSessionDynFlags
117 case postStartupMode of
121 ShowInfo -> showInfo dflags
122 ShowGhcUsage -> showGhcUsage dflags
123 ShowGhciUsage -> showGhciUsage dflags
124 PrintWithDynFlags f -> putStrLn (f dflags)
125 Right postLoadMode ->
126 main' postLoadMode dflags argv3 flagWarnings
128 main' :: PostLoadMode -> DynFlags -> [Located String] -> [Located String]
130 main' postLoadMode dflags0 args flagWarnings = do
131 -- set the default GhcMode, HscTarget and GhcLink. The HscTarget
132 -- can be further adjusted on a module by module basis, using only
133 -- the -fvia-C and -fasm flags. If the default HscTarget is not
134 -- HscC or HscAsm, -fvia-C and -fasm have no effect.
135 let dflt_target = hscTarget dflags0
137 = case postLoadMode of
138 DoInteractive -> (CompManager, HscInterpreted, LinkInMemory)
139 DoEval _ -> (CompManager, HscInterpreted, LinkInMemory)
140 DoMake -> (CompManager, dflt_target, LinkBinary)
141 DoMkDependHS -> (MkDepend, dflt_target, LinkBinary)
142 DoAbiHash -> (OneShot, dflt_target, LinkBinary)
143 _ -> (OneShot, dflt_target, LinkBinary)
145 let dflags1 = dflags0{ ghcMode = mode,
148 -- leave out hscOutName for now
149 hscOutName = panic "Main.main:hscOutName not set",
150 verbosity = case postLoadMode of
155 -- turn on -fimplicit-import-qualified for GHCi now, so that it
156 -- can be overriden from the command-line
157 dflags1a | DoInteractive <- postLoadMode = imp_qual_enabled
158 | DoEval _ <- postLoadMode = imp_qual_enabled
159 | otherwise = dflags1
160 where imp_qual_enabled = dflags1 `dopt_set` Opt_ImplicitImportQualified
162 -- The rest of the arguments are "dynamic"
163 -- Leftover ones are presumably files
164 (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1a args
166 let flagWarnings' = flagWarnings ++ dynamicFlagWarnings
168 handleSourceError (\e -> do
169 GHC.printExceptionAndWarnings e
170 liftIO $ exitWith (ExitFailure 1)) $
171 handleFlagWarnings dflags2 flagWarnings'
173 -- make sure we clean up after ourselves
174 GHC.defaultCleanupHandler dflags2 $ do
176 liftIO $ showBanner postLoadMode dflags2
178 -- we've finished manipulating the DynFlags, update the session
179 _ <- GHC.setSessionDynFlags dflags2
180 dflags3 <- GHC.getSessionDynFlags
181 hsc_env <- GHC.getSession
184 -- To simplify the handling of filepaths, we normalise all filepaths right
185 -- away - e.g., for win32 platforms, backslashes are converted
186 -- into forward slashes.
187 normal_fileish_paths = map (normalise . unLoc) fileish_args
188 (srcs, objs) = partition_args normal_fileish_paths [] []
190 -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
192 liftIO $ mapM_ (consIORef v_Ld_inputs) (reverse objs)
194 ---------------- Display configuration -----------
195 when (verbosity dflags3 >= 4) $
196 liftIO $ dumpPackages dflags3
198 when (verbosity dflags3 >= 3) $ do
199 liftIO $ hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags)
201 ---------------- Final sanity checking -----------
202 liftIO $ checkOptions postLoadMode dflags3 srcs objs
204 ---------------- Do the business -----------
205 handleSourceError (\e -> do
206 GHC.printExceptionAndWarnings e
207 liftIO $ exitWith (ExitFailure 1)) $ do
209 ShowInterface f -> liftIO $ doShowIface dflags3 f
210 DoMake -> doMake srcs
211 DoMkDependHS -> doMkDependHS (map fst srcs)
212 StopBefore p -> oneShot hsc_env p srcs >> GHC.printWarnings
213 DoInteractive -> interactiveUI srcs Nothing
214 DoEval exprs -> interactiveUI srcs $ Just $ reverse exprs
215 DoAbiHash -> abiHash srcs
217 liftIO $ dumpFinalStats dflags3
220 interactiveUI :: b -> c -> Ghc ()
222 ghcError (CmdLineError "not built for interactive use")
225 -- -----------------------------------------------------------------------------
226 -- Splitting arguments into source files and object files. This is where we
227 -- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
228 -- file indicating the phase specified by the -x option in force, if any.
230 partition_args :: [String] -> [(String, Maybe Phase)] -> [String]
231 -> ([(String, Maybe Phase)], [String])
232 partition_args [] srcs objs = (reverse srcs, reverse objs)
233 partition_args ("-x":suff:args) srcs objs
234 | "none" <- suff = partition_args args srcs objs
235 | StopLn <- phase = partition_args args srcs (slurp ++ objs)
236 | otherwise = partition_args rest (these_srcs ++ srcs) objs
237 where phase = startPhase suff
238 (slurp,rest) = break (== "-x") args
239 these_srcs = zip slurp (repeat (Just phase))
240 partition_args (arg:args) srcs objs
241 | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
242 | otherwise = partition_args args srcs (arg:objs)
245 We split out the object files (.o, .dll) and add them
246 to v_Ld_inputs for use by the linker.
248 The following things should be considered compilation manager inputs:
250 - haskell source files (strings ending in .hs, .lhs or other
251 haskellish extension),
253 - module names (not forgetting hierarchical module names),
255 - and finally we consider everything not containing a '.' to be
256 a comp manager input, as shorthand for a .hs or .lhs filename.
258 Everything else is considered to be a linker object, and passed
259 straight through to the linker.
261 looks_like_an_input :: String -> Bool
262 looks_like_an_input m = isSourceFilename m
263 || looksLikeModuleName m
266 -- -----------------------------------------------------------------------------
267 -- Option sanity checks
269 -- | Ensure sanity of options.
271 -- Throws 'UsageError' or 'CmdLineError' if not.
272 checkOptions :: PostLoadMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
273 -- Final sanity checking before kicking off a compilation (pipeline).
274 checkOptions mode dflags srcs objs = do
275 -- Complain about any unknown flags
276 let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
277 when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
279 when (notNull (filter isRTSWay (wayNames dflags))
280 && isInterpretiveMode mode) $
281 hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
283 -- -prof and --interactive are not a good combination
284 when (notNull (filter (not . isRTSWay) (wayNames dflags))
285 && isInterpretiveMode mode) $
286 do ghcError (UsageError
287 "--interactive can't be used with -prof or -unreg.")
289 if (isJust (outputHi dflags) &&
290 (isCompManagerMode mode || srcs `lengthExceeds` 1))
291 then ghcError (UsageError "-ohi can only be used when compiling a single source file")
294 -- -o sanity checking
295 if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
296 && not (isLinkMode mode))
297 then ghcError (UsageError "can't apply -o to multiple source files")
300 let not_linking = not (isLinkMode mode) || isNoLink (ghcLink dflags)
302 when (not_linking && not (null objs)) $
303 hPutStrLn stderr ("Warning: the following files would be used as linker inputs, but linking is not being done: " ++ unwords objs)
305 -- Check that there are some input files
306 -- (except in the interactive case)
307 if null srcs && (null objs || not_linking) && needsInputsMode mode
308 then ghcError (UsageError "no input files")
311 -- Verify that output files point somewhere sensible.
312 verifyOutputFiles dflags
315 -- Compiler output options
317 -- called to verify that the output files & directories
318 -- point somewhere valid.
320 -- The assumption is that the directory portion of these output
321 -- options will have to exist by the time 'verifyOutputFiles'
324 verifyOutputFiles :: DynFlags -> IO ()
325 verifyOutputFiles dflags = do
326 -- not -odir: we create the directory for -odir if it doesn't exist (#2278).
327 let ofile = outputFile dflags
328 when (isJust ofile) $ do
329 let fn = fromJust ofile
330 flg <- doesDirNameExist fn
331 when (not flg) (nonExistentDir "-o" fn)
332 let ohi = outputHi dflags
333 when (isJust ohi) $ do
334 let hi = fromJust ohi
335 flg <- doesDirNameExist hi
336 when (not flg) (nonExistentDir "-ohi" hi)
338 nonExistentDir flg dir =
339 ghcError (CmdLineError ("error: directory portion of " ++
340 show dir ++ " does not exist (used with " ++
341 show flg ++ " option.)"))
343 -----------------------------------------------------------------------------
344 -- GHC modes of operation
346 type Mode = Either PreStartupMode PostStartupMode
347 type PostStartupMode = Either PreLoadMode PostLoadMode
350 = ShowVersion -- ghc -V/--version
351 | ShowNumVersion -- ghc --numeric-version
352 | ShowSupportedLanguages -- ghc --supported-languages
353 | Print String -- ghc --print-foo
355 showVersionMode, showNumVersionMode, showSupportedLanguagesMode :: Mode
356 showVersionMode = mkPreStartupMode ShowVersion
357 showNumVersionMode = mkPreStartupMode ShowNumVersion
358 showSupportedLanguagesMode = mkPreStartupMode ShowSupportedLanguages
360 printMode :: String -> Mode
361 printMode str = mkPreStartupMode (Print str)
363 mkPreStartupMode :: PreStartupMode -> Mode
364 mkPreStartupMode = Left
366 isShowVersionMode :: Mode -> Bool
367 isShowVersionMode (Left ShowVersion) = True
368 isShowVersionMode _ = False
370 isShowNumVersionMode :: Mode -> Bool
371 isShowNumVersionMode (Left ShowNumVersion) = True
372 isShowNumVersionMode _ = False
375 = ShowGhcUsage -- ghc -?
376 | ShowGhciUsage -- ghci -?
377 | ShowInfo -- ghc --info
378 | PrintWithDynFlags (DynFlags -> String) -- ghc --print-foo
380 showGhcUsageMode, showGhciUsageMode, showInfoMode :: Mode
381 showGhcUsageMode = mkPreLoadMode ShowGhcUsage
382 showGhciUsageMode = mkPreLoadMode ShowGhciUsage
383 showInfoMode = mkPreLoadMode ShowInfo
385 printWithDynFlagsMode :: (DynFlags -> String) -> Mode
386 printWithDynFlagsMode f = mkPreLoadMode (PrintWithDynFlags f)
388 mkPreLoadMode :: PreLoadMode -> Mode
389 mkPreLoadMode = Right . Left
391 isShowGhcUsageMode :: Mode -> Bool
392 isShowGhcUsageMode (Right (Left ShowGhcUsage)) = True
393 isShowGhcUsageMode _ = False
395 isShowGhciUsageMode :: Mode -> Bool
396 isShowGhciUsageMode (Right (Left ShowGhciUsage)) = True
397 isShowGhciUsageMode _ = False
400 = ShowInterface FilePath -- ghc --show-iface
401 | DoMkDependHS -- ghc -M
402 | StopBefore Phase -- ghc -E | -C | -S
403 -- StopBefore StopLn is the default
404 | DoMake -- ghc --make
405 | DoInteractive -- ghc --interactive
406 | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
407 | DoAbiHash -- ghc --abi-hash
409 doMkDependHSMode, doMakeMode, doInteractiveMode, doAbiHashMode :: Mode
410 doMkDependHSMode = mkPostLoadMode DoMkDependHS
411 doMakeMode = mkPostLoadMode DoMake
412 doInteractiveMode = mkPostLoadMode DoInteractive
413 doAbiHashMode = mkPostLoadMode DoAbiHash
415 showInterfaceMode :: FilePath -> Mode
416 showInterfaceMode fp = mkPostLoadMode (ShowInterface fp)
418 stopBeforeMode :: Phase -> Mode
419 stopBeforeMode phase = mkPostLoadMode (StopBefore phase)
421 doEvalMode :: String -> Mode
422 doEvalMode str = mkPostLoadMode (DoEval [str])
424 mkPostLoadMode :: PostLoadMode -> Mode
425 mkPostLoadMode = Right . Right
427 isDoInteractiveMode :: Mode -> Bool
428 isDoInteractiveMode (Right (Right DoInteractive)) = True
429 isDoInteractiveMode _ = False
432 isInteractiveMode :: PostLoadMode -> Bool
433 isInteractiveMode DoInteractive = True
434 isInteractiveMode _ = False
437 -- isInterpretiveMode: byte-code compiler involved
438 isInterpretiveMode :: PostLoadMode -> Bool
439 isInterpretiveMode DoInteractive = True
440 isInterpretiveMode (DoEval _) = True
441 isInterpretiveMode _ = False
443 needsInputsMode :: PostLoadMode -> Bool
444 needsInputsMode DoMkDependHS = True
445 needsInputsMode (StopBefore _) = True
446 needsInputsMode DoMake = True
447 needsInputsMode _ = False
449 -- True if we are going to attempt to link in this mode.
450 -- (we might not actually link, depending on the GhcLink flag)
451 isLinkMode :: PostLoadMode -> Bool
452 isLinkMode (StopBefore StopLn) = True
453 isLinkMode DoMake = True
454 isLinkMode DoInteractive = True
455 isLinkMode (DoEval _) = True
458 isCompManagerMode :: PostLoadMode -> Bool
459 isCompManagerMode DoMake = True
460 isCompManagerMode DoInteractive = True
461 isCompManagerMode (DoEval _) = True
462 isCompManagerMode _ = False
465 -- -----------------------------------------------------------------------------
466 -- Parsing the mode flag
468 parseModeFlags :: [Located String]
472 parseModeFlags args = do
473 let ((leftover, errs1, warns), (mModeFlag, errs2, flags')) =
474 runCmdLine (processArgs mode_flags args)
476 mode = case mModeFlag of
477 Nothing -> stopBeforeMode StopLn
479 errs = errs1 ++ map (mkGeneralLocated "on the commandline") errs2
480 when (not (null errs)) $ ghcError $ errorsToGhcException errs
481 return (mode, flags' ++ leftover, warns)
483 type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
484 -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
485 -- so we collect the new ones and return them.
487 mode_flags :: [Flag ModeM]
489 [ ------- help / version ----------------------------------------------
490 Flag "?" (PassFlag (setMode showGhcUsageMode))
492 , Flag "-help" (PassFlag (setMode showGhcUsageMode))
494 , Flag "V" (PassFlag (setMode showVersionMode))
496 , Flag "-version" (PassFlag (setMode showVersionMode))
498 , Flag "-numeric-version" (PassFlag (setMode showNumVersionMode))
500 , Flag "-info" (PassFlag (setMode showInfoMode))
502 , Flag "-supported-languages" (PassFlag (setMode showSupportedLanguagesMode))
505 [ Flag k' (PassFlag (setMode mode))
507 | (k, v) <- compilerInfo,
508 let k' = "-print-" ++ map (replaceSpace . toLower) k
509 replaceSpace ' ' = '-'
512 String str -> printMode str
513 FromDynFlags f -> printWithDynFlagsMode f
515 ------- interfaces ----------------------------------------------------
516 [ Flag "-show-iface" (HasArg (\f -> setMode (showInterfaceMode f)
520 ------- primary modes ------------------------------------------------
521 , Flag "M" (PassFlag (setMode doMkDependHSMode))
523 , Flag "E" (PassFlag (setMode (stopBeforeMode anyHsc)))
525 , Flag "C" (PassFlag (\f -> do setMode (stopBeforeMode HCc) f
526 addFlag "-fvia-C" f))
528 , Flag "S" (PassFlag (setMode (stopBeforeMode As)))
530 , Flag "-make" (PassFlag (setMode doMakeMode))
532 , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
534 , Flag "-abi-hash" (PassFlag (setMode doAbiHashMode))
536 , Flag "e" (HasArg (\s -> setMode (doEvalMode s) "-e"))
539 -- -fno-code says to stop after Hsc but don't generate any code.
540 , Flag "fno-code" (PassFlag (\f -> do setMode (stopBeforeMode HCc) f
541 addFlag "-fno-code" f
542 addFlag "-fforce-recomp" f))
546 setMode :: Mode -> String -> ModeM ()
547 setMode newMode newFlag = do
548 (mModeFlag, errs, flags') <- getCmdLineState
549 let (modeFlag', errs') =
551 Nothing -> ((newMode, newFlag), errs)
552 Just (oldMode, oldFlag) ->
553 case (oldMode, newMode) of
554 -- If we have both --help and --interactive then we
555 -- want showGhciUsage
556 _ | isShowGhcUsageMode oldMode &&
557 isDoInteractiveMode newMode ->
558 ((showGhciUsageMode, oldFlag), [])
559 | isShowGhcUsageMode newMode &&
560 isDoInteractiveMode oldMode ->
561 ((showGhciUsageMode, newFlag), [])
562 -- Otherwise, --help/--version/--numeric-version always win
563 | isDominantFlag oldMode -> ((oldMode, oldFlag), [])
564 | isDominantFlag newMode -> ((newMode, newFlag), [])
565 -- We need to accumulate eval flags like "-e foo -e bar"
566 (Right (Right (DoEval esOld)),
567 Right (Right (DoEval [eNew]))) ->
568 ((Right (Right (DoEval (eNew : esOld))), oldFlag),
570 -- Saying e.g. --interactive --interactive is OK
571 _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
572 -- Otherwise, complain
573 _ -> let err = flagMismatchErr oldFlag newFlag
574 in ((oldMode, oldFlag), err : errs)
575 putCmdLineState (Just modeFlag', errs', flags')
576 where isDominantFlag f = isShowGhcUsageMode f ||
577 isShowGhciUsageMode f ||
578 isShowVersionMode f ||
579 isShowNumVersionMode f
581 flagMismatchErr :: String -> String -> String
582 flagMismatchErr oldFlag newFlag
583 = "cannot use `" ++ oldFlag ++ "' with `" ++ newFlag ++ "'"
585 addFlag :: String -> String -> ModeM ()
587 (m, e, flags') <- getCmdLineState
588 putCmdLineState (m, e, mkGeneralLocated loc s : flags')
589 where loc = "addFlag by " ++ flag ++ " on the commandline"
591 -- ----------------------------------------------------------------------------
594 doMake :: [(String,Maybe Phase)] -> Ghc ()
595 doMake [] = ghcError (UsageError "no input files")
597 let (hs_srcs, non_hs_srcs) = partition haskellish srcs
599 haskellish (f,Nothing) =
600 looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
601 haskellish (_,Just phase) =
602 phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
604 hsc_env <- GHC.getSession
605 o_files <- mapM (\x -> do
606 f <- compileFile hsc_env StopLn x
610 liftIO $ mapM_ (consIORef v_Ld_inputs) (reverse o_files)
612 targets <- mapM (uncurry GHC.guessTarget) hs_srcs
613 GHC.setTargets targets
614 ok_flag <- GHC.load LoadAllTargets
616 when (failed ok_flag) (liftIO $ exitWith (ExitFailure 1))
620 -- ---------------------------------------------------------------------------
623 doShowIface :: DynFlags -> FilePath -> IO ()
624 doShowIface dflags file = do
625 hsc_env <- newHscEnv defaultCallbacks dflags
626 showIface hsc_env file
628 -- ---------------------------------------------------------------------------
629 -- Various banners and verbosity output.
631 showBanner :: PostLoadMode -> DynFlags -> IO ()
632 showBanner _postLoadMode dflags = do
633 let verb = verbosity dflags
636 -- Show the GHCi banner
637 when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg
640 -- Display details of the configuration in verbose mode
642 do hPutStr stderr "Glasgow Haskell Compiler, Version "
643 hPutStr stderr cProjectVersion
644 hPutStr stderr ", for Haskell 98, stage "
645 hPutStr stderr cStage
646 hPutStr stderr " booted by GHC version "
647 hPutStrLn stderr cBooterVersion
649 -- We print out a Read-friendly string, but a prettier one than the
650 -- Show instance gives us
651 showInfo :: DynFlags -> IO ()
653 let sq x = " [" ++ x ++ "\n ]"
654 putStrLn $ sq $ concat $ intersperse "\n ," $ map (show . flatten) compilerInfo
655 where flatten (k, String v) = (k, v)
656 flatten (k, FromDynFlags f) = (k, f dflags)
658 showSupportedLanguages :: IO ()
659 showSupportedLanguages = mapM_ putStrLn supportedLanguages
662 showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
664 showGhcUsage :: DynFlags -> IO ()
665 showGhcUsage = showUsage False
667 showGhciUsage :: DynFlags -> IO ()
668 showGhciUsage = showUsage True
670 showUsage :: Bool -> DynFlags -> IO ()
671 showUsage ghci dflags = do
672 let usage_path = if ghci then ghciUsagePath dflags
673 else ghcUsagePath dflags
674 usage <- readFile usage_path
678 dump ('$':'$':s) = putStr progName >> dump s
679 dump (c:s) = putChar c >> dump s
681 dumpFinalStats :: DynFlags -> IO ()
682 dumpFinalStats dflags =
683 when (dopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
685 dumpFastStringStats :: DynFlags -> IO ()
686 dumpFastStringStats dflags = do
687 buckets <- getFastStringTable
688 let (entries, longest, is_z, has_z) = countFS 0 0 0 0 buckets
689 msg = text "FastString stats:" $$
690 nest 4 (vcat [text "size: " <+> int (length buckets),
691 text "entries: " <+> int entries,
692 text "longest chain: " <+> int longest,
693 text "z-encoded: " <+> (is_z `pcntOf` entries),
694 text "has z-encoding: " <+> (has_z `pcntOf` entries)
696 -- we usually get more "has z-encoding" than "z-encoded", because
697 -- when we z-encode a string it might hash to the exact same string,
698 -- which will is not counted as "z-encoded". Only strings whose
699 -- Z-encoding is different from the original string are counted in
700 -- the "z-encoded" total.
703 x `pcntOf` y = int ((x * 100) `quot` y) <> char '%'
705 countFS :: Int -> Int -> Int -> Int -> [[FastString]] -> (Int, Int, Int, Int)
706 countFS entries longest is_z has_z [] = (entries, longest, is_z, has_z)
707 countFS entries longest is_z has_z (b:bs) =
710 longest' = max len longest
711 entries' = entries + len
712 is_zs = length (filter isZEncoded b)
713 has_zs = length (filter hasZEncoding b)
715 countFS entries' longest' (is_z + is_zs) (has_z + has_zs) bs
717 -- -----------------------------------------------------------------------------
721 ghc --abi-hash Data.Foo System.Bar
723 Generates a combined hash of the ABI for modules Data.Foo and
724 System.Bar. The modules must already be compiled, and appropriate -i
725 options may be necessary in order to find the .hi files.
727 This is used by Cabal for generating the InstalledPackageId for a
728 package. The InstalledPackageId must change when the visible ABI of
729 the package chagnes, so during registration Cabal calls ghc --abi-hash
730 to get a hash of the package's ABI.
733 abiHash :: [(String, Maybe Phase)] -> Ghc ()
735 hsc_env <- getSession
736 let dflags = hsc_dflags hsc_env
741 let modname = mkModuleName str
742 r <- findImportedModule hsc_env modname Nothing
744 Found _ m -> return m
745 _error -> ghcError $ CmdLineError $ showSDoc $
746 cannotFindInterface dflags modname r
748 mods <- mapM find_it (map fst strs)
750 let get_iface modl = loadUserInterface False (text "abiHash") modl
751 ifaces <- initIfaceCheck hsc_env $ mapM get_iface mods
753 bh <- openBinMem (3*1024) -- just less than a block
754 mapM_ (put_ bh . mi_mod_hash) ifaces
755 f <- fingerprintBinMem bh
757 putStrLn (showSDoc (ppr f))
759 -- -----------------------------------------------------------------------------
762 unknownFlagsErr :: [String] -> a
763 unknownFlagsErr fs = ghcError (UsageError ("unrecognised flags: " ++ unwords fs))