%
-% (c) The AQUA Project, Glasgow University, 1996-98
+% (c) The University of Glasgow, 1996-2000
%
\section[CmdLineOpts]{Things to do with command-line options}
module CmdLineOpts (
CoreToDo(..),
- SimplifierSwitch(..),
+ SimplifierSwitch(..), isAmongSimpl,
StgToDo(..),
SwitchResult(..),
HscLang(..),
- classifyOpts,
+ DynFlag(..), -- needed non-abstractly by DriverFlags
+ DynFlags(..),
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_PprUserLength,
opt_PprStyle_Debug,
+ dopt,
+
-- other dynamic flags
dopt_CoreToDo,
dopt_StgToDo,
-
- -- 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,
+ dopt_HscLang,
+ dopt_OutName,
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AllStrict,
opt_DictsStrict,
opt_MaxContextReductionDepth,
- dopt_AllowOverlappingInstances,
- dopt_AllowUndecidableInstances,
- dopt_GlasgowExts,
- opt_Generics,
opt_IrrefutableTuples,
opt_NumbersStrict,
opt_Parallel,
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_Verbose
) where
#include "HsVersions.h"
import GlaExts
import Argv
import Constants -- Default values for some flags
+import Util
+import FastTypes
import Maybes ( firstJust )
import Panic ( panic )
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:
| CoreDoWorkerWrapper
| CoreDoSpecialising
| CoreDoUSPInf
- | CoreDoCPResult
+ | CoreDoCPResult
| CoreDoGlomBinds
| CoreCSE
+
+ | CoreDoNothing -- useful when building up lists of these things
\end{code}
\begin{code}
| 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
+
+ -- misc
+ | Opt_ReportCompile
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 file in which to place output
+ 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 :: DynFlag -> DynFlags -> Bool
+dopt f dflags = f `elem` (flags dflags)
dopt_CoreToDo :: DynFlags -> CoreToDo
dopt_CoreToDo = coreToDo
dopt_StgToDo :: DynFlags -> StgToDo
dopt_StgToDo = stgToDo
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
+
data HscLang
= HscC
| HscAsm
| HscJava
- deriving Eq
+ | HscInterpreter
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
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")
-- language opts
opt_AllStrict = lookUp SLIT("-fall-strict")
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")
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'
-}
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
\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",
+ "-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*@ 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!
\begin{code}
isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-
isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
-- in the list; defaults right at the end.
= let
#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