X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverFlags.hs;h=ac9e92ccb8eac1f28767c01190629f17b3786ea6;hb=79d7a7c0d17b51dfb2bb06d758b6e556550862ba;hp=337cad7e0600daaad4eec0f0e02bdab634157f6e;hpb=7cbba64b65967d947f5b028c80c0e2320376aabd;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs index 337cad7..ac9e92c 100644 --- a/ghc/compiler/main/DriverFlags.hs +++ b/ghc/compiler/main/DriverFlags.hs @@ -1,9 +1,8 @@ ----------------------------------------------------------------------------- --- $Id: DriverFlags.hs,v 1.124 2003/09/10 16:44:05 simonmar Exp $ -- -- Driver flags -- --- (c) Simon Marlow 2000 +-- (c) The University of Glasgow 2000-2003 -- ----------------------------------------------------------------------------- @@ -15,7 +14,7 @@ module DriverFlags ( ) where #include "HsVersions.h" -#include "../includes/config.h" +#include "../includes/ghcconfig.h" import MkIface ( showIface ) import DriverState @@ -94,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 -> @@ -202,8 +201,11 @@ static_flags = , ( "smp" , NoArg (addNoDups v_Ways WaySMP) ) , ( "debug" , NoArg (addNoDups v_Ways WayDebug) ) , ( "ndp" , NoArg (addNoDups v_Ways WayNDP) ) + , ( "threaded" , NoArg (addNoDups v_Ways WayThreaded) ) -- ToDo: user ways + ------ RTS ways ----------------------------------------------------- + ------ Debugging ---------------------------------------------------- , ( "dppr-noprags", PassFlag (add v_Opt_C) ) , ( "dppr-debug", PassFlag (add v_Opt_C) ) @@ -252,12 +254,11 @@ static_flags = 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 \ - \object files on this architecture" + "warning: don't know how to split object files on this architecture" ) ) ------- Include/Import Paths ---------------------------------------- - , ( "i" , OptPrefix (addToDirList v_Import_paths) ) + , ( "i" , OptPrefix (addToOrDeleteDirList v_Import_paths) ) , ( "I" , Prefix (addToDirList v_Include_paths) ) ------- Libraries --------------------------------------------------- @@ -280,13 +281,13 @@ static_flags = ------- Specific phases -------------------------------------------- , ( "pgmL" , HasArg setPgmL ) , ( "pgmP" , HasArg setPgmP ) - , ( "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 ) @@ -307,28 +308,11 @@ static_flags = , ( "Rghc-timing" , NoArg (enableTimingStats) ) ------ Compiler flags ----------------------------------------------- - , ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) ) - , ( "O" , NoArg (setOptLevel 1)) - , ( "Onot" , NoArg (setOptLevel 0)) - , ( "O" , PrefixPred (all isDigit) (setOptLevel . read)) - , ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) ) - , ( "fmax-simplifier-iterations", - PrefixPred (all isDigit) (writeIORef v_MaxSimplifierIterations . read) ) - - , ( "frule-check", - SepArg (\s -> writeIORef v_RuleCheck (Just s)) ) - , ( "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-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)) ) @@ -363,7 +347,7 @@ dynamic_flags = [ ------ Debugging ---------------------------------------------------- , ( "dstg-stats", NoArg (writeIORef v_StgStats True) ) - , ( "ddump-absC", NoArg (setDynFlag Opt_D_dump_absC) ) + , ( "ddump-cmm", NoArg (setDynFlag Opt_D_dump_cmm) ) , ( "ddump-asm", NoArg (setDynFlag Opt_D_dump_asm) ) , ( "ddump-cpranal", NoArg (setDynFlag Opt_D_dump_cpranal) ) , ( "ddump-deriv", NoArg (setDynFlag Opt_D_dump_deriv) ) @@ -373,7 +357,6 @@ dynamic_flags = [ , ( "ddump-inlinings", NoArg (setDynFlag Opt_D_dump_inlinings) ) , ( "ddump-occur-anal", NoArg (setDynFlag Opt_D_dump_occur_anal) ) , ( "ddump-parsed", NoArg (setDynFlag Opt_D_dump_parsed) ) - , ( "ddump-realC", NoArg (setDynFlag Opt_D_dump_realC) ) , ( "ddump-rn", NoArg (setDynFlag Opt_D_dump_rn) ) , ( "ddump-simpl", NoArg (setDynFlag Opt_D_dump_simpl) ) , ( "ddump-simpl-iterations", NoArg (setDynFlag Opt_D_dump_simpl_iterations) ) @@ -388,10 +371,11 @@ dynamic_flags = [ , ( "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-opt-cmm", NoArg (setDynFlag Opt_D_dump_opt_cmm) ) , ( "ddump-simpl-stats", NoArg (setDynFlag Opt_D_dump_simpl_stats) ) , ( "ddump-bcos", NoArg (setDynFlag Opt_D_dump_BCOs) ) , ( "dsource-stats", NoArg (setDynFlag Opt_D_source_stats) ) @@ -403,6 +387,7 @@ dynamic_flags = [ , ( "ddump-vect", NoArg (setDynFlag Opt_D_dump_vect) ) , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting) ) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting) ) + , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting) ) ------ Machine dependant (-m) stuff --------------------------- @@ -417,6 +402,19 @@ dynamic_flags = [ , ( "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) ) @@ -443,6 +441,7 @@ fFlags = [ ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), ( "warn-hi-shadowing", Opt_WarnHiShadows ), ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), ( "warn-missing-fields", Opt_WarnMissingFields ), ( "warn-missing-methods", Opt_WarnMissingMethods ), ( "warn-missing-signatures", Opt_WarnMissingSigs ), @@ -456,7 +455,6 @@ fFlags = [ ( "warn-deprecations", Opt_WarnDeprecations ), ( "fi", Opt_FFI ), -- support `-ffi'... ( "ffi", Opt_FFI ), -- ...and also `-fffi' - ( "with", Opt_With ), -- with keyword ( "arrows", Opt_Arrows ), -- arrow syntax ( "parr", Opt_PArr ), ( "th", Opt_TH ), @@ -464,7 +462,17 @@ fFlags = [ ( "allow-overlapping-instances", Opt_AllowOverlappingInstances ), ( "allow-undecidable-instances", Opt_AllowUndecidableInstances ), ( "allow-incoherent-instances", Opt_AllowIncoherentInstances ), - ( "generics", Opt_Generics ) + ( "generics", Opt_Generics ), + ( "strictness", Opt_Strictness ), + ( "full-laziness", Opt_FullLaziness ), + ( "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 ] @@ -506,21 +514,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 - n -> throwDyn (CmdLineError ("unknown optimisation level: " - ++ show n)) - -- 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" @@ -625,14 +622,20 @@ machdepCCOpts -- 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"] ) - + -- Turn off PIC code generation to save space and time. + -- -fno-common: + -- Don't generate "common" symbols - these are unwanted + -- in dynamic libraries. + + = if opt_PIC + then return ( ["-no-cpp-precomp", "-fno-common"], + ["-fno-common"] ) + else return ( ["-no-cpp-precomp", "-mdynamic-no-pic"], + ["-mdynamic-no-pic"] ) + + | prefixMatch "powerpc" cTARGETPLATFORM && opt_PIC + = return ( ["-fPIC"], ["-fPIC"] ) + | otherwise = return ( [], [] ) @@ -657,7 +660,24 @@ setVerbosity n 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