-%
+
% (c) The University of Glasgow, 1996-2000
%
\section[CmdLineOpts]{Things to do with command-line options}
SimplifierSwitch(..), isAmongSimpl,
StgToDo(..),
SwitchResult(..),
+
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags(..),
+ 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,
-
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs,
opt_NumbersStrict,
opt_Parallel,
opt_SMP,
+ opt_NoMonomorphismRestriction,
+ opt_RuntimeTypes,
-- optimisation opts
+ opt_NoMethodSharing,
opt_DoSemiTagging,
opt_FoldrBuildOn,
opt_LiberateCaseThreshold,
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,
opt_IgnoreAsserts,
opt_IgnoreIfacePragmas,
opt_NoHiCheck,
- opt_NoImplicitPrelude,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
opt_NoPruneTyDecls,
opt_NoPruneDecls,
opt_Static,
opt_Unregisterised,
- opt_Verbose
+ opt_EmitExternalCore
) where
#include "HsVersions.h"
import Array ( array, (//) )
import GlaExts
-import Argv
+import IOExts ( IORef, readIORef, writeIORef )
import Constants -- Default values for some flags
import Util
import FastTypes
+import Config
import Maybes ( firstJust )
import Panic ( panic )
| CoreDoStrictness
| CoreDoWorkerWrapper
| CoreDoSpecialising
+ | CoreDoSpecConstr
| CoreDoUSPInf
| CoreDoCPResult
| CoreDoGlomBinds
\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
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
| 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
| 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_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
+ | Opt_WarnMisc
-- language opts
| Opt_AllowOverlappingInstances
| Opt_AllowUndecidableInstances
| Opt_GlasgowExts
| Opt_Generics
+ | Opt_NoImplicitPrelude
- -- misc
- | Opt_ReportCompile
deriving (Eq)
data DynFlags = DynFlags {
- coreToDo :: CoreToDo,
- stgToDo :: StgToDo,
- hscLang :: HscLang,
- 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?
+ 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]
}
+data HscLang
+ = HscC
+ | HscAsm
+ | HscJava
+ | HscILX
+ | HscInterpreted
+ deriving (Eq, Show)
+
+defaultDynFlags = DynFlags {
+ coreToDo = [], stgToDo = [],
+ hscLang = HscC,
+ hscOutName = "",
+ hscStubHOutName = "", hscStubCOutName = "",
+ extCoreName = "",
+ 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 :: DynFlags -> [CoreToDo]
dopt_CoreToDo = coreToDo
-dopt_StgToDo :: DynFlags -> StgToDo
+dopt_StgToDo :: DynFlags -> [StgToDo]
dopt_StgToDo = stgToDo
-data HscLang
- = HscC
- | HscAsm
- | HscJava
- | HscInterpreter
- deriving Eq
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
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}
%************************************************************************
%************************************************************************
\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
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
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]
-- 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
-- profiling opts
-- language opts
opt_AllStrict = lookUp SLIT("-fall-strict")
+opt_NoMonomorphismRestriction = lookUp SLIT("-fno-monomorphism-restriction")
opt_DictsStrict = lookUp SLIT("-fdicts-strict")
opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
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
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_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
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_Verbose = lookUp SLIT("-v")
+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}
%************************************************************************
\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" ]
+ "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",
+ "fruntime-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",
+ "fext-core"
+ ]
|| 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"
+ "fcontext-stack",
+ "fliberate-case-threshold",
+ "fmax-worker-args",
+ "fhistory-size",
+ "funfolding-creation-threshold",
+ "funfolding-use-threshold",
+ "funfolding-fun-discount",
+ "funfolding-keeness-factor"
]
\end{code}
|| sw `is_elem` ss
\end{code}
-Default settings for simplifier switches
-
-\begin{code}
-defaultSimplSwitches = [MaxSimplifierIterations 1]
-\end{code}
%************************************************************************
%* *
projects / ghc-hetmet.git / blobdiff