%
-% (c) The AQUA Project, Glasgow University, 1996-98
+% (c) The University of Glasgow, 1996-2000
%
\section[CmdLineOpts]{Things to do with command-line options}
\begin{code}
+
module CmdLineOpts (
CoreToDo(..),
- SimplifierSwitch(..),
+ SimplifierSwitch(..), isAmongSimpl,
StgToDo(..),
SwitchResult(..),
- classifyOpts,
+ HscLang(..),
+ DynFlag(..), -- needed non-abstractly by DriverFlags
+ DynFlags(..),
intSwitchSet,
switchIsOn,
-
- src_filename,
+ isStaticHscFlag,
-- debugging opts
- opt_D_dump_absC,
- opt_D_dump_asm,
- opt_D_dump_cpranal,
- opt_D_dump_cse,
- opt_D_dump_deriv,
- opt_D_dump_ds,
- opt_D_dump_flatC,
- opt_D_dump_foreign,
- opt_D_dump_inlinings,
- opt_D_dump_occur_anal,
- opt_D_dump_parsed,
- opt_D_dump_realC,
- opt_D_dump_rn,
- opt_D_dump_rules,
- opt_D_dump_simpl,
- opt_D_dump_simpl_iterations,
- opt_D_dump_simpl_stats,
- opt_D_dump_spec,
- opt_D_dump_stg,
- opt_D_dump_stranal,
- opt_D_dump_tc,
- opt_D_dump_usagesp,
- opt_D_dump_worker_wrapper,
- opt_D_show_passes,
- opt_D_dump_rn_trace,
- opt_D_dump_rn_stats,
- opt_D_source_stats,
- opt_D_verbose_core2core,
- opt_D_verbose_stg2stg,
- opt_DoCoreLinting,
- opt_DoStgLinting,
- opt_DoUSPLinting,
- opt_PprStyle_Debug,
+ 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,
+
opt_PprStyle_NoPrags,
opt_PprUserLength,
+ opt_PprStyle_Debug,
+
+ -- other dynamic flags
+ dopt_CoreToDo,
+ dopt_StgToDo,
-- warning opts
opt_WarnDuplicateExports,
opt_WarnHiShadows,
opt_WarnIncompletePatterns,
+ opt_WarnMissingFields,
opt_WarnMissingMethods,
opt_WarnMissingSigs,
opt_WarnNameShadowing,
opt_WarnUnusedBinds,
opt_WarnUnusedImports,
opt_WarnUnusedMatches,
+ opt_WarnDeprecations,
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs,
opt_AutoSccsOnIndividualCafs,
opt_AutoSccsOnDicts,
- opt_SccGroup,
opt_SccProfilingOn,
opt_DoTickyProfiling,
opt_AllStrict,
opt_DictsStrict,
opt_MaxContextReductionDepth,
- opt_AllowOverlappingInstances,
- opt_AllowUndecidableInstances,
- opt_GlasgowExts,
+ dopt_AllowOverlappingInstances,
+ dopt_AllowUndecidableInstances,
+ dopt_GlasgowExts,
+ opt_Generics,
opt_IrrefutableTuples,
opt_NumbersStrict,
opt_Parallel,
+ opt_SMP,
-- optimisation opts
- opt_DoEtaReduction,
opt_DoSemiTagging,
opt_FoldrBuildOn,
opt_LiberateCaseThreshold,
- opt_NoPreInlining,
opt_StgDoLetNoEscapes,
opt_UnfoldCasms,
opt_UsageSPOn,
opt_SimplDoLambdaEtaExpansion,
opt_SimplCaseOfCase,
opt_SimplCaseMerge,
- opt_SimplLetToCase,
opt_SimplPedanticBottoms,
+ opt_SimplExcessPrecision,
-- Unfolding control
opt_UF_HiFileThreshold,
opt_UF_CreationThreshold,
opt_UF_UseThreshold,
- opt_UF_ScrutConDiscount,
opt_UF_FunAppDiscount,
- opt_UF_PrimArgDiscount,
opt_UF_KeenessFactor,
+ opt_UF_UpdateInPlace,
opt_UF_CheapOp,
opt_UF_DearOp,
- opt_UF_NoRepLit,
-- misc opts
- opt_CompilingPrelude,
+ opt_InPackage,
opt_EmitCExternDecls,
opt_EnsureSplittableC,
opt_GranMacros,
- opt_HiMap,
opt_HiVersion,
opt_HistorySize,
opt_IgnoreAsserts,
opt_NoImplicitPrelude,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
- opt_ProduceC,
- opt_ProduceExportCStubs,
- opt_ProduceExportHStubs,
- opt_ProduceHi,
- opt_ProduceS,
+ opt_NoPruneTyDecls,
opt_NoPruneDecls,
opt_ReportCompile,
- opt_SourceUnchanged,
opt_Static,
opt_Unregisterised,
opt_Verbose,
import GlaExts
import Argv
import Constants -- Default values for some flags
+import Util
+import FastTypes
-import FastString ( headFS )
-import Maybes ( assocMaybe, firstJust, maybeToBool )
-import Panic ( panic, panic# )
+import Maybes ( firstJust )
+import Panic ( panic )
#if __GLASGOW_HASKELL__ < 301
import ArrBase ( Array(..) )
#endif
\end{code}
-A command-line {\em switch} is (generally) either on or off; e.g., the
-``verbose'' (-v) switch is either on or off. (The \tr{-G<group>}
-switch is an exception; it's set to a string, or nothing.)
+%************************************************************************
+%* *
+\subsection{Command-line options}
+%* *
+%************************************************************************
+
+The hsc command-line options are split into two categories:
+
+ - static flags
+ - dynamic flags
+
+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 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:
A list of {\em ToDo}s is things to be done in a particular part of
processing. A (fictitious) example for the Core-to-Core simplifier
(\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
(\tr{simplStg/SimplStg.lhs}).
-
%************************************************************************
%* *
\subsection{Datatypes associated with command-line options}
-- Each run of the simplifier can take a different
-- set of simplifier-specific flags.
| CoreDoFloatInwards
- | CoreDoFullLaziness
+ | CoreDoFloatOutwards Bool -- True <=> float lambdas to top level
| CoreLiberateCase
| CoreDoPrintCore
| CoreDoStaticArgs
| CoreDoSpecialising
| CoreDoUSPInf
| CoreDoCPResult
+ | CoreDoGlomBinds
| CoreCSE
+
+ | CoreDoNothing -- useful when building up lists of these things
\end{code}
\begin{code}
data StgToDo
= StgDoStaticArgs
- | StgDoUpdateAnalysis
| StgDoLambdaLift
| StgDoMassageForProfiling -- should be (next to) last
-- There's also setStgVarInfo, but its absolute "lastness"
data SimplifierSwitch
= MaxSimplifierIterations Int
| SimplInlinePhase Int
+ | DontApplyRules
+ | NoCaseOfCase
+ | SimplLetToCase
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Dynamic command-line options}
+%* *
+%************************************************************************
+
+\begin{code}
+data DynFlag
+
+ -- debugging flags
+ = Opt_D_dump_all
+ | Opt_D_dump_most
+ | Opt_D_dump_absC
+ | Opt_D_dump_asm
+ | Opt_D_dump_cpranal
+ | Opt_D_dump_deriv
+ | Opt_D_dump_ds
+ | Opt_D_dump_flatC
+ | Opt_D_dump_foreign
+ | Opt_D_dump_inlinings
+ | Opt_D_dump_occur_anal
+ | Opt_D_dump_parsed
+ | Opt_D_dump_realC
+ | Opt_D_dump_rn
+ | Opt_D_dump_simpl
+ | Opt_D_dump_simpl_iterations
+ | Opt_D_dump_spec
+ | Opt_D_dump_stg
+ | Opt_D_dump_stranal
+ | Opt_D_dump_tc
+ | Opt_D_dump_types
+ | Opt_D_dump_rules
+ | 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_source_stats
+ | Opt_D_verbose_core2core
+ | Opt_D_verbose_stg2stg
+ | Opt_D_dump_hi_diffs
+ | Opt_D_dump_minimal_imports
+ | Opt_DoCoreLinting
+ | Opt_DoStgLinting
+ | Opt_DoUSPLinting
+
+ -- language opts
+ | Opt_AllowOverlappingInstances
+ | Opt_AllowUndecidableInstances
+ | Opt_GlasgowExts
+ deriving (Eq)
+
+data DynFlags = DynFlags {
+ coreToDo :: CoreToDo,
+ stgToDo :: StgToDo,
+ hscLang :: HscLang,
+ flags :: [DynFlag]
+ }
+
+boolOpt :: DynFlag -> DynFlags -> Bool
+boolOpt f dflags = f `elem` (flags dflags)
+
+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
+dopt_CoreToDo = coreToDo
+
+dopt_StgToDo :: DynFlags -> StgToDo
+dopt_StgToDo = stgToDo
+
+data HscLang
+ = HscC
+ | HscAsm
+ | HscJava
+ deriving Eq
+
+dopt_HscLang :: DynFlags -> HscLang
+dopt_HscLang = hscLang
\end{code}
%************************************************************************
lookup_def_float :: String -> Float -> Float
lookup_str :: String -> Maybe String
-lookUp sw = maybeToBool (assoc_opts sw)
+lookUp sw = sw `elem` argv
lookup_str sw = firstJust (map (startsWith sw) unpacked_opts)
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
-assoc_opts = assocMaybe [ (a, True) | a <- argv ]
unpacked_opts = map _UNPK_ argv
{-
a pure Win32 application where I think there's a command-line
length limit of 255. unpacked_opts understands the @ option.
-assoc_opts = assocMaybe [ (_PK_ a, True) | a <- unpacked_opts ]
-
unpacked_opts :: [String]
unpacked_opts =
concat $
-}
\end{code}
-\begin{code}
-src_filename :: FAST_STRING
-src_filename = case argv of
- filename : rest | headFS filename /= '-' -> filename
- otherwise -> panic "no filename"
-\end{code}
+%************************************************************************
+%* *
+\subsection{Static options}
+%* *
+%************************************************************************
\begin{code}
-- debugging opts
-opt_D_dump_all {- do not -} = lookUp SLIT("-ddump-all")
-opt_D_dump_most {- export -} = opt_D_dump_all || lookUp SLIT("-ddump-most")
-
-opt_D_dump_absC = opt_D_dump_all || lookUp SLIT("-ddump-absC")
-opt_D_dump_asm = opt_D_dump_all || lookUp SLIT("-ddump-asm")
-opt_D_dump_cpranal = opt_D_dump_most || lookUp SLIT("-ddump-cpranal")
-opt_D_dump_deriv = opt_D_dump_most || lookUp SLIT("-ddump-deriv")
-opt_D_dump_ds = opt_D_dump_most || lookUp SLIT("-ddump-ds")
-opt_D_dump_flatC = opt_D_dump_all || lookUp SLIT("-ddump-flatC")
-opt_D_dump_foreign = opt_D_dump_most || lookUp SLIT("-ddump-foreign-stubs")
-opt_D_dump_inlinings = opt_D_dump_all || lookUp SLIT("-ddump-inlinings")
-opt_D_dump_occur_anal = opt_D_dump_most || lookUp SLIT("-ddump-occur-anal")
-opt_D_dump_parsed = opt_D_dump_most || lookUp SLIT("-ddump-parsed")
-opt_D_dump_realC = opt_D_dump_all || lookUp SLIT("-ddump-realC")
-opt_D_dump_rn = opt_D_dump_most || lookUp SLIT("-ddump-rn")
-opt_D_dump_simpl = opt_D_dump_most || lookUp SLIT("-ddump-simpl")
-opt_D_dump_simpl_iterations = opt_D_dump_all || lookUp SLIT("-ddump-simpl-iterations")
-opt_D_dump_spec = opt_D_dump_most || lookUp SLIT("-ddump-spec")
-opt_D_dump_stg = opt_D_dump_most || lookUp SLIT("-ddump-stg")
-opt_D_dump_stranal = opt_D_dump_most || lookUp SLIT("-ddump-stranal")
-opt_D_dump_tc = opt_D_dump_most || lookUp SLIT("-ddump-tc")
-opt_D_dump_rules = opt_D_dump_most || lookUp SLIT("-ddump-rules")
-opt_D_dump_usagesp = opt_D_dump_most || lookUp SLIT("-ddump-usagesp")
-opt_D_dump_cse = opt_D_dump_most || lookUp SLIT("-ddump-cse")
-opt_D_dump_worker_wrapper = opt_D_dump_most || lookUp SLIT("-ddump-workwrap")
-opt_D_show_passes = opt_D_dump_most || lookUp SLIT("-dshow-passes")
-opt_D_dump_rn_trace = opt_D_dump_all || lookUp SLIT("-ddump-rn-trace")
-opt_D_dump_rn_stats = opt_D_dump_most || lookUp SLIT("-ddump-rn-stats")
-opt_D_dump_simpl_stats = opt_D_dump_most || lookUp SLIT("-ddump-simpl-stats")
-opt_D_source_stats = opt_D_dump_most || lookUp SLIT("-dsource-stats")
-opt_D_verbose_core2core = opt_D_dump_all || lookUp SLIT("-dverbose-simpl")
-opt_D_verbose_stg2stg = opt_D_dump_all || lookUp SLIT("-dverbose-stg")
-
-opt_DoCoreLinting = lookUp SLIT("-dcore-lint")
-opt_DoStgLinting = lookUp SLIT("-dstg-lint")
-opt_DoUSPLinting = lookUp SLIT("-dusagesp-lint")
opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
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_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")
opt_AutoSccsOnIndividualCafs = lookUp SLIT("-fauto-sccs-on-individual-cafs")
opt_AutoSccsOnDicts = lookUp SLIT("-fauto-sccs-on-dicts")
-opt_SccGroup = lookup_str "-G="
opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
-- language opts
opt_AllStrict = lookUp SLIT("-fall-strict")
opt_DictsStrict = lookUp SLIT("-fdicts-strict")
-opt_AllowOverlappingInstances = lookUp SLIT("-fallow-overlapping-instances")
-opt_AllowUndecidableInstances = lookUp SLIT("-fallow-undecidable-instances")
-opt_GlasgowExts = lookUp SLIT("-fglasgow-exts")
+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")
opt_Parallel = lookUp SLIT("-fparallel")
+opt_SMP = lookUp SLIT("-fsmp")
-- optimisation opts
-opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction")
opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
-opt_NoPreInlining = lookUp SLIT("-fno-pre-inlining")
opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")
- {-
- It's a bit unfortunate to have to re-introduce this chap, but on Win32
- platforms we do need a way of distinguishing between the case when we're
- compiling a static version of the Prelude and one that's going to be
- put into a DLL. Why? Because the compiler's wired in modules need to
- be attributed as either coming from a DLL or not.
- -}
-opt_CompilingPrelude = lookUp SLIT("-fcompiling-prelude")
+{-
+ The optional '-inpackage=P' flag tells what package
+ we are compiling this module for.
+ The Prelude, for example is compiled with '-package prelude'
+-}
+opt_InPackage = case lookup_str "-inpackage=" of
+ Just p -> _PK_ p
+ Nothing -> SLIT("Main") -- The package name if none is specified
+
opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls")
opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names")
opt_GranMacros = lookUp SLIT("-fgransim")
-opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files
opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
opt_HistorySize = lookup_def_int "-fhistory-size" 20
opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts")
opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude")
opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas")
-opt_ProduceC = lookup_str "-C="
-opt_ProduceExportCStubs = lookup_str "-F="
-opt_ProduceExportHStubs = lookup_str "-FH="
-opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time
-- Simplifier switches
opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining")
opt_SimplDoLambdaEtaExpansion = lookUp SLIT("-fdo-lambda-eta-expansion")
opt_SimplCaseOfCase = lookUp SLIT("-fcase-of-case")
opt_SimplCaseMerge = lookUp SLIT("-fcase-merge")
-opt_SimplLetToCase = lookUp SLIT("-flet-to-case")
opt_SimplPedanticBottoms = lookUp SLIT("-fpedantic-bottoms")
+opt_SimplExcessPrecision = lookUp SLIT("-fexcess-precision")
-- Unfolding control
-opt_UF_HiFileThreshold = lookup_def_int "-funfolding-interface-threshold" (30::Int)
-opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (30::Int)
+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_ScrutConDiscount = lookup_def_int "-funfolding-con-discount" (2::Int)
opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) -- It's great to inline a fn
-opt_UF_PrimArgDiscount = lookup_def_int "-funfolding-prim-discount" (1::Int)
-opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (2.0::Float)
+opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Float)
+opt_UF_UpdateInPlace = lookUp SLIT("-funfolding-update-in-place")
-opt_UF_CheapOp = ( 0 :: Int) -- Only one instruction; and the args are charged for
+opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for
opt_UF_DearOp = ( 4 :: Int)
-opt_UF_NoRepLit = ( 20 :: Int) -- Strings can be pretty big
-opt_ProduceS = lookup_str "-S="
opt_ReportCompile = lookUp SLIT("-freport-compile")
opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls")
-opt_SourceUnchanged = lookUp SLIT("-fsource-unchanged")
+opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls")
opt_Static = lookUp SLIT("-static")
opt_Unregisterised = lookUp SLIT("-funregisterised")
opt_Verbose = lookUp SLIT("-v")
| otherwise = mAX_Real_Long_REG
\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)
- "-ffull-laziness" -> CORE_TD(CoreDoFullLaziness)
- "-fliberate-case" -> CORE_TD(CoreLiberateCase)
- "-fcse" -> CORE_TD(CoreCSE)
- "-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)
- "-fupdate-analysis" -> STG_TD(StgDoUpdateAnalysis)
- "-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 :: 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` [
+ "-fwarn-duplicate-exports",
+ "-fwarn-hi-shadowing",
+ "-fwarn-incomplete-patterns",
+ "-fwarn-missing-fields",
+ "-fwarn-missing-methods",
+ "-fwarn-missing-signatures",
+ "-fwarn-name-shadowing",
+ "-fwarn-overlapping-patterns",
+ "-fwarn-simple-patterns",
+ "-fwarn-type-defaults",
+ "-fwarn-unused-binds",
+ "-fwarn-unused-imports",
+ "-fwarn-unused-matches",
+ "-fwarn-deprecations",
+ "-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",
+ "-fgenerics",
+ "-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",
+ "-fno-implicit-prelude",
+ "-dno-black-holing",
+ "-fomit-interface-pragmas",
+ "-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",
+ "-v" ]
+ || any (flip prefixMatch f) [
+ "-fcontext-stack",
+ "-fliberate-case-threshold",
+ "-fhi-version=",
+ "-fhistory-size",
+ "-funfolding-interface-threshold",
+ "-funfolding-creation-threshold",
+ "-funfolding-use-threshold",
+ "-funfolding-fun-discount",
+ "-funfolding-keeness-factor"
+ ]
\end{code}
%************************************************************************
%* *
%************************************************************************
-In spite of the @Produce*@ and @SccGroup@ constructors, 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 (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 = 2
+lAST_SIMPL_SWITCH_TAG = 5
\end{code}
%************************************************************************
\begin{code}
isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-
isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
-- in the list; defaults right at the end.
= let
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
#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
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}
projects / ghc-hetmet.git / blobdiff