X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FStaticFlagParser.hs;h=5767a52552997e6a835f205116ed03d8dd8c56c9;hp=f3d737cbd74ae773caffacb1bf69beb490200d3c;hb=da9d10064c084fed395e6030b1cb82bee2b140ed;hpb=0c5a05841df790c3d6b8537debc3b18aa8da98c5 diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs index f3d737c..5767a52 100644 --- a/compiler/main/StaticFlagParser.hs +++ b/compiler/main/StaticFlagParser.hs @@ -13,7 +13,9 @@ module StaticFlagParser (parseStaticFlags) where #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 @@ -53,7 +55,7 @@ parseStaticFlags args = do -- 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 @@ -101,52 +103,73 @@ static_flags :: [Flag IO] 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 "eventlog" (NoArg (addWay WayEventLog)) 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 "dstub-dead-values" (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 ----- 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-" options cancel out "-f" on the hsc cmdline , Flag "fno-" (PrefixPred (\s -> isStaticFlag ("f"++s)) (\s -> removeOpt ("-f"++s))) - Supported + -- Pass all remaining "-f" 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` [ @@ -160,9 +183,9 @@ isStaticFlag f = "dno-black-holing", "fno-state-hack", "fsimple-list-literals", - "fno-ds-multi-tyvar", "fruntime-types", "fno-pre-inlining", + "fno-opt-coercion", "fexcess-precision", "static", "fhardwire-lib-paths", @@ -177,6 +200,7 @@ isStaticFlag f = "fmax-worker-args", "fhistory-size", "funfolding-creation-threshold", + "funfolding-dict-threshold", "funfolding-use-threshold", "funfolding-fun-discount", "funfolding-keeness-factor" @@ -186,9 +210,7 @@ unregFlags :: [Located String] 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 @@ -204,6 +226,18 @@ decodeSize str 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