{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
+
-----------------------------------------------------------------------------
--
-- GHC Driver program
--
-----------------------------------------------------------------------------
-{-# 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
-
module Main (main) where
#include "HsVersions.h"
import DynFlags
import BasicTypes ( failed )
import ErrUtils ( putMsg )
-import FastString ( getFastStringTable, isZEncoded, hasZEncoding )
+import FastString
import Outputable
import Util
import Panic
import System.Directory ( doesDirectoryExist )
import System.Environment
import System.Exit
+import System.FilePath
import Control.Monad
import Data.List
import Data.Maybe
-----------------------------------------------------------------------------
-- GHC's command-line interface
+main :: IO ()
main =
GHC.defaultErrorHandler defaultDynFlags $ do
exitWith ExitSuccess
ShowSupportedLanguages -> do showSupportedLanguages
exitWith ExitSuccess
- ShowDocDir -> do showDocDir
- exitWith ExitSuccess
ShowVersion -> do showVersion
exitWith ExitSuccess
ShowNumVersion -> do putStrLn cProjectVersion
-- 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
ShowUsage -> showGhcUsage dflags cli_mode
PrintLibdir -> putStrLn (topDir dflags)
ShowSupportedLanguages -> alreadyHandled
- ShowDocDir -> alreadyHandled
ShowVersion -> alreadyHandled
ShowNumVersion -> alreadyHandled
ShowInterface f -> doShowIface dflags f
DoMkDependHS -> doMkDependHS session (map fst srcs)
StopBefore p -> oneShot dflags p srcs
DoInteractive -> interactiveUI session srcs Nothing
- DoEval expr -> interactiveUI session srcs (Just expr)
+ DoEval exprs -> interactiveUI session srcs $ Just $ reverse exprs
dumpFinalStats dflags
exitWith ExitSuccess
#ifndef GHCI
+interactiveUI :: a -> b -> c -> IO ()
interactiveUI _ _ _ =
throwDyn (CmdLineError "not built for interactive use")
#endif
-- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
-- file indicating the phase specified by the -x option in force, if any.
+partition_args :: [String] -> [(String, Maybe Phase)] -> [String]
+ -> ([(String, Maybe Phase)], [String])
partition_args [] srcs objs = (reverse srcs, reverse objs)
partition_args ("-x":suff:args) srcs objs
| "none" <- suff = partition_args args srcs objs
Everything else is considered to be a linker object, and passed
straight through to the linker.
-}
+looks_like_an_input :: String -> Bool
looks_like_an_input m = isSourceFilename m
|| looksLikeModuleName m
|| '.' `notElem` m
data CmdLineMode
= ShowUsage -- ghc -?
| PrintLibdir -- ghc --print-libdir
- | ShowDocDir -- ghc --print-docdir
| ShowInfo -- ghc --info
| ShowSupportedLanguages -- ghc --supported-languages
| ShowVersion -- ghc -V/--version
-- StopBefore StopLn is the default
| DoMake -- ghc --make
| DoInteractive -- ghc --interactive
- | DoEval String -- ghc -e
+ | DoEval [String] -- ghc -e foo -e bar => DoEval ["bar", "foo"]
deriving (Show)
-isInteractiveMode, isInterpretiveMode :: CmdLineMode -> Bool
-isLinkMode, isCompManagerMode :: CmdLineMode -> Bool
-
+#ifdef GHCI
+isInteractiveMode :: CmdLineMode -> Bool
isInteractiveMode DoInteractive = True
isInteractiveMode _ = False
+#endif
-- isInterpretiveMode: byte-code compiler involved
+isInterpretiveMode :: CmdLineMode -> Bool
isInterpretiveMode DoInteractive = True
isInterpretiveMode (DoEval _) = True
isInterpretiveMode _ = False
+needsInputsMode :: CmdLineMode -> Bool
needsInputsMode DoMkDependHS = True
needsInputsMode (StopBefore _) = True
needsInputsMode DoMake = True
-- True if we are going to attempt to link in this mode.
-- (we might not actually link, depending on the GhcLink flag)
+isLinkMode :: CmdLineMode -> Bool
isLinkMode (StopBefore StopLn) = True
isLinkMode DoMake = True
isLinkMode _ = False
+isCompManagerMode :: CmdLineMode -> Bool
isCompManagerMode DoMake = True
isCompManagerMode DoInteractive = True
isCompManagerMode (DoEval _) = True
( "?" , PassFlag (setMode ShowUsage))
, ( "-help" , PassFlag (setMode ShowUsage))
, ( "-print-libdir" , PassFlag (setMode PrintLibdir))
- , ( "-print-docdir" , PassFlag (setMode ShowDocDir))
, ( "V" , PassFlag (setMode ShowVersion))
, ( "-version" , PassFlag (setMode ShowVersion))
, ( "-numeric-version" , PassFlag (setMode ShowNumVersion))
------- 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))
- , ( "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"))
+ , ( "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 -> updateMode (updateDoEval 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"))
]
setMode :: CmdLineMode -> String -> ModeM ()
-setMode m flag = do
+setMode m flag = updateMode (\_ -> m) flag
+
+updateDoEval :: String -> CmdLineMode -> CmdLineMode
+updateDoEval expr (DoEval exprs) = DoEval (expr : exprs)
+updateDoEval expr _ = DoEval [expr]
+
+updateMode :: (CmdLineMode -> CmdLineMode) -> String -> ModeM ()
+updateMode f 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 (f old_mode, flag, flags)
addFlag :: String -> ModeM ()
addFlag s = do
-- Run --make mode
doMake :: Session -> [(String,Maybe Phase)] -> IO ()
-doMake sess [] = throwDyn (UsageError "no input files")
+doMake _ [] = throwDyn (UsageError "no input files")
doMake sess srcs = do
let (hs_srcs, non_hs_srcs) = partition haskellish srcs
haskellish (f,Nothing) =
looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
- haskellish (f,Just phase) =
+ haskellish (_,Just phase) =
phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
dflags <- GHC.getSessionDynFlags sess
-- Various banners and verbosity output.
showBanner :: CmdLineMode -> DynFlags -> IO ()
-showBanner cli_mode dflags = do
+showBanner _cli_mode dflags = do
let verb = verbosity dflags
#ifdef GHCI
-- Show the GHCi banner
- when (isInteractiveMode cli_mode && verb >= 1) $ putStrLn ghciWelcomeMsg
+ when (isInteractiveMode _cli_mode && verb >= 1) $ putStrLn ghciWelcomeMsg
#endif
-- Display details of the configuration in verbose mode
showSupportedLanguages = do mapM_ putStrLn supportedLanguages
exitWith ExitSuccess
-showDocDir :: IO ()
-showDocDir = do
- putStrLn cDocDir
- exitWith ExitSuccess
-
showVersion :: IO ()
showVersion = do
putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
exitWith ExitSuccess
+showGhcUsage :: DynFlags -> CmdLineMode -> IO ()
showGhcUsage dflags cli_mode = do
let usage_path
| DoInteractive <- cli_mode = ghciUsagePath dflags
putMsg dflags msg
where
x `pcntOf` y = int ((x * 100) `quot` y) <> char '%'
-
+
+countFS :: Int -> Int -> Int -> Int -> [[FastString]] -> (Int, Int, Int, Int)
countFS entries longest is_z has_z [] = (entries, longest, is_z, has_z)
countFS entries longest is_z has_z (b:bs) =
let
projects / ghc-hetmet.git / blobdiff