X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=b2db529e5738600026b764e7ee3210ba2f447f19;hb=58eba7cdb39ad4a9ddd23eeaf2bb76a561aa813d;hp=333b23072d1a4516456eb5018d46450571646699;hpb=51f8f0f50c1a709ed898d149f458f781279fa4c6;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 333b230..b2db529 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,18 +1,14 @@ -{-# OPTIONS -#include "hschooks.h" #-} - ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.69 2001/09/06 15:43:35 simonpj Exp $ -- -- Driver flags -- --- (c) Simon Marlow 2000 +-- (c) The University of Glasgow 2000-2003 -- ----------------------------------------------------------------------------- module DriverFlags ( processArgs, OptKind(..), static_flags, dynamic_flags, - getDynFlags, dynFlag, - getOpts, getVerbFlag, addCmdlineHCInclude, + addCmdlineHCInclude, buildStaticHscOpts, machdepCCOpts ) where @@ -20,18 +16,20 @@ module DriverFlags ( #include "HsVersions.h" #include "../includes/config.h" +import MkIface ( showIface ) import DriverState +import DriverPhases import DriverUtil -import SysTools ( setTmpDir, setPgm, setDryRun, showGhcUsage ) +import SysTools import CmdLineOpts import Config import Util import Panic -import Exception -import IOExts -import System ( exitWith, ExitCode(..) ) +import EXCEPTION +import DATA_IOREF ( readIORef, writeIORef ) +import System ( exitWith, ExitCode(..) ) import IO import Maybe import Monad @@ -95,7 +93,7 @@ processOneArg action rest (dash_arg@('-':arg):args) = if rest /= "" then fio rest >> return args else case args of - [] -> unknownFlagErr dash_arg + [] -> missingArgErr dash_arg (arg1:args1) -> fio arg1 >> return args1 SepArg fio -> @@ -128,7 +126,7 @@ findArg :: [(String,OptKind)] -> String -> Maybe (String,OptKind) findArg spec arg = case [ (remove_spaces rest, k) | (pat,k) <- spec, - Just rest <- [my_prefix_match pat arg], + Just rest <- [maybePrefixMatch pat arg], arg_ok k rest arg ] of [] -> Nothing @@ -137,8 +135,8 @@ findArg spec arg arg_ok (NoArg _) rest arg = null rest arg_ok (HasArg _) rest arg = True arg_ok (SepArg _) rest arg = null rest -arg_ok (Prefix _) rest arg = not (null rest) -arg_ok (PrefixPred p _) rest arg = not (null rest) && p rest +arg_ok (Prefix _) rest arg = notNull rest +arg_ok (PrefixPred p _) rest arg = notNull rest && p rest arg_ok (OptPrefix _) rest arg = True arg_ok (PassFlag _) rest arg = null rest arg_ok (AnySuffix _) rest arg = True @@ -152,21 +150,40 @@ arg_ok (AnySuffixPred p _) rest arg = p arg -- flags further down the list with the same prefix. static_flags = - [ ------- help ------------------------------------------------------- - ( "?" , NoArg showGhcUsage) - , ( "-help" , NoArg showGhcUsage) - - - ------- version ---------------------------------------------------- - , ( "-version" , NoArg (do hPutStrLn stdout (cProjectName - ++ ", version " ++ cProjectVersion) - exitWith ExitSuccess)) - , ( "-numeric-version", NoArg (do hPutStrLn stdout cProjectVersion + [ ------- help / version ---------------------------------------------- + ( "?" , NoArg showGhcUsage) + , ( "-help" , NoArg showGhcUsage) + , ( "-print-libdir" , NoArg (do getTopDir >>= putStrLn + exitWith ExitSuccess)) + , ( "V" , NoArg showVersion) + , ( "-version" , NoArg showVersion) + , ( "-numeric-version", NoArg (do putStrLn cProjectVersion exitWith ExitSuccess)) + ------- interfaces ---------------------------------------------------- + , ( "-show-iface" , HasArg (\f -> do showIface f + exitWith ExitSuccess)) + ------- verbosity ---------------------------------------------------- , ( "n" , NoArg setDryRun ) + ------- primary modes ------------------------------------------------ + , ( "M" , PassFlag (setMode DoMkDependHS)) + , ( "E" , PassFlag (setMode (StopBefore Hsc))) + , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f + setLang HscC)) + , ( "S" , PassFlag (setMode (StopBefore As))) + , ( "c" , PassFlag (setMode (StopBefore Ln))) + , ( "-make" , PassFlag (setMode DoMake)) + , ( "-interactive" , PassFlag (setMode DoInteractive)) + , ( "-mk-dll" , PassFlag (setMode DoMkDLL)) + , ( "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 + setLang HscNothing + writeIORef v_Recomp False)) + ------- GHCi ------------------------------------------------------- , ( "ignore-dot-ghci", NoArg (writeIORef v_Read_DotGHCi False) ) , ( "read-dot-ghci" , NoArg (writeIORef v_Read_DotGHCi True) ) @@ -183,6 +200,7 @@ static_flags = , ( "gransim" , NoArg (addNoDups v_Ways WayGran) ) , ( "smp" , NoArg (addNoDups v_Ways WaySMP) ) , ( "debug" , NoArg (addNoDups v_Ways WayDebug) ) + , ( "ndp" , NoArg (addNoDups v_Ways WayNDP) ) -- ToDo: user ways ------ Debugging ---------------------------------------------------- @@ -206,11 +224,12 @@ static_flags = ------- Miscellaneous ----------------------------------------------- , ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat , ( "no-hs-main" , NoArg (writeIORef v_NoHsMain True) ) + , ( "main-is" , SepArg setMainIs ) ------- Output Redirection ------------------------------------------ , ( "odir" , HasArg (writeIORef v_Output_dir . Just) ) , ( "o" , SepArg (writeIORef v_Output_file . Just) ) - , ( "osuf" , HasArg (writeIORef v_Object_suf . Just) ) + , ( "osuf" , HasArg (writeIORef v_Object_suf) ) , ( "hcsuf" , HasArg (writeIORef v_HC_suf . Just) ) , ( "hisuf" , HasArg (writeIORef v_Hi_suf) ) , ( "hidir" , HasArg (writeIORef v_Hi_dir . Just) ) @@ -222,13 +241,17 @@ static_flags = , ( "keep-hc-file" , AnySuffix (\_ -> writeIORef v_Keep_hc_files True) ) , ( "keep-s-file" , AnySuffix (\_ -> writeIORef v_Keep_s_files True) ) , ( "keep-raw-s-file", AnySuffix (\_ -> writeIORef v_Keep_raw_s_files True) ) +#ifdef ILX + , ( "keep-il-file" , AnySuffix (\_ -> writeIORef v_Keep_il_files True) ) + , ( "keep-ilx-file" , AnySuffix (\_ -> writeIORef v_Keep_ilx_files True) ) +#endif , ( "keep-tmp-files" , AnySuffix (\_ -> writeIORef v_Keep_tmp_files True) ) , ( "split-objs" , NoArg (if can_split then do writeIORef v_Split_object_files True add v_Opt_C "-fglobalise-toplev-names" else hPutStrLn stderr - "warning: don't know how to split \ + "warning: don't know how to split \ \object files on this architecture" ) ) @@ -238,8 +261,14 @@ static_flags = ------- Libraries --------------------------------------------------- , ( "L" , Prefix (addToDirList v_Library_paths) ) - , ( "l" , Prefix (add v_Cmdline_libraries) ) + , ( "l" , AnySuffix (\s -> add v_Opt_l s >> add v_Opt_dll s) ) +#ifdef darwin_TARGET_OS + ------- Frameworks -------------------------------------------------- + -- -framework-path should really be -F ... + , ( "framework-path" , HasArg (addToDirList v_Framework_paths) ) + , ( "framework" , HasArg (add v_Cmdline_frameworks) ) +#endif ------- Packages ---------------------------------------------------- , ( "package-name" , HasArg (\s -> add v_Opt_C ("-inpackage="++s)) ) @@ -248,13 +277,26 @@ static_flags = , ( "syslib" , HasArg (addPackage) ) -- for compatibility w/ old vsns ------- Specific phases -------------------------------------------- - , ( "pgm" , HasArg setPgm ) + , ( "pgmL" , HasArg setPgmL ) + , ( "pgmP" , HasArg setPgmP ) + , ( "pgmF" , HasArg setPgmF ) + , ( "pgmc" , HasArg setPgmc ) + , ( "pgmm" , HasArg setPgmm ) + , ( "pgms" , HasArg setPgms ) + , ( "pgma" , HasArg setPgma ) + , ( "pgml" , HasArg setPgml ) + , ( "pgmdll" , HasArg setPgmDLL ) +#ifdef ILX + , ( "pgmI" , HasArg setPgmI ) + , ( "pgmi" , HasArg setPgmi ) +#endif , ( "optdep" , HasArg (add v_Opt_dep) ) , ( "optl" , HasArg (add v_Opt_l) ) , ( "optdll" , HasArg (add v_Opt_dll) ) ----- Linker -------------------------------------------------------- + , ( "no-link" , NoArg (writeIORef v_NoLink True) ) , ( "static" , NoArg (writeIORef v_Static True) ) , ( "dynamic" , NoArg (writeIORef v_Static False) ) , ( "rdynamic" , NoArg (return ()) ) -- ignored for compat w/ gcc @@ -264,27 +306,11 @@ static_flags = , ( "Rghc-timing" , NoArg (enableTimingStats) ) ------ Compiler flags ----------------------------------------------- - , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) ) - , ( "O" , OptPrefix (setOptLevel) ) - , ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) ) - , ( "fmax-simplifier-iterations", - Prefix (writeIORef v_MaxSimplifierIterations . read) ) - - , ( "fusagesp" , NoArg (do writeIORef v_UsageSPInf True - add v_Opt_C "-fusagesp-on") ) - , ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True add v_Opt_C "-fexcess-precision")) - -- Optimisation flags are treated specially, so the normal - -- -fno-* pattern below doesn't work. We therefore allow - -- certain optimisation passes to be turned off explicitly: - , ( "fno-strictness" , NoArg (writeIORef v_Strictness False) ) - , ( "fno-cpr" , NoArg (writeIORef v_CPR False) ) - , ( "fno-cse" , NoArg (writeIORef v_CSE False) ) - -- All other "-fno-" options cancel out "-f" on the hsc cmdline , ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s)) (\s -> add v_Anti_opt_C ("-f"++s)) ) @@ -296,12 +322,14 @@ static_flags = dynamic_flags = [ ( "cpp", NoArg (updDynFlags (\s -> s{ cppFlag = True })) ) + , ( "F", NoArg (updDynFlags (\s -> s{ ppFlag = True })) ) , ( "#include", HasArg (addCmdlineHCInclude) ) , ( "v", OptPrefix (setVerbosity) ) , ( "optL", HasArg (addOpt_L) ) , ( "optP", HasArg (addOpt_P) ) + , ( "optF", HasArg (addOpt_F) ) , ( "optc", HasArg (addOpt_c) ) , ( "optm", HasArg (addOpt_m) ) , ( "opta", HasArg (addOpt_a) ) @@ -311,19 +339,8 @@ dynamic_flags = [ #endif ------ HsCpp opts --------------------------------------------------- - -- With a C compiler whose system() doesn't use a UNIX shell (i.e. - -- mingwin gcc), -D and -U args must *not* be quoted, as the quotes - -- will be interpreted as part of the arguments, and not stripped; - -- on all other systems, quoting is necessary, to avoid interpretation - -- of shell metacharacters in the arguments (e.g. green-card's - -- -DBEGIN_GHC_ONLY='}-' trick). -#ifndef mingw32_TARGET_OS - , ( "D", Prefix (\s -> addOpt_P ("-D'"++s++"'") ) ) - , ( "U", Prefix (\s -> addOpt_P ("-U'"++s++"'") ) ) -#else - , ( "D", Prefix (\s -> addOpt_P ("-D"++s) ) ) - , ( "U", Prefix (\s -> addOpt_P ("-U"++s) ) ) -#endif + , ( "D", AnySuffix addOpt_P ) + , ( "U", AnySuffix addOpt_P ) ------ Debugging ---------------------------------------------------- , ( "dstg-stats", NoArg (writeIORef v_StgStats True) ) @@ -343,18 +360,19 @@ dynamic_flags = [ , ( "ddump-simpl", NoArg (setDynFlag Opt_D_dump_simpl) ) , ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) ) , ( "ddump-spec", NoArg (setDynFlag Opt_D_dump_spec) ) - , ( "ddump-sat", NoArg (setDynFlag Opt_D_dump_sat) ) + , ( "ddump-prep", NoArg (setDynFlag Opt_D_dump_prep) ) , ( "ddump-stg", NoArg (setDynFlag Opt_D_dump_stg) ) , ( "ddump-stranal", NoArg (setDynFlag Opt_D_dump_stranal) ) , ( "ddump-tc", NoArg (setDynFlag Opt_D_dump_tc) ) , ( "ddump-types", NoArg (setDynFlag Opt_D_dump_types) ) , ( "ddump-rules", NoArg (setDynFlag Opt_D_dump_rules) ) - , ( "ddump-usagesp", NoArg (setDynFlag Opt_D_dump_usagesp) ) , ( "ddump-cse", NoArg (setDynFlag Opt_D_dump_cse) ) , ( "ddump-worker-wrapper", NoArg (setDynFlag Opt_D_dump_worker_wrapper) ) , ( "dshow-passes", NoArg (setVerbosity "2") ) , ( "ddump-rn-trace", NoArg (setDynFlag Opt_D_dump_rn_trace) ) + , ( "ddump-if-trace", NoArg (setDynFlag Opt_D_dump_if_trace) ) , ( "ddump-tc-trace", NoArg (setDynFlag Opt_D_dump_tc_trace) ) + , ( "ddump-splices", NoArg (setDynFlag Opt_D_dump_splices) ) , ( "ddump-rn-stats", NoArg (setDynFlag Opt_D_dump_rn_stats) ) , ( "ddump-stix", NoArg (setDynFlag Opt_D_dump_stix) ) , ( "ddump-simpl-stats", NoArg (setDynFlag Opt_D_dump_simpl_stats) ) @@ -365,9 +383,9 @@ dynamic_flags = [ , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs) ) , ( "ddump-hi", NoArg (setDynFlag Opt_D_dump_hi) ) , ( "ddump-minimal-imports", NoArg (setDynFlag Opt_D_dump_minimal_imports) ) + , ( "ddump-vect", NoArg (setDynFlag Opt_D_dump_vect) ) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting) ) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting) ) - , ( "dusagesp-lint", NoArg (setDynFlag Opt_DoUSPLinting) ) ------ Machine dependant (-m) stuff --------------------------- @@ -377,20 +395,38 @@ dynamic_flags = [ ------ Warning opts ------------------------------------------------- , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) ) + , ( "Werror" , NoArg (setDynFlag Opt_WarnIsError) ) , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) ) , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */ , ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) + ------ Optimisation flags ------------------------------------------ + , ( "O" , NoArg (setOptLevel 1)) + , ( "Onot" , NoArg (setOptLevel 0)) + , ( "O" , PrefixPred (all isDigit) (setOptLevel . read)) + + , ( "fmax-simplifier-iterations", + PrefixPred (all isDigit) + (\n -> updDynFlags (\dfs -> + dfs{ maxSimplIterations = read n })) ) + + , ( "frule-check", + SepArg (\s -> updDynFlags (\dfs -> dfs{ ruleCheck = Just s }))) + ------ Compiler flags ----------------------------------------------- , ( "fasm", AnySuffix (\_ -> setLang HscAsm) ) , ( "fvia-c", NoArg (setLang HscC) ) , ( "fvia-C", NoArg (setLang HscC) ) , ( "filx", NoArg (setLang HscILX) ) - , ( "fno-code", NoArg (setLang HscNothing) ) + + , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) + , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) -- "active negatives" , ( "fno-implicit-prelude", NoArg (setDynFlag Opt_NoImplicitPrelude) ) + , ( "fno-monomorphism-restriction", + NoArg (setDynFlag Opt_NoMonomorphismRestriction) ) -- the rest of the -f* and -fno-* flags , ( "fno-", PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) ) @@ -414,12 +450,29 @@ fFlags = [ ( "warn-unused-imports", Opt_WarnUnusedImports ), ( "warn-unused-matches", Opt_WarnUnusedMatches ), ( "warn-deprecations", Opt_WarnDeprecations ), - ( "glasgow-exts", Opt_GlasgowExts ), + ( "fi", Opt_FFI ), -- support `-ffi'... + ( "ffi", Opt_FFI ), -- ...and also `-fffi' + ( "arrows", Opt_Arrows ), -- arrow syntax + ( "parr", Opt_PArr ), + ( "th", Opt_TH ), + ( "implicit-params", Opt_ImplicitParams ), ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), - ( "generics", Opt_Generics ) + ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), + ( "generics", Opt_Generics ), + ( "strictness", Opt_Strictness ), + ( "cse", Opt_CSE ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), + ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), + ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), + ( "ignore-asserts", Opt_IgnoreAsserts ), + ( "do-eta-reduction", Opt_DoEtaReduction ), + ( "case-merge", Opt_CaseMerge ), + ( "unbox-strict-fields", Opt_UnboxStrictFields ) ] +glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ] + isFFlag f = f `elem` (map fst fFlags) getFFlag f = fromJust (lookup f fFlags) @@ -441,8 +494,13 @@ decodeSize str ----------------------------------------------------------------------------- -- RTS Hooks +#if __GLASGOW_HASKELL__ >= 504 +foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () +foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () +#else foreign import "setHeapSize" unsafe setHeapSize :: Int -> IO () foreign import "enableTimingStats" unsafe enableTimingStats :: IO () +#endif ----------------------------------------------------------------------------- -- Build the Hsc static command line opts @@ -452,20 +510,10 @@ buildStaticHscOpts = do opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts from the command line - -- optimisation - minus_o <- readIORef v_OptLevel - let optimisation_opts = - case minus_o of - 0 -> hsc_minusNoO_flags - 1 -> hsc_minusO_flags - 2 -> hsc_minusO2_flags - _ -> error "unknown opt level" - -- ToDo: -Ofile - -- take into account -fno-* flags by removing the equivalent -f* -- flag from our list. anti_flags <- getStaticOpts v_Anti_opt_C - let basic_opts = opt_C_ ++ optimisation_opts + let basic_opts = opt_C_ filtered_opts = filter (`notElem` anti_flags) basic_opts static <- (do s <- readIORef v_Static; if s then return "-static" @@ -473,6 +521,21 @@ buildStaticHscOpts = do return ( static : filtered_opts ) +setMainIs :: String -> IO () +setMainIs arg + | not (null main_mod) -- The arg looked like "Foo.baz" + = do { writeIORef v_MainFunIs (Just main_fn) ; + writeIORef v_MainModIs (Just main_mod) } + + | isUpper (head main_fn) -- The arg looked like "Foo" + = writeIORef v_MainModIs (Just main_fn) + + | otherwise -- The arg looked like "baz" + = writeIORef v_MainFunIs (Just main_fn) + where + (main_mod, main_fn) = split_longest_prefix arg (== '.') + + ----------------------------------------------------------------------------- -- Via-C compilation stuff @@ -482,7 +545,11 @@ buildStaticHscOpts = do machdepCCOpts | prefixMatch "alpha" cTARGETPLATFORM - = return ( ["-static"], ["-w"] ) + = return ( ["-static", "-w", "-mieee" +#ifdef HAVE_THREADED_RTS_SUPPORT + , "-D_REENTRANT" +#endif + ], [] ) -- For now, to suppress the gcc warning "call-clobbered -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. @@ -511,12 +578,31 @@ machdepCCOpts -- the fp (%ebp) for our register maps. = do n_regs <- dynFlag stolen_x86_regs sta <- readIORef v_Static - return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "", - if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ], - [ "-fno-defer-pop", "-fomit-frame-pointer", + return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" +-- , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" + ], + [ "-fno-defer-pop", +#ifdef HAVE_GCC_MNO_OMIT_LFPTR + -- Some gccs are configured with + -- -momit-leaf-frame-pointer on by default, and it + -- apparently takes precedence over + -- -fomit-frame-pointer, so we disable it first here. + "-mno-omit-leaf-frame-pointer", +#endif + "-fomit-frame-pointer", + -- we want -fno-builtin, because when gcc inlines + -- built-in functions like memcpy() it tends to + -- run out of registers, requiring -monly-n-regs + "-fno-builtin", "-DSTOLEN_X86_REGS="++show n_regs ] ) + | prefixMatch "ia64" cTARGETPLATFORM + = return ( [], ["-fomit-frame-pointer", "-G0"] ) + + | prefixMatch "x86_64" cTARGETPLATFORM + = return ( [], ["-fomit-frame-pointer"] ) + | prefixMatch "mips" cTARGETPLATFORM = return ( ["-static"], [] ) @@ -526,16 +612,29 @@ machdepCCOpts -- register used for global register variable", we simply -- disable all warnings altogether using the -w flag. Oh well. + | prefixMatch "powerpc-apple-darwin" cTARGETPLATFORM + -- -no-cpp-precomp: + -- Disable Apple's precompiling preprocessor. It's a great thing + -- for "normal" programs, but it doesn't support register variable + -- declarations. + -- -mdynamic-no-pic: + -- As we don't support haskell code in shared libraries anyway, + -- we might as well turn of PIC code generation and save space and time. + -- This is completely optional. + = return ( ["-no-cpp-precomp","-mdynamic-no-pic"], [] ) + | prefixMatch "powerpc" cTARGETPLATFORM || prefixMatch "rs6000" cTARGETPLATFORM = return ( ["-static"], ["-finhibit-size-directive"] ) | otherwise = return ( [], [] ) - +----------------------------------------------------------------------------- +-- local utils addOpt_L a = updDynFlags (\s -> s{opt_L = a : opt_L s}) addOpt_P a = updDynFlags (\s -> s{opt_P = a : opt_P s}) +addOpt_F a = updDynFlags (\s -> s{opt_F = a : opt_F s}) addOpt_c a = updDynFlags (\s -> s{opt_c = a : opt_c s}) addOpt_a a = updDynFlags (\s -> s{opt_a = a : opt_a s}) addOpt_m a = updDynFlags (\s -> s{opt_m = a : opt_m s}) @@ -544,25 +643,31 @@ addOpt_I a = updDynFlags (\s -> s{opt_I = a : opt_I s}) addOpt_i a = updDynFlags (\s -> s{opt_i = a : opt_i s}) #endif -addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) - -getOpts :: (DynFlags -> [a]) -> IO [a] - -- We add to the options from the front, so we need to reverse the list -getOpts opts = dynFlag opts >>= return . reverse - --- we can only change HscC to HscAsm and vice-versa with dynamic flags --- (-fvia-C and -fasm). We can also set the new lang to ILX, via -filx. -setLang l = updDynFlags (\ dfs -> case hscLang dfs of - HscC -> dfs{ hscLang = l } - HscAsm -> dfs{ hscLang = l } - HscILX -> dfs{ hscLang = l } - _ -> dfs) - setVerbosity "" = updDynFlags (\dfs -> dfs{ verbosity = 3 }) setVerbosity n | all isDigit n = updDynFlags (\dfs -> dfs{ verbosity = read n }) | otherwise = throwDyn (UsageError "can't parse verbosity flag (-v)") -getVerbFlag = do - verb <- dynFlag verbosity - if verb >= 3 then return "-v" else return "" +addCmdlineHCInclude a = updDynFlags (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) + +-- ----------------------------------------------------------------------------- +-- Version and usage messages + +showVersion :: IO () +showVersion = do + putStrLn (cProjectName ++ ", version " ++ cProjectVersion) + exitWith ExitSuccess + +showGhcUsage = do + (ghc_usage_path,ghci_usage_path) <- getUsageMsgPaths + mode <- readIORef v_GhcMode + let usage_path + | mode == DoInteractive = ghci_usage_path + | otherwise = ghc_usage_path + usage <- readFile usage_path + dump usage + exitWith ExitSuccess + where + dump "" = return () + dump ('$':'$':s) = hPutStr stderr progName >> dump s + dump (c:s) = hPutChar stderr c >> dump s