X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=2aa9453fa8f7e4937f1df74bc37c1f6b91ef2ca3;hb=12e6a9a58473f8b24e831c2171bf62d256da8a85;hp=ab552fa8abbe08a3a966ca38d2df22da7c7b2a9d;hpb=4d9a324107b610ffd80f69dc41b382e0fbf43dcb;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index ab552fa..2aa9453 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -1,5 +1,5 @@ -% -% (c) The AQUA Project, Glasgow University, 1996-98 + +% (c) The University of Glasgow, 1996-2000 % \section[CmdLineOpts]{Things to do with command-line options} @@ -7,76 +7,38 @@ module CmdLineOpts ( CoreToDo(..), - SimplifierSwitch(..), + SimplifierSwitch(..), isAmongSimpl, StgToDo(..), SwitchResult(..), + HscLang(..), - classifyOpts, + DynFlag(..), -- needed non-abstractly by DriverFlags + DynFlags(..), + defaultDynFlags, + + v_Static_hsc_opts, intSwitchSet, switchIsOn, - - -- debugging opts - dopt_D_dump_absC, - dopt_D_dump_asm, - dopt_D_dump_cpranal, - dopt_D_dump_cse, - dopt_D_dump_deriv, - dopt_D_dump_ds, - dopt_D_dump_flatC, - dopt_D_dump_foreign, - dopt_D_dump_hi_diffs, - dopt_D_dump_inlinings, - dopt_D_dump_occur_anal, - dopt_D_dump_parsed, - dopt_D_dump_realC, - dopt_D_dump_rn, - dopt_D_dump_rules, - dopt_D_dump_simpl, - dopt_D_dump_simpl_iterations, - dopt_D_dump_simpl_stats, - dopt_D_dump_spec, - dopt_D_dump_stg, - dopt_D_dump_stranal, - dopt_D_dump_tc, - dopt_D_dump_types, - dopt_D_dump_usagesp, - dopt_D_dump_worker_wrapper, - dopt_D_show_passes, - dopt_D_dump_rn_trace, - dopt_D_dump_rn_stats, - dopt_D_dump_stix, - dopt_D_dump_minimal_imports, - dopt_D_source_stats, - dopt_D_verbose_core2core, - dopt_D_verbose_stg2stg, - dopt_DoCoreLinting, - dopt_DoStgLinting, - dopt_DoUSPLinting, + isStaticHscFlag, opt_PprStyle_NoPrags, + opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, + dopt, + -- other dynamic flags dopt_CoreToDo, dopt_StgToDo, + dopt_HscLang, + dopt_OutName, - -- warning opts - opt_WarnDuplicateExports, - opt_WarnHiShadows, - opt_WarnIncompletePatterns, - opt_WarnMissingFields, - opt_WarnMissingMethods, - opt_WarnMissingSigs, - opt_WarnNameShadowing, - opt_WarnOverlappingPatterns, - opt_WarnSimplePatterns, - opt_WarnTypeDefaults, - opt_WarnUnusedBinds, - opt_WarnUnusedImports, - opt_WarnUnusedMatches, - opt_WarnDeprecations, + -- sets of warning opts + standardWarnings, + minusWOpts, + minusWallOpts, -- profiling opts opt_AutoSccsOnAllToplevs, @@ -90,16 +52,15 @@ module CmdLineOpts ( opt_AllStrict, opt_DictsStrict, opt_MaxContextReductionDepth, - dopt_AllowOverlappingInstances, - dopt_AllowUndecidableInstances, - dopt_GlasgowExts, - opt_Generics, opt_IrrefutableTuples, opt_NumbersStrict, opt_Parallel, opt_SMP, + opt_NoMonomorphismRestriction, + opt_KeepStgTypes, -- optimisation opts + opt_NoMethodSharing, opt_DoSemiTagging, opt_FoldrBuildOn, opt_LiberateCaseThreshold, @@ -110,9 +71,7 @@ module CmdLineOpts ( opt_SimplNoPreInlining, opt_SimplDoEtaReduction, opt_SimplDoLambdaEtaExpansion, - opt_SimplCaseOfCase, opt_SimplCaseMerge, - opt_SimplPedanticBottoms, opt_SimplExcessPrecision, -- Unfolding control @@ -135,29 +94,23 @@ module CmdLineOpts ( opt_IgnoreAsserts, opt_IgnoreIfacePragmas, opt_NoHiCheck, - opt_NoImplicitPrelude, opt_OmitBlackHoling, opt_OmitInterfacePragmas, opt_NoPruneTyDecls, opt_NoPruneDecls, - opt_ReportCompile, opt_Static, - opt_Unregisterised, - opt_Verbose, - - -- Code generation - opt_UseVanillaRegs, - opt_UseFloatRegs, - opt_UseDoubleRegs, - opt_UseLongRegs + opt_Unregisterised ) where #include "HsVersions.h" import Array ( array, (//) ) import GlaExts -import Argv +import IOExts ( IORef, readIORef ) import Constants -- Default values for some flags +import Util +import FastTypes +import Config import Maybes ( firstJust ) import Panic ( panic ) @@ -184,14 +137,11 @@ Static flags are represented by top-level values of type Bool or Int, for example. They therefore have the same value throughout the invocation of hsc. -Dynamic flags are represented by a function: - - checkDynFlag :: DynFlag -> SwitchResult - -which is passed into hsc by the compilation manager for every -compilation. Dynamic flags are those that change on a per-compilation -basis, perhaps because they may be present in the OPTIONS pragma at -the top of a module. +Dynamic flags are represented by an abstract type, DynFlags, which is +passed into hsc by the compilation manager for every compilation. +Dynamic flags are those that change on a per-compilation basis, +perhaps because they may be present in the OPTIONS pragma at the top +of a module. Other flag-related blurb: @@ -235,17 +185,18 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoStrictness | CoreDoWorkerWrapper | CoreDoSpecialising + | CoreDoSpecConstr | CoreDoUSPInf - | CoreDoCPResult + | CoreDoCPResult | CoreDoGlomBinds | CoreCSE + + | CoreDoNothing -- useful when building up lists of these things \end{code} \begin{code} data StgToDo - = StgDoStaticArgs - | StgDoLambdaLift - | StgDoMassageForProfiling -- should be (next to) last + = StgDoMassageForProfiling -- should be (next to) last -- There's also setStgVarInfo, but its absolute "lastness" -- is so critical that it is hardwired in (no flag). | D_stg_stats @@ -270,9 +221,7 @@ data SimplifierSwitch data DynFlag -- debugging flags - = Opt_D_dump_all - | Opt_D_dump_most - | Opt_D_dump_absC + = Opt_D_dump_absC | Opt_D_dump_asm | Opt_D_dump_cpranal | Opt_D_dump_deriv @@ -287,6 +236,7 @@ data DynFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec + | Opt_D_dump_sat | Opt_D_dump_stg | Opt_D_dump_stranal | Opt_D_dump_tc @@ -295,94 +245,115 @@ data DynFlag | Opt_D_dump_usagesp | Opt_D_dump_cse | Opt_D_dump_worker_wrapper - | Opt_D_show_passes | Opt_D_dump_rn_trace | Opt_D_dump_rn_stats | Opt_D_dump_stix | Opt_D_dump_simpl_stats + | Opt_D_dump_tc_trace + | Opt_D_dump_BCOs | Opt_D_source_stats | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg + | Opt_D_dump_hi | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting | Opt_DoUSPLinting + | Opt_WarnDuplicateExports + | Opt_WarnHiShadows + | Opt_WarnIncompletePatterns + | Opt_WarnMissingFields + | Opt_WarnMissingMethods + | Opt_WarnMissingSigs + | Opt_WarnNameShadowing + | Opt_WarnOverlappingPatterns + | Opt_WarnSimplePatterns + | Opt_WarnTypeDefaults + | Opt_WarnUnusedBinds + | Opt_WarnUnusedImports + | Opt_WarnUnusedMatches + | Opt_WarnDeprecations + -- language opts | Opt_AllowOverlappingInstances | Opt_AllowUndecidableInstances | Opt_GlasgowExts + | Opt_Generics + | Opt_NoImplicitPrelude + deriving (Eq) data DynFlags = DynFlags { - coreToDo :: CoreToDo, - stgToDo :: StgToDo, - hscLang :: HscLang, - flags :: [(DynFlag, SwitchResult)] + coreToDo :: [CoreToDo], + stgToDo :: [StgToDo], + hscLang :: HscLang, + hscOutName :: String, -- name of the output file + verbosity :: Int, -- verbosity level + cppFlag :: Bool, -- preprocess with cpp? + stolen_x86_regs :: Int, + cmdlineHcIncludes :: [String], -- -#includes + + -- options for particular phases + opt_L :: [String], + opt_P :: [String], + opt_c :: [String], + opt_a :: [String], + opt_m :: [String], + + -- hsc dynamic flags + flags :: [DynFlag] } -boolOpt :: DynFlag -> DynFlags -> Bool -boolOpt f dflags - = case lookup f (flags dflags) of - Nothing -> False - Just (SwBool b) -> b - _ -> panic "boolOpt" - -dopt_D_dump_all = boolOpt Opt_D_dump_all -dopt_D_dump_most = boolOpt Opt_D_dump_most -dopt_D_dump_absC = boolOpt Opt_D_dump_absC -dopt_D_dump_asm = boolOpt Opt_D_dump_asm -dopt_D_dump_cpranal = boolOpt Opt_D_dump_cpranal -dopt_D_dump_deriv = boolOpt Opt_D_dump_deriv -dopt_D_dump_ds = boolOpt Opt_D_dump_ds -dopt_D_dump_flatC = boolOpt Opt_D_dump_flatC -dopt_D_dump_foreign = boolOpt Opt_D_dump_foreign -dopt_D_dump_inlinings = boolOpt Opt_D_dump_inlinings -dopt_D_dump_occur_anal = boolOpt Opt_D_dump_occur_anal -dopt_D_dump_parsed = boolOpt Opt_D_dump_parsed -dopt_D_dump_realC = boolOpt Opt_D_dump_realC -dopt_D_dump_rn = boolOpt Opt_D_dump_rn -dopt_D_dump_simpl = boolOpt Opt_D_dump_simpl -dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations -dopt_D_dump_spec = boolOpt Opt_D_dump_spec -dopt_D_dump_stg = boolOpt Opt_D_dump_stg -dopt_D_dump_stranal = boolOpt Opt_D_dump_stranal -dopt_D_dump_tc = boolOpt Opt_D_dump_tc -dopt_D_dump_types = boolOpt Opt_D_dump_types -dopt_D_dump_rules = boolOpt Opt_D_dump_rules -dopt_D_dump_usagesp = boolOpt Opt_D_dump_usagesp -dopt_D_dump_cse = boolOpt Opt_D_dump_cse -dopt_D_dump_worker_wrapper = boolOpt Opt_D_dump_worker_wrapper -dopt_D_show_passes = boolOpt Opt_D_show_passes -dopt_D_dump_rn_trace = boolOpt Opt_D_dump_rn_trace -dopt_D_dump_rn_stats = boolOpt Opt_D_dump_rn_stats -dopt_D_dump_stix = boolOpt Opt_D_dump_stix -dopt_D_dump_simpl_stats = boolOpt Opt_D_dump_simpl_stats -dopt_D_source_stats = boolOpt Opt_D_source_stats -dopt_D_verbose_core2core = boolOpt Opt_D_verbose_core2core -dopt_D_verbose_stg2stg = boolOpt Opt_D_verbose_stg2stg -dopt_D_dump_hi_diffs = boolOpt Opt_D_dump_hi_diffs -dopt_D_dump_minimal_imports = boolOpt Opt_D_dump_minimal_imports -dopt_DoCoreLinting = boolOpt Opt_DoCoreLinting -dopt_DoStgLinting = boolOpt Opt_DoStgLinting -dopt_DoUSPLinting = boolOpt Opt_DoUSPLinting - -dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances -dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances -dopt_GlasgowExts = boolOpt Opt_GlasgowExts - -dopt_CoreToDo :: DynFlags -> CoreToDo +defaultDynFlags = DynFlags { + coreToDo = [], stgToDo = [], + hscLang = HscC, + hscOutName = "", + verbosity = 0, + cppFlag = False, + stolen_x86_regs = 4, + cmdlineHcIncludes = [], + opt_L = [], + opt_P = [], + opt_c = [], + opt_a = [], + opt_m = [], + flags = standardWarnings, + } + +{- + Verbosity levels: + + 0 | print errors & warnings only + 1 | minimal verbosity: print "compiling M ... done." for each module. + 2 | equivalent to -dshow-passes + 3 | equivalent to existing "ghc -v" + 4 | "ghc -v -ddump-most" + 5 | "ghc -v -ddump-all" +-} + +dopt :: DynFlag -> DynFlags -> Bool +dopt f dflags = f `elem` (flags dflags) + +dopt_CoreToDo :: DynFlags -> [CoreToDo] dopt_CoreToDo = coreToDo -dopt_StgToDo :: DynFlags -> StgToDo +dopt_StgToDo :: DynFlags -> [StgToDo] dopt_StgToDo = stgToDo +dopt_OutName :: DynFlags -> String +dopt_OutName = hscOutName + data HscLang = HscC | HscAsm | HscJava - deriving Eq +#ifdef ILX + | HscILX +#endif + | HscInterpreted + deriving (Eq, Show) dopt_HscLang :: DynFlags -> HscLang dopt_HscLang = hscLang @@ -390,20 +361,59 @@ dopt_HscLang = hscLang %************************************************************************ %* * +\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 + ] + +minusWallOpts + = minusWOpts ++ + [ Opt_WarnTypeDefaults, + Opt_WarnNameShadowing, + Opt_WarnMissingSigs, + Opt_WarnHiShadows + ] +\end{code} + +%************************************************************************ +%* * \subsection{Classifying command-line options} %* * %************************************************************************ \begin{code} +-- v_Statis_hsc_opts is here to avoid a circular dependency with +-- main/DriverState. +GLOBAL_VAR(v_Static_hsc_opts, [], [String]) + lookUp :: FAST_STRING -> Bool lookup_int :: String -> Maybe Int lookup_def_int :: String -> Int -> Int lookup_def_float :: String -> Float -> Float lookup_str :: String -> Maybe String -lookUp sw = sw `elem` argv +unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts) +packed_static_opts = map _PK_ unpacked_static_opts + +lookUp sw = sw `elem` packed_static_opts -lookup_str sw = firstJust (map (startsWith sw) unpacked_opts) +lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts) lookup_int sw = case (lookup_str sw) of Nothing -> Nothing @@ -413,15 +423,10 @@ lookup_def_int sw def = case (lookup_str sw) of Nothing -> def -- Use default Just xx -> read xx -lookup_def_char sw def = case (lookup_str sw) of - Just (xx:_) -> xx - _ -> def -- Use default - lookup_def_float sw def = case (lookup_str sw) of Nothing -> def -- Use default Just xx -> read xx -unpacked_opts = map _UNPK_ argv {- Putting the compiler options into temporary at-files @@ -433,7 +438,7 @@ unpacked_opts :: [String] unpacked_opts = concat $ map (expandAts) $ - map _UNPK_ argv + map _UNPK_ argv -- NOT ARGV any more: v_Static_hsc_opts where expandAts ('@':fname) = words (unsafePerformIO (readFile fname)) expandAts l = [l] @@ -450,24 +455,9 @@ unpacked_opts = -- debugging opts opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags") opt_PprStyle_Debug = lookUp SLIT("-dppr-debug") +opt_PprStyle_RawTypes = lookUp SLIT("-dppr-rawtypes") opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name --- warning opts -opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports") -opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing") -opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns") -opt_WarnMissingFields = lookUp SLIT("-fwarn-missing-fields") -opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods") -opt_WarnMissingSigs = lookUp SLIT("-fwarn-missing-signatures") -opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing") -opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns") -opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns") -opt_WarnTypeDefaults = lookUp SLIT("-fwarn-type-defaults") -opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds") -opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports") -opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches") -opt_WarnDeprecations = lookUp SLIT("-fwarn-deprecations") - -- profiling opts opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs") opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs") @@ -478,8 +468,8 @@ opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky") -- language opts opt_AllStrict = lookUp SLIT("-fall-strict") +opt_NoMonomorphismRestriction = lookUp SLIT("-fno-monomorphism-restriction") opt_DictsStrict = lookUp SLIT("-fdicts-strict") -opt_Generics = lookUp SLIT("-fgenerics") opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples") opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH opt_NumbersStrict = lookUp SLIT("-fnumbers-strict") @@ -487,18 +477,19 @@ 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") {- - The optional '-inpackage=P' flag tells what package + 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 prelude' -} opt_InPackage = case lookup_str "-inpackage=" of Just p -> _PK_ p @@ -507,25 +498,23 @@ opt_InPackage = case lookup_str "-inpackage=" of opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls") opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names") opt_GranMacros = lookUp SLIT("-fgransim") -opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling. +opt_HiVersion = read cProjectVersionInt :: Int opt_HistorySize = lookup_def_int "-fhistory-size" 20 opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts") opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check") -opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude") opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing") opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas") +opt_KeepStgTypes = lookUp SLIT("-fkeep-stg-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) @@ -538,113 +527,71 @@ 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_ReportCompile = lookUp SLIT("-freport-compile") -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_Verbose = lookUp SLIT("-v") - -opt_UseVanillaRegs | opt_Unregisterised = 0 - | otherwise = mAX_Real_Vanilla_REG -opt_UseFloatRegs | opt_Unregisterised = 0 - | otherwise = mAX_Real_Float_REG -opt_UseDoubleRegs | opt_Unregisterised = 0 - | otherwise = mAX_Real_Double_REG -opt_UseLongRegs | opt_Unregisterised = 0 - | otherwise = mAX_Real_Long_REG +opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls") +opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls") +opt_Static = lookUp SLIT("-static") +opt_Unregisterised = lookUp SLIT("-funregisterised") \end{code} -\begin{code} -classifyOpts :: ([CoreToDo], -- Core-to-Core processing spec - [StgToDo]) -- STG-to-STG processing spec - -classifyOpts = sep argv [] [] -- accumulators... - where - sep :: [FAST_STRING] -- cmd-line opts (input) - -> [CoreToDo] -> [StgToDo] -- to_do accumulators - -> ([CoreToDo], [StgToDo]) -- result - - sep [] core_td stg_td -- all done! - = (reverse core_td, reverse stg_td) - -# define CORE_TD(to_do) sep opts (to_do:core_td) stg_td -# define STG_TD(to_do) sep opts core_td (to_do:stg_td) - - sep (opt1:opts) core_td stg_td - = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end... - ',' : _ -> sep opts core_td stg_td -- it is for the parser - - "-fsimplify" -> -- gather up SimplifierSwitches specially... - simpl_sep opts defaultSimplSwitches core_td stg_td - - "-ffloat-inwards" -> CORE_TD(CoreDoFloatInwards) - "-ffloat-outwards" -> CORE_TD(CoreDoFloatOutwards False) - "-ffloat-outwards-full" -> CORE_TD(CoreDoFloatOutwards True) - "-fliberate-case" -> CORE_TD(CoreLiberateCase) - "-fcse" -> CORE_TD(CoreCSE) - "-fglom-binds" -> CORE_TD(CoreDoGlomBinds) - "-fprint-core" -> CORE_TD(CoreDoPrintCore) - "-fstatic-args" -> CORE_TD(CoreDoStaticArgs) - "-fstrictness" -> CORE_TD(CoreDoStrictness) - "-fworker-wrapper" -> CORE_TD(CoreDoWorkerWrapper) - "-fspecialise" -> CORE_TD(CoreDoSpecialising) - "-fusagesp" -> CORE_TD(CoreDoUSPInf) - "-fcpr-analyse" -> CORE_TD(CoreDoCPResult) - - "-fstg-static-args" -> STG_TD(StgDoStaticArgs) - "-dstg-stats" -> STG_TD(D_stg_stats) - "-flambda-lift" -> STG_TD(StgDoLambdaLift) - "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling) - - _ -> -- NB: the driver is really supposed to handle bad options - sep opts core_td stg_td - - ---------------- - - simpl_sep :: [FAST_STRING] -- cmd-line opts (input) - -> [SimplifierSwitch] -- simplifier-switch accumulator - -> [CoreToDo] -> [StgToDo] -- to_do accumulators - -> ([CoreToDo], [StgToDo]) -- result - - -- "simpl_sep" tailcalls "sep" once it's seen one set - -- of SimplifierSwitches for a CoreDoSimplify. - -#ifdef DEBUG - simpl_sep input@[] simpl_sw core_td stg_td - = panic "simpl_sep []" -#endif +%************************************************************************ +%* * +\subsection{List of static hsc flags} +%* * +%************************************************************************ - -- The SimplifierSwitches should be delimited by "[" and "]". - - simpl_sep (opt1:opts) simpl_sw core_td stg_td - = case (_UNPK_ opt1) of - "[" -> simpl_sep opts simpl_sw core_td stg_td - "]" -> let - this_simpl = CoreDoSimplify (isAmongSimpl simpl_sw) - in - sep opts (this_simpl : core_td) stg_td - - opt -> case matchSimplSw opt of - Just sw -> simpl_sep opts (sw:simpl_sw) core_td stg_td - Nothing -> simpl_sep opts simpl_sw core_td stg_td - -matchSimplSw opt - = firstJust [ matchSwInt opt "-fmax-simplifier-iterations" MaxSimplifierIterations - , matchSwInt opt "-finline-phase" SimplInlinePhase - , matchSwBool opt "-fno-rules" DontApplyRules - , matchSwBool opt "-fno-case-of-case" NoCaseOfCase - , matchSwBool opt "-flet-to-case" SimplLetToCase - ] - -matchSwBool :: String -> String -> a -> Maybe a -matchSwBool opt str sw | opt == str = Just sw - | otherwise = Nothing - -matchSwInt :: String -> String -> (Int -> a) -> Maybe a -matchSwInt opt str sw = case startsWith str opt of - Just opt_left -> Just (sw (read opt_left)) - Nothing -> Nothing +\begin{code} +isStaticHscFlag f = + f `elem` [ + "fauto-sccs-on-all-toplevs", + "fauto-sccs-on-exported-toplevs", + "fauto-sccs-on-individual-cafs", + "fauto-sccs-on-dicts", + "fscc-profiling", + "fticky-ticky", + "fall-strict", + "fdicts-strict", + "firrefutable-tuples", + "fnumbers-strict", + "fparallel", + "fsmp", + "fsemi-tagging", + "ffoldr-build-on", + "flet-no-escape", + "funfold-casms-in-hi-file", + "fusagesp-on", + "funbox-strict-fields", + "femit-extern-decls", + "fglobalise-toplev-names", + "fgransim", + "fignore-asserts", + "fignore-interface-pragmas", + "fno-hi-version-check", + "dno-black-holing", + "fno-method-sharing", + "fno-monomorphism-restriction", + "fomit-interface-pragmas", + "fkeep-stg-types", + "fno-pre-inlining", + "fdo-eta-reduction", + "fdo-lambda-eta-expansion", + "fcase-merge", + "fexcess-precision", + "funfolding-update-in-place", + "fno-prune-decls", + "fno-prune-tydecls", + "static", + "funregisterised" + ] + || any (flip prefixMatch f) [ + "fcontext-stack", + "fliberate-case-threshold", + "fhistory-size", + "funfolding-interface-threshold", + "funfolding-creation-threshold", + "funfolding-use-threshold", + "funfolding-fun-discount", + "funfolding-keeness-factor" + ] \end{code} %************************************************************************ @@ -653,23 +600,22 @@ matchSwInt opt str sw = case startsWith str opt of %* * %************************************************************************ -In spite of the @Produce*@ constructor, these things behave just like -enumeration types. +These things behave just like enumeration types. \begin{code} instance Eq SimplifierSwitch where - a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b + a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b instance Ord SimplifierSwitch where - a < b = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b - a <= b = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b + 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) +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! @@ -684,7 +630,6 @@ lAST_SIMPL_SWITCH_TAG = 5 \begin{code} isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult - isAmongSimpl on_switches -- Switches mentioned later occur *earlier* -- in the list; defaults right at the end. = let @@ -718,9 +663,12 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* #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! + 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 @@ -729,15 +677,10 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* else switch : switches_so_far where sw `is_elem` [] = False - sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s) + sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s) || sw `is_elem` ss \end{code} -Default settings for simplifier switches - -\begin{code} -defaultSimplSwitches = [MaxSimplifierIterations 1] -\end{code} %************************************************************************ %* *