#include "HsVersions.h"
-import StaticFlags
+import qualified StaticFlags as SF
+import StaticFlags ( v_opt_C_ready, getWayFlags, tablesNextToCode, WayName(..)
+ , opt_SimplExcessPrecision )
import CmdLineParser
import Config
import SrcLoc
-- deal with the way flags: the way (eg. prof) gives rise to
-- further flags, some of which might be static.
- way_flags <- findBuildTag
+ way_flags <- getWayFlags
let way_flags' = map (mkGeneralLocated "in way flags") way_flags
-- if we're unregisterised, add some more flags
static_flags = [
------- GHCi -------------------------------------------------------
- Flag "ignore-dot-ghci" (PassFlag addOpt) Supported
- , Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci")) Supported
+ Flag "ignore-dot-ghci" (PassFlag addOpt)
+ , Flag "read-dot-ghci" (NoArg (removeOpt "-ignore-dot-ghci"))
------- ways --------------------------------------------------------
- , Flag "prof" (NoArg (addWay WayProf)) Supported
- , Flag "ticky" (NoArg (addWay WayTicky)) Supported
- , Flag "parallel" (NoArg (addWay WayPar)) Supported
- , Flag "gransim" (NoArg (addWay WayGran)) Supported
- , Flag "smp" (NoArg (addWay WayThreaded))
- (Deprecated "Use -threaded instead")
- , Flag "debug" (NoArg (addWay WayDebug)) Supported
- , Flag "ndp" (NoArg (addWay WayNDP)) Supported
- , Flag "threaded" (NoArg (addWay WayThreaded)) Supported
- -- ToDo: user ways
+ , Flag "prof" (NoArg (addWay WayProf))
+ , Flag "eventlog" (NoArg (addWay WayEventLog))
+ , Flag "parallel" (NoArg (addWay WayPar))
+ , Flag "gransim" (NoArg (addWay WayGran))
+ , Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
+ , Flag "debug" (NoArg (addWay WayDebug))
+ , Flag "ndp" (NoArg (addWay WayNDP))
+ , Flag "threaded" (NoArg (addWay WayThreaded))
+
+ , Flag "ticky" (PassFlag (\f -> do addOpt f; addWay WayDebug))
+ -- -ticky enables ticky-ticky code generation, and also implies -debug which
+ -- is required to get the RTS ticky support.
------ Debugging ----------------------------------------------------
- , Flag "dppr-debug" (PassFlag addOpt) Supported
- , Flag "dsuppress-uniques" (PassFlag addOpt) Supported
- , Flag "dppr-user-length" (AnySuffix addOpt) Supported
- , Flag "dopt-fuel" (AnySuffix addOpt) Supported
- , Flag "dno-debug-output" (PassFlag addOpt) Supported
+ , Flag "dppr-debug" (PassFlag addOpt)
+ , Flag "dppr-cols" (AnySuffix addOpt)
+ , Flag "dppr-user-length" (AnySuffix addOpt)
+ , Flag "dppr-case-as-let" (PassFlag addOpt)
+ , Flag "dsuppress-all" (PassFlag addOpt)
+ , Flag "dsuppress-uniques" (PassFlag addOpt)
+ , Flag "dsuppress-coercions" (PassFlag addOpt)
+ , Flag "dsuppress-module-prefixes" (PassFlag addOpt)
+ , Flag "dsuppress-type-applications" (PassFlag addOpt)
+ , Flag "dsuppress-idinfo" (PassFlag addOpt)
+ , Flag "dsuppress-type-signatures" (PassFlag addOpt)
+ , Flag "dopt-fuel" (AnySuffix addOpt)
+ , Flag "dtrace-level" (AnySuffix addOpt)
+ , Flag "dno-debug-output" (PassFlag addOpt)
+ , Flag "dstub-dead-values" (PassFlag addOpt)
-- rest of the debugging flags are dynamic
- --------- Profiling --------------------------------------------------
- , Flag "auto-all" (NoArg (addOpt "-fauto-sccs-on-all-toplevs"))
- Supported
- , Flag "auto" (NoArg (addOpt "-fauto-sccs-on-exported-toplevs"))
- Supported
- , Flag "caf-all" (NoArg (addOpt "-fauto-sccs-on-individual-cafs"))
- Supported
- -- "ignore-sccs" doesn't work (ToDo)
-
- , Flag "no-auto-all" (NoArg (removeOpt "-fauto-sccs-on-all-toplevs"))
- Supported
- , Flag "no-auto" (NoArg (removeOpt "-fauto-sccs-on-exported-toplevs"))
- Supported
- , Flag "no-caf-all" (NoArg (removeOpt "-fauto-sccs-on-individual-cafs"))
- Supported
-
----- Linker --------------------------------------------------------
- , Flag "static" (PassFlag addOpt) Supported
- , Flag "dynamic" (NoArg (removeOpt "-static")) Supported
+ , Flag "static" (PassFlag addOpt)
+ , Flag "dynamic" (NoArg (removeOpt "-static" >> addWay WayDyn))
-- ignored for compat w/ gcc:
- , Flag "rdynamic" (NoArg (return ())) Supported
+ , Flag "rdynamic" (NoArg (return ()))
----- RTS opts ------------------------------------------------------
- , Flag "H" (HasArg (setHeapSize . fromIntegral . decodeSize))
- Supported
- , Flag "Rghc-timing" (NoArg (enableTimingStats)) Supported
+ , Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
+
+ , Flag "Rghc-timing" (NoArg (liftEwM enableTimingStats))
------ Compiler flags -----------------------------------------------
+
+ -- -fPIC requires extra checking: only the NCG supports it.
+ -- See also DynFlags.parseDynamicFlags.
+ , Flag "fPIC" (PassFlag setPIC)
+
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, Flag "fno-"
(PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s)))
- Supported
+
-- Pass all remaining "-f<blah>" options to hsc
- , Flag "f" (AnySuffixPred (isStaticFlag) addOpt)
- Supported
+ , Flag "f" (AnySuffixPred isStaticFlag addOpt)
]
+setPIC :: String -> StaticP ()
+setPIC | cGhcWithNativeCodeGen == "YES" || cGhcUnregisterised == "YES"
+ = addOpt
+ | otherwise
+ = ghcError $ CmdLineError "-fPIC is not supported on this platform"
+
isStaticFlag :: String -> Bool
isStaticFlag f =
f `elem` [
- "fauto-sccs-on-all-toplevs",
- "fauto-sccs-on-exported-toplevs",
- "fauto-sccs-on-individual-cafs",
"fscc-profiling",
"fdicts-strict",
"fspec-inline-join-points",
"fgransim",
"fno-hi-version-check",
"dno-black-holing",
- "fno-method-sharing",
"fno-state-hack",
- "fno-ds-multi-tyvar",
+ "fsimple-list-literals",
"fruntime-types",
"fno-pre-inlining",
+ "fno-opt-coercion",
"fexcess-precision",
"static",
"fhardwire-lib-paths",
"funregisterised",
- "fext-core",
"fcpr-off",
"ferror-spans",
"fPIC",
"fmax-worker-args",
"fhistory-size",
"funfolding-creation-threshold",
+ "funfolding-dict-threshold",
"funfolding-use-threshold",
"funfolding-fun-discount",
"funfolding-keeness-factor"
unregFlags = map (mkGeneralLocated "in unregFlags")
[ "-optc-DNO_REGS"
, "-optc-DUSE_MINIINTERPRETER"
- , "-fno-asm-mangling"
- , "-funregisterised"
- , "-fvia-C" ]
+ , "-funregisterised" ]
-----------------------------------------------------------------------------
-- convert sizes like "3.5M" into integers
n = readRational m
pred c = isDigit c || c == '.'
+
+type StaticP = EwM IO
+
+addOpt :: String -> StaticP ()
+addOpt = liftEwM . SF.addOpt
+
+addWay :: WayName -> StaticP ()
+addWay = liftEwM . SF.addWay
+
+removeOpt :: String -> StaticP ()
+removeOpt = liftEwM . SF.removeOpt
+
-----------------------------------------------------------------------------
-- RTS Hooks