X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=6fb17e8b7a1572389d50a9e34890fa81441fa815;hb=224131a71a9edbd6aa8d5a704f1012f8a0a88814;hp=59861ce4102877ad278e931bda9f88cae3f316d6;hpb=b76bd4f4ff65e8b6f65918f8e810b4798103e9a9;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 59861ce..6fb17e8 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -1,4 +1,4 @@ -% + % (c) The University of Glasgow, 1996-2000 % \section[CmdLineOpts]{Things to do with command-line options} @@ -6,35 +6,47 @@ \begin{code} module CmdLineOpts ( - CoreToDo(..), - SimplifierSwitch(..), isAmongSimpl, - StgToDo(..), - SwitchResult(..), + CoreToDo(..), StgToDo(..), + SimplifierSwitch(..), + SimplifierMode(..), FloatOutSwitches(..), HscLang(..), DynFlag(..), -- needed non-abstractly by DriverFlags DynFlags(..), - defaultDynFlags, v_Static_hsc_opts, - intSwitchSet, - switchIsOn, isStaticHscFlag, + -- Manipulating DynFlags + defaultDynFlags, -- DynFlags + dopt, -- DynFlag -> DynFlags -> Bool + dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags + dopt_CoreToDo, -- DynFlags -> [CoreToDo] + dopt_StgToDo, -- DynFlags -> [StgToDo] + dopt_HscLang, -- DynFlags -> HscLang + dopt_OutName, -- DynFlags -> String + + -- Manipulating the DynFlags state + getDynFlags, -- IO DynFlags + setDynFlags, -- DynFlags -> IO () + updDynFlags, -- (DynFlags -> DynFlags) -> IO () + dynFlag, -- (DynFlags -> a) -> IO a + setDynFlag, unSetDynFlag, -- DynFlag -> IO () + saveDynFlags, -- IO () + restoreDynFlags, -- IO DynFlags + + -- sets of warning opts + standardWarnings, + minusWOpts, + minusWallOpts, + + -- Output style options opt_PprStyle_NoPrags, opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, - dopt, - - -- other dynamic flags - dopt_CoreToDo, - dopt_StgToDo, - dopt_HscLang, - dopt_OutName, - -- profiling opts opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs, @@ -52,8 +64,10 @@ module CmdLineOpts ( opt_Parallel, opt_SMP, opt_NoMonomorphismRestriction, + opt_RuntimeTypes, -- optimisation opts + opt_NoMethodSharing, opt_DoSemiTagging, opt_FoldrBuildOn, opt_LiberateCaseThreshold, @@ -64,13 +78,11 @@ module CmdLineOpts ( opt_SimplNoPreInlining, opt_SimplDoEtaReduction, opt_SimplDoLambdaEtaExpansion, - opt_SimplCaseOfCase, opt_SimplCaseMerge, - opt_SimplPedanticBottoms, opt_SimplExcessPrecision, + opt_MaxWorkerArgs, -- Unfolding control - opt_UF_HiFileThreshold, opt_UF_CreationThreshold, opt_UF_UseThreshold, opt_UF_FunAppDiscount, @@ -94,27 +106,20 @@ module CmdLineOpts ( opt_NoPruneTyDecls, opt_NoPruneDecls, opt_Static, - opt_Unregisterised + opt_Unregisterised, + opt_EmitExternalCore ) where #include "HsVersions.h" -import Array ( array, (//) ) import GlaExts -import IOExts ( IORef, readIORef ) +import IOExts ( IORef, readIORef, writeIORef ) import Constants -- Default values for some flags import Util import FastTypes import Config import Maybes ( firstJust ) -import Panic ( panic ) - -#if __GLASGOW_HASKELL__ < 301 -import ArrBase ( Array(..) ) -#else -import PrelArr ( Array(..) ) -#endif \end{code} %************************************************************************ @@ -157,33 +162,30 @@ main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop %************************************************************************ \begin{code} -data SwitchResult - = SwBool Bool -- on/off - | SwString FAST_STRING -- nothing or a String - | SwInt Int -- nothing or an Int -\end{code} - -\begin{code} data CoreToDo -- These are diff core-to-core passes, -- which may be invoked in any order, -- as many times as you like. = CoreDoSimplify -- The core-to-core simplifier. - (SimplifierSwitch -> SwitchResult) + SimplifierMode + [SimplifierSwitch] -- Each run of the simplifier can take a different -- set of simplifier-specific flags. | CoreDoFloatInwards - | CoreDoFloatOutwards Bool -- True <=> float lambdas to top level + | CoreDoFloatOutwards FloatOutSwitches | CoreLiberateCase | CoreDoPrintCore | CoreDoStaticArgs | CoreDoStrictness | CoreDoWorkerWrapper | CoreDoSpecialising + | CoreDoSpecConstr | CoreDoUSPInf | CoreDoCPResult | CoreDoGlomBinds | CoreCSE + | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules + -- matching this string | CoreDoNothing -- useful when building up lists of these things \end{code} @@ -197,12 +199,18 @@ data StgToDo \end{code} \begin{code} +data SimplifierMode -- See comments in SimplMonad + = SimplGently + | SimplPhase Int + data SimplifierSwitch = MaxSimplifierIterations Int - | SimplInlinePhase Int - | DontApplyRules | NoCaseOfCase - | SimplLetToCase + +data FloatOutSwitches + = FloatOutSw Bool -- True <=> float lambdas to top level + Bool -- True <=> float constants to top level, + -- even if they do not escape a lambda \end{code} %************************************************************************ @@ -230,7 +238,7 @@ data DynFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec - | Opt_D_dump_sat + | Opt_D_dump_prep | Opt_D_dump_stg | Opt_D_dump_stranal | Opt_D_dump_tc @@ -243,7 +251,8 @@ data DynFlag | Opt_D_dump_rn_stats | Opt_D_dump_stix | Opt_D_dump_simpl_stats - | Opt_D_dump_InterpSyn + | Opt_D_dump_tc_trace + | Opt_D_dump_BCOs | Opt_D_source_stats | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg @@ -268,31 +277,79 @@ data DynFlag | Opt_WarnUnusedImports | Opt_WarnUnusedMatches | Opt_WarnDeprecations + | Opt_WarnMisc -- language opts | Opt_AllowOverlappingInstances | Opt_AllowUndecidableInstances + | Opt_AllowIncoherentInstances | Opt_GlasgowExts | Opt_Generics | Opt_NoImplicitPrelude - -- misc - | Opt_ReportCompile deriving (Eq) data DynFlags = DynFlags { - coreToDo :: [CoreToDo], - stgToDo :: [StgToDo], - hscLang :: HscLang, - hscOutName :: String, -- name of the file in which to place output - verbosity :: Int, -- verbosity level - flags :: [DynFlag] + coreToDo :: [CoreToDo], + stgToDo :: [StgToDo], + hscLang :: HscLang, + hscOutName :: String, -- name of the output file + hscStubHOutName :: String, -- name of the .stub_h output file + hscStubCOutName :: String, -- name of the .stub_c output file + extCoreName :: String, -- name of the .core output file + verbosity :: Int, -- verbosity level + cppFlag :: Bool, -- preprocess with cpp? + ppFlag :: Bool, -- preprocess with a Haskell Pp? + stolen_x86_regs :: Int, + cmdlineHcIncludes :: [String], -- -#includes + + -- options for particular phases + opt_L :: [String], + opt_P :: [String], + opt_F :: [String], + opt_c :: [String], + opt_a :: [String], + opt_m :: [String], +#ifdef ILX + opt_I :: [String], + opt_i :: [String], +#endif + + -- hsc dynamic flags + flags :: [DynFlag] } +data HscLang + = HscC + | HscAsm + | HscJava + | HscILX + | HscInterpreted + | HscNothing + deriving (Eq, Show) + defaultDynFlags = DynFlags { coreToDo = [], stgToDo = [], - hscLang = HscC, hscOutName = "", - verbosity = 0, flags = [] + hscLang = HscC, + hscOutName = "", + hscStubHOutName = "", hscStubCOutName = "", + extCoreName = "", + verbosity = 0, + cppFlag = False, + ppFlag = False, + stolen_x86_regs = 4, + cmdlineHcIncludes = [], + opt_L = [], + opt_P = [], + opt_F = [], + opt_c = [], + opt_a = [], + opt_m = [], +#ifdef ILX + opt_I = [], + opt_i = [], +#endif + flags = standardWarnings, } {- @@ -318,15 +375,92 @@ dopt_StgToDo = stgToDo dopt_OutName :: DynFlags -> String dopt_OutName = hscOutName -data HscLang - = HscC - | HscAsm - | HscJava - | HscInterpreted - deriving (Eq, Show) - dopt_HscLang :: DynFlags -> HscLang dopt_HscLang = hscLang + +dopt_set :: DynFlags -> DynFlag -> DynFlags +dopt_set dfs f = dfs{ flags = f : flags dfs } + +dopt_unset :: DynFlags -> DynFlag -> DynFlags +dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } +\end{code} + +----------------------------------------------------------------------------- +-- Mess about with the mutable variables holding the dynamic arguments + +-- v_InitDynFlags +-- is the "baseline" dynamic flags, initialised from +-- the defaults and command line options, and updated by the +-- ':s' command in GHCi. +-- +-- v_DynFlags +-- is the dynamic flags for the current compilation. It is reset +-- to the value of v_InitDynFlags before each compilation, then +-- updated by reading any OPTIONS pragma in the current module. + +\begin{code} +GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags) +GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags) + +setDynFlags :: DynFlags -> IO () +setDynFlags dfs = writeIORef v_DynFlags dfs + +saveDynFlags :: IO () +saveDynFlags = do dfs <- readIORef v_DynFlags + writeIORef v_InitDynFlags dfs + +restoreDynFlags :: IO DynFlags +restoreDynFlags = do dfs <- readIORef v_InitDynFlags + writeIORef v_DynFlags dfs + return dfs + +getDynFlags :: IO DynFlags +getDynFlags = readIORef v_DynFlags + +updDynFlags :: (DynFlags -> DynFlags) -> IO () +updDynFlags f = do dfs <- readIORef v_DynFlags + writeIORef v_DynFlags (f dfs) + +dynFlag :: (DynFlags -> a) -> IO a +dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags) + +setDynFlag, unSetDynFlag :: DynFlag -> IO () +setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f) +unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f) +\end{code} + + +%************************************************************************ +%* * +\subsection{Warnings} +%* * +%************************************************************************ + +\begin{code} +standardWarnings + = [ Opt_WarnDeprecations, + Opt_WarnOverlappingPatterns, + Opt_WarnMissingFields, + Opt_WarnMissingMethods, + Opt_WarnDuplicateExports + ] + +minusWOpts + = standardWarnings ++ + [ Opt_WarnUnusedBinds, + Opt_WarnUnusedMatches, + Opt_WarnUnusedImports, + Opt_WarnIncompletePatterns, + Opt_WarnMisc + ] + +minusWallOpts + = minusWOpts ++ + [ Opt_WarnTypeDefaults, + Opt_WarnNameShadowing, + Opt_WarnMissingSigs, + Opt_WarnHiShadows + ] \end{code} %************************************************************************ @@ -415,18 +549,20 @@ opt_Parallel = lookUp SLIT("-fparallel") opt_SMP = lookUp SLIT("-fsmp") -- optimisation opts +opt_NoMethodSharing = lookUp SLIT("-fno-method-sharing") opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging") opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on") opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int) opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape") -opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file") +opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file") opt_UsageSPOn = lookUp SLIT("-fusagesp-on") opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields") +opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int) {- The optional '-inpackage=P' flag tells what package we are compiling this module for. - The Prelude, for example is compiled with '-package prelude' + The Prelude, for example is compiled with '-inpackage std' -} opt_InPackage = case lookup_str "-inpackage=" of Just p -> _PK_ p @@ -442,20 +578,18 @@ opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check") opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing") opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas") +opt_RuntimeTypes = lookUp SLIT("-fruntime-types") -- Simplifier switches -opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining") +opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining") -- NoPreInlining is there just to see how bad things -- get if you don't do it! -opt_SimplDoEtaReduction = lookUp SLIT("-fdo-eta-reduction") -opt_SimplDoLambdaEtaExpansion = lookUp SLIT("-fdo-lambda-eta-expansion") -opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case") -opt_SimplCaseMerge = lookUp SLIT("-fcase-merge") -opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms") -opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision") +opt_SimplDoEtaReduction = lookUp SLIT("-fdo-eta-reduction") +opt_SimplDoLambdaEtaExpansion = lookUp SLIT("-fdo-lambda-eta-expansion") +opt_SimplCaseMerge = lookUp SLIT("-fcase-merge") +opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision") -- Unfolding control -opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (45::Int) opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int) opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (8::Int) -- Discounts can be big opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) -- It's great to inline a fn @@ -465,10 +599,11 @@ opt_UF_UpdateInPlace = lookUp SLIT("-funfolding-update-in-place") opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for opt_UF_DearOp = ( 4 :: Int) -opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls") -opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls") -opt_Static = lookUp SLIT("-static") -opt_Unregisterised = lookUp SLIT("-funregisterised") +opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls") +opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls") +opt_Static = lookUp SLIT("-static") +opt_Unregisterised = lookUp SLIT("-funregisterised") +opt_EmitExternalCore = lookUp SLIT("-fext-core") \end{code} %************************************************************************ @@ -505,26 +640,28 @@ isStaticHscFlag f = "fignore-interface-pragmas", "fno-hi-version-check", "dno-black-holing", + "fno-method-sharing", + "fno-monomorphism-restriction", "fomit-interface-pragmas", + "fruntime-types", "fno-pre-inlining", "fdo-eta-reduction", "fdo-lambda-eta-expansion", - "fcase-of-case", "fcase-merge", - "fpedantic-bottoms", "fexcess-precision", "funfolding-update-in-place", - "freport-compile", "fno-prune-decls", "fno-prune-tydecls", "static", - "funregisterised" + "funregisterised", + "fext-core", + "frule-check" ] || any (flip prefixMatch f) [ "fcontext-stack", "fliberate-case-threshold", + "fmax-worker-args", "fhistory-size", - "funfolding-interface-threshold", "funfolding-creation-threshold", "funfolding-use-threshold", "funfolding-fun-discount", @@ -534,116 +671,11 @@ isStaticHscFlag f = %************************************************************************ %* * -\subsection{Switch ordering} -%* * -%************************************************************************ - -These things behave just like enumeration types. - -\begin{code} -instance Eq SimplifierSwitch where - a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b - -instance Ord SimplifierSwitch where - a < b = tagOf_SimplSwitch a <# tagOf_SimplSwitch b - a <= b = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b - - -tagOf_SimplSwitch (SimplInlinePhase _) = _ILIT(1) -tagOf_SimplSwitch (MaxSimplifierIterations _) = _ILIT(2) -tagOf_SimplSwitch DontApplyRules = _ILIT(3) -tagOf_SimplSwitch SimplLetToCase = _ILIT(4) -tagOf_SimplSwitch NoCaseOfCase = _ILIT(5) - --- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too! - -lAST_SIMPL_SWITCH_TAG = 5 -\end{code} - -%************************************************************************ -%* * -\subsection{Switch lookup} -%* * -%************************************************************************ - -\begin{code} -isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult -isAmongSimpl on_switches -- Switches mentioned later occur *earlier* - -- in the list; defaults right at the end. - = let - tidied_on_switches = foldl rm_dups [] on_switches - -- The fold*l* ensures that we keep the latest switches; - -- ie the ones that occur earliest in the list. - - sw_tbl :: Array Int SwitchResult - sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds... - all_undefined) - // defined_elems - - all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ] - - defined_elems = map mk_assoc_elem tidied_on_switches - in - -- (avoid some unboxing, bounds checking, and other horrible things:) -#if __GLASGOW_HASKELL__ < 405 - case sw_tbl of { Array bounds_who_needs_'em stuff -> -#else - case sw_tbl of { Array _ _ stuff -> -#endif - \ switch -> - case (indexArray# stuff (tagOf_SimplSwitch switch)) of -#if __GLASGOW_HASKELL__ < 400 - Lift v -> v -#elif __GLASGOW_HASKELL__ < 403 - (# _, v #) -> v -#else - (# v #) -> v -#endif - } - where - mk_assoc_elem k@(MaxSimplifierIterations lvl) - = (iBox (tagOf_SimplSwitch k), SwInt lvl) - mk_assoc_elem k@(SimplInlinePhase n) - = (iBox (tagOf_SimplSwitch k), SwInt n) - mk_assoc_elem k - = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom! - - -- cannot have duplicates if we are going to use the array thing - rm_dups switches_so_far switch - = if switch `is_elem` switches_so_far - then switches_so_far - else switch : switches_so_far - where - sw `is_elem` [] = False - sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s) - || sw `is_elem` ss -\end{code} - - -%************************************************************************ -%* * \subsection{Misc functions for command-line options} %* * %************************************************************************ -\begin{code} -switchIsOn :: (switch -> SwitchResult) -> switch -> Bool - -switchIsOn lookup_fn switch - = case (lookup_fn switch) of - SwBool False -> False - _ -> True - -intSwitchSet :: (switch -> SwitchResult) - -> (Int -> switch) - -> Maybe Int - -intSwitchSet lookup_fn switch - = case (lookup_fn (switch (panic "intSwitchSet"))) of - SwInt int -> Just int - _ -> Nothing -\end{code} \begin{code} startsWith :: String -> String -> Maybe String