-- Output style options
opt_PprUserLength,
+ opt_PprCols,
+ opt_PprCaseAsLet,
+ opt_PprStyle_Debug, opt_TraceLevel,
+ opt_NoDebugOutput,
+
+ -- Suppressing boring aspects of core dumps
+ opt_SuppressAll,
opt_SuppressUniques,
opt_SuppressCoercions,
- opt_PprStyle_Debug,
- opt_NoDebugOutput,
+ opt_SuppressModulePrefixes,
+ opt_SuppressTypeApplications,
+ opt_SuppressIdInfo,
+ opt_SuppressTypeSignatures,
-- profiling opts
opt_SccProfilingOn,
opt_Parallel,
-- optimisation opts
- opt_DsMultiTyVar,
opt_NoStateHack,
opt_SimpleListLiterals,
opt_CprOff,
opt_SimplNoPreInlining,
opt_SimplExcessPrecision,
+ opt_NoOptCoercion,
opt_MaxWorkerArgs,
-- Unfolding control
import Config
import FastString
import Util
-import Maybes ( firstJust )
+import Maybes ( firstJusts )
import Panic
import Data.Maybe ( listToMaybe )
-- (lookup_str "foo") looks for the flag -foo=X or -fooX,
-- and returns the string X
lookup_str sw
- = case firstJust (map (stripPrefix sw) staticFlags) of
+ = case firstJusts (map (stripPrefix sw) staticFlags) of
Just ('=' : str) -> Just str
Just str -> Just str
Nothing -> Nothing
= case reads str of
((x,_):_) -> x -- Be forgiving: ignore trailing goop, and alternative parses
[] -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
- -- ToDo: hack alert. We should really parse the arugments
+ -- ToDo: hack alert. We should really parse the arguments
-- and announce errors in a more civilised way.
opt_IgnoreDotGhci :: Bool
opt_IgnoreDotGhci = lookUp (fsLit "-ignore-dot-ghci")
--- debugging opts
-opt_SuppressUniques :: Bool
-opt_SuppressUniques = lookUp (fsLit "-dsuppress-uniques")
+-- debugging options
+-- | Suppress all that is suppressable in core dumps.
+-- Except for uniques, as some simplifier phases introduce new varibles that
+-- have otherwise identical names.
+opt_SuppressAll :: Bool
+opt_SuppressAll
+ = lookUp (fsLit "-dsuppress-all")
+
+-- | Suppress all coercions, them replacing with '...'
opt_SuppressCoercions :: Bool
-opt_SuppressCoercions = lookUp (fsLit "-dsuppress-coercions")
+opt_SuppressCoercions
+ = lookUp (fsLit "-dsuppress-all")
+ || lookUp (fsLit "-dsuppress-coercions")
+
+-- | Suppress module id prefixes on variables.
+opt_SuppressModulePrefixes :: Bool
+opt_SuppressModulePrefixes
+ = lookUp (fsLit "-dsuppress-all")
+ || lookUp (fsLit "-dsuppress-module-prefixes")
+
+-- | Suppress type applications.
+opt_SuppressTypeApplications :: Bool
+opt_SuppressTypeApplications
+ = lookUp (fsLit "-dsuppress-all")
+ || lookUp (fsLit "-dsuppress-type-applications")
+
+-- | Suppress info such as arity and unfoldings on identifiers.
+opt_SuppressIdInfo :: Bool
+opt_SuppressIdInfo
+ = lookUp (fsLit "-dsuppress-all")
+ || lookUp (fsLit "-dsuppress-idinfo")
+
+-- | Suppress seprate type signatures in core, but leave types on lambda bound vars
+opt_SuppressTypeSignatures :: Bool
+opt_SuppressTypeSignatures
+ = lookUp (fsLit "-dsuppress-all")
+ || lookUp (fsLit "-dsuppress-type-signatures")
+
+-- | Suppress unique ids on variables.
+-- Except for uniques, as some simplifier phases introduce new variables that
+-- have otherwise identical names.
+opt_SuppressUniques :: Bool
+opt_SuppressUniques
+ = lookUp (fsLit "-dsuppress-uniques")
+
+-- | Display case expressions with a single alternative as strict let bindings
+opt_PprCaseAsLet :: Bool
+opt_PprCaseAsLet = lookUp (fsLit "-dppr-case-as-let")
+
+-- | Set the maximum width of the dumps
+-- If GHC's command line options are bad then the options parser uses the
+-- pretty printer display the error message. In this case the staticFlags
+-- won't be initialized yet, so we must check for this case explicitly
+-- and return the default value.
+opt_PprCols :: Int
+opt_PprCols
+ = unsafePerformIO
+ $ do ready <- readIORef v_opt_C_ready
+ if (not ready)
+ then return 100
+ else return $ lookup_def_int "-dppr-cols" 100
+
+
opt_PprStyle_Debug :: Bool
-opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
+opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
+
+opt_TraceLevel :: Int
+opt_TraceLevel = lookup_def_int "-dtrace-level" 1 -- Standard level is 1
+ -- Less verbose is 0
+
opt_PprUserLength :: Int
opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
+
opt_Fuel :: Int
opt_Fuel = lookup_def_int "-dopt-fuel" maxBound
+
opt_NoDebugOutput :: Bool
opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output")
-
-- profiling opts
opt_SccProfilingOn :: Bool
opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling")
-- language opts
opt_DictsStrict :: Bool
opt_DictsStrict = lookUp (fsLit "-fdicts-strict")
+
opt_IrrefutableTuples :: Bool
opt_IrrefutableTuples = lookUp (fsLit "-firrefutable-tuples")
+
opt_Parallel :: Bool
opt_Parallel = lookUp (fsLit "-fparallel")
--- optimisation opts
-opt_DsMultiTyVar :: Bool
-opt_DsMultiTyVar = not (lookUp (fsLit "-fno-ds-multi-tyvar"))
- -- On by default
-
opt_SimpleListLiterals :: Bool
opt_SimpleListLiterals = lookUp (fsLit "-fsimple-list-literals")
opt_GranMacros :: Bool
opt_GranMacros = lookUp (fsLit "-fgransim")
+
opt_HiVersion :: Integer
opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
+
opt_HistorySize :: Int
opt_HistorySize = lookup_def_int "-fhistory-size" 20
+
opt_OmitBlackHoling :: Bool
opt_OmitBlackHoling = lookUp (fsLit "-dno-black-holing")
+
opt_StubDeadValues :: Bool
opt_StubDeadValues = lookUp (fsLit "-dstub-dead-values")
opt_SimplExcessPrecision :: Bool
opt_SimplExcessPrecision = lookUp (fsLit "-fexcess-precision")
+opt_NoOptCoercion :: Bool
+opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion")
+
-- Unfolding control
-- See Note [Discounts and thresholds] in CoreUnfold
opt_UF_DearOp, opt_UF_FunAppDiscount, opt_UF_DictDiscount :: Int
opt_UF_KeenessFactor :: Float
-opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int)
-opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (6::Int)
-opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int)
-opt_UF_DictDiscount = lookup_def_int "-funfolding-dict-discount" (1::Int)
+opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (450::Int)
+opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (60::Int)
+opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (60::Int)
+
+opt_UF_DictDiscount = lookup_def_int "-funfolding-dict-discount" (30::Int)
+ -- Be fairly keen to inline a fuction if that means
+ -- we'll be able to pick the right method from a dictionary
+
opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Float)
-opt_UF_DearOp = ( 4 :: Int)
+opt_UF_DearOp = ( 40 :: Int)
-- Related to linking
-- the problems are our fault or theirs, but it seems that using the
-- alternative 1:1 threading library libthr works around it:
"-optl-lthr"
+#elif defined(openbsd_TARGET_OS)
+ "-optc-pthread"
+ , "-optl-pthread"
#elif defined(solaris2_TARGET_OS)
"-optl-lrt"
#endif
-- with -fPIC. Labels not in the current package are assumed to be in a DLL
-- different from the current one.
, "-fPIC"
+#elif defined(openbsd_TARGET_OS)
+ -- Without this, linking the shared libHSffi fails because
+ -- it uses pthread mutexes.
+ , "-optl-pthread"
#endif
],
projects / ghc-hetmet.git / blobdiff