{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- GHC Driver program
import DriverPipeline ( oneShot, compileFile )
import DriverMkDepend ( doMkDependHS )
#ifdef GHCI
-import InteractiveUI ( ghciWelcomeMsg, interactiveUI )
+import InteractiveUI ( interactiveUI, ghciWelcomeMsg )
#endif
-- Various other random stuff that we need
-import Config ( cProjectVersion, cBooterVersion, cProjectName )
+import Config
import Packages ( dumpPackages )
import DriverPhases ( Phase(..), isSourceFilename, anyHsc,
startPhase, isHaskellSrcFilename )
import StaticFlags
-import DynFlags ( defaultDynFlags )
+import DynFlags
import BasicTypes ( failed )
import ErrUtils ( putMsg )
import FastString ( getFastStringTable, isZEncoded, hasZEncoding )
import System.Directory ( doesDirectoryExist )
import System.Environment
import System.Exit
+import System.FilePath
import Control.Monad
import Data.List
import Data.Maybe
argv0 <- getArgs
let
- (minusB_args, argv1) = partition (prefixMatch "-B") argv0
+ (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0
mbMinusB | null minusB_args = Nothing
| otherwise = Just (drop 2 (last minusB_args))
-- to find out what version of GHC it's using before package.conf
-- exists, so starting the session fails.
case cli_mode of
- ShowVersion -> do showVersion
- exitWith ExitSuccess
- ShowNumVersion -> do putStrLn cProjectVersion
- exitWith ExitSuccess
- _ -> return ()
+ ShowInfo -> do showInfo
+ exitWith ExitSuccess
+ ShowSupportedLanguages -> do showSupportedLanguages
+ exitWith ExitSuccess
+ ShowVersion -> do showVersion
+ exitWith ExitSuccess
+ ShowNumVersion -> do putStrLn cProjectVersion
+ exitWith ExitSuccess
+ _ -> return ()
-- start our GHC session
session <- GHC.newSession mbMinusB
-- make sure we clean up after ourselves
GHC.defaultCleanupHandler dflags $ do
- -- Display banner
showBanner cli_mode dflags
-- we've finished manipulating the DynFlags, update the session
-- To simplify the handling of filepaths, we normalise all filepaths right
-- away - e.g., for win32 platforms, backslashes are converted
-- into forward slashes.
- normal_fileish_paths = map normalisePath fileish_args
+ normal_fileish_paths = map normalise fileish_args
(srcs, objs) = partition_args normal_fileish_paths [] []
-- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on
---------------- Final sanity checking -----------
checkOptions cli_mode dflags srcs objs
- ---------------- Do the business -----------
+ ---------------- Do the business -----------
+ let alreadyHandled = panic (show cli_mode ++
+ " should already have been handled")
case cli_mode of
- ShowUsage -> showGhcUsage dflags cli_mode
- PrintLibdir -> putStrLn (topDir dflags)
- ShowVersion -> panic "ShowVersion should already have been handled"
- ShowNumVersion -> panic "ShowNumVersion should already have been handled"
- ShowInterface f -> doShowIface dflags f
- DoMake -> doMake session srcs
- DoMkDependHS -> doMkDependHS session (map fst srcs)
- StopBefore p -> oneShot dflags p srcs
- DoInteractive -> interactiveUI session srcs Nothing
- DoEval expr -> interactiveUI session srcs (Just expr)
+ ShowUsage -> showGhcUsage dflags cli_mode
+ PrintLibdir -> putStrLn (topDir dflags)
+ ShowSupportedLanguages -> alreadyHandled
+ ShowVersion -> alreadyHandled
+ ShowNumVersion -> alreadyHandled
+ ShowInterface f -> doShowIface dflags f
+ DoMake -> doMake session srcs
+ DoMkDependHS -> doMkDependHS session (map fst srcs)
+ StopBefore p -> oneShot dflags p srcs
+ DoInteractive -> interactiveUI session srcs Nothing
+ DoEval expr -> interactiveUI session srcs (Just expr)
dumpFinalStats dflags
exitWith ExitSuccess
-- GHC modes of operation
data CmdLineMode
- = ShowUsage -- ghc -?
- | PrintLibdir -- ghc --print-libdir
- | ShowVersion -- ghc -V/--version
- | ShowNumVersion -- ghc --numeric-version
- | ShowInterface String -- ghc --show-iface
- | DoMkDependHS -- ghc -M
- | StopBefore Phase -- ghc -E | -C | -S
- -- StopBefore StopLn is the default
- | DoMake -- ghc --make
- | DoInteractive -- ghc --interactive
- | DoEval String -- ghc -e
+ = ShowUsage -- ghc -?
+ | PrintLibdir -- ghc --print-libdir
+ | ShowInfo -- ghc --info
+ | ShowSupportedLanguages -- ghc --supported-languages
+ | ShowVersion -- ghc -V/--version
+ | ShowNumVersion -- ghc --numeric-version
+ | ShowInterface String -- ghc --show-iface
+ | DoMkDependHS -- ghc -M
+ | StopBefore Phase -- ghc -E | -C | -S
+ -- StopBefore StopLn is the default
+ | DoMake -- ghc --make
+ | DoInteractive -- ghc --interactive
+ | DoEval String -- ghc -e
deriving (Show)
isInteractiveMode, isInterpretiveMode :: CmdLineMode -> Bool
mode_flags :: [(String, OptKind (CmdLineP (CmdLineMode, String, [String])))]
mode_flags =
[ ------- help / version ----------------------------------------------
- ( "?" , PassFlag (setMode ShowUsage))
- , ( "-help" , PassFlag (setMode ShowUsage))
- , ( "-print-libdir" , PassFlag (setMode PrintLibdir))
- , ( "V" , PassFlag (setMode ShowVersion))
- , ( "-version" , PassFlag (setMode ShowVersion))
- , ( "-numeric-version", PassFlag (setMode ShowNumVersion))
+ ( "?" , PassFlag (setMode ShowUsage))
+ , ( "-help" , PassFlag (setMode ShowUsage))
+ , ( "-print-libdir" , PassFlag (setMode PrintLibdir))
+ , ( "V" , PassFlag (setMode ShowVersion))
+ , ( "-version" , PassFlag (setMode ShowVersion))
+ , ( "-numeric-version" , PassFlag (setMode ShowNumVersion))
+ , ( "-info" , PassFlag (setMode ShowInfo))
+ , ( "-supported-languages", PassFlag (setMode ShowSupportedLanguages))
------- interfaces ----------------------------------------------------
, ( "-show-iface" , HasArg (\f -> setMode (ShowInterface f)
- "--show-iface"))
+ "--show-iface"))
------- primary modes ------------------------------------------------
- , ( "M" , PassFlag (setMode DoMkDependHS))
- , ( "E" , PassFlag (setMode (StopBefore anyHsc)))
- , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f
- addFlag "-fvia-C"))
- , ( "S" , PassFlag (setMode (StopBefore As)))
- , ( "-make" , PassFlag (setMode DoMake))
- , ( "-interactive" , PassFlag (setMode DoInteractive))
+ , ( "M" , PassFlag (setMode DoMkDependHS))
+ , ( "E" , PassFlag (setMode (StopBefore anyHsc)))
+ , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f
+ addFlag "-fvia-C"))
+ , ( "S" , PassFlag (setMode (StopBefore As)))
+ , ( "-make" , PassFlag (setMode DoMake))
+ , ( "-interactive" , PassFlag (setMode DoInteractive))
, ( "e" , HasArg (\s -> setMode (DoEval s) "-e"))
- -- -fno-code says to stop after Hsc but don't generate any code.
- , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f
- addFlag "-fno-code"
- addFlag "-no-recomp"))
+ -- -fno-code says to stop after Hsc but don't generate any code.
+ , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f
+ addFlag "-fno-code"
+ addFlag "-no-recomp"))
]
setMode :: CmdLineMode -> String -> ModeM ()
setMode m flag = do
(old_mode, old_flag, flags) <- getCmdLineState
- when (notNull old_flag && flag /= old_flag) $
- throwDyn (UsageError
- ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
- putCmdLineState (m, flag, flags)
+ if notNull old_flag && flag /= old_flag
+ then throwDyn (UsageError
+ ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
+ else putCmdLineState (m, flag, flags)
addFlag :: String -> ModeM ()
addFlag s = do
showBanner :: CmdLineMode -> DynFlags -> IO ()
showBanner cli_mode dflags = do
let verb = verbosity dflags
- -- Show the GHCi banner
-# ifdef GHCI
- when (isInteractiveMode cli_mode && verb >= 1) $
- hPutStrLn stdout ghciWelcomeMsg
-# endif
-
- -- Display details of the configuration in verbose mode
- when (not (isInteractiveMode cli_mode) && verb >= 2) $
- do hPutStr stderr "Glasgow Haskell Compiler, Version "
- hPutStr stderr cProjectVersion
- hPutStr stderr ", for Haskell 98, compiled by GHC version "
+
#ifdef GHCI
- -- GHCI is only set when we are bootstrapping...
- hPutStrLn stderr cProjectVersion
-#else
- hPutStrLn stderr cBooterVersion
+ -- Show the GHCi banner
+ when (isInteractiveMode cli_mode && verb >= 1) $ putStrLn ghciWelcomeMsg
#endif
+ -- Display details of the configuration in verbose mode
+ when (verb >= 2) $
+ do hPutStr stderr "Glasgow Haskell Compiler, Version "
+ hPutStr stderr cProjectVersion
+ hPutStr stderr ", for Haskell 98, stage "
+ hPutStr stderr cStage
+ hPutStr stderr " booted by GHC version "
+ hPutStrLn stderr cBooterVersion
+
+-- We print out a Read-friendly string, but a prettier one than the
+-- Show instance gives us
+showInfo :: IO ()
+showInfo = do
+ let sq x = " [" ++ x ++ "\n ]"
+ putStrLn $ sq $ concat $ intersperse "\n ," $ map show compilerInfo
+ exitWith ExitSuccess
+
+showSupportedLanguages :: IO ()
+showSupportedLanguages = do mapM_ putStrLn supportedLanguages
+ exitWith ExitSuccess
+
showVersion :: IO ()
showVersion = do
putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
showGhcUsage dflags cli_mode = do
let usage_path
- | DoInteractive <- cli_mode = ghcUsagePath dflags
- | otherwise = ghciUsagePath dflags
+ | DoInteractive <- cli_mode = ghciUsagePath dflags
+ | otherwise = ghcUsagePath dflags
usage <- readFile usage_path
dump usage
exitWith ExitSuccess
projects / ghc-hetmet.git / blobdiff