X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=64ed4adaf5d9170b37983b0f99bca6ff63f731b6;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=7a4799bc5b07388ff1cea0d5f2471904bd321b46;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 7a4799b..64ed4ad 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -20,7 +20,6 @@ module CmdLineOpts ( -- Manipulating DynFlags defaultDynFlags, -- DynFlags - defaultHscLang, -- HscLang dopt, -- DynFlag -> DynFlags -> Bool dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags dopt_CoreToDo, -- DynFlags -> [CoreToDo] @@ -42,13 +41,10 @@ module CmdLineOpts ( restoreDynFlags, -- IO DynFlags -- sets of warning opts - standardWarnings, minusWOpts, minusWallOpts, -- Output style options - opt_PprStyle_NoPrags, - opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, @@ -56,24 +52,21 @@ module CmdLineOpts ( opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs, opt_AutoSccsOnIndividualCafs, - opt_AutoSccsOnDicts, opt_SccProfilingOn, opt_DoTickyProfiling, -- language opts - opt_AllStrict, opt_DictsStrict, opt_MaxContextReductionDepth, opt_IrrefutableTuples, - opt_NumbersStrict, opt_Parallel, opt_SMP, opt_RuntimeTypes, opt_Flatten, -- optimisation opts - opt_NoMethodSharing, - opt_DoSemiTagging, + opt_NoMethodSharing, + opt_NoStateHack, opt_LiberateCaseThreshold, opt_CprOff, opt_RulesOff, @@ -87,19 +80,17 @@ module CmdLineOpts ( opt_UF_FunAppDiscount, opt_UF_KeenessFactor, opt_UF_UpdateInPlace, - opt_UF_CheapOp, opt_UF_DearOp, -- misc opts + opt_ErrorSpans, opt_InPackage, opt_EmitCExternDecls, opt_EnsureSplittableC, opt_GranMacros, opt_HiVersion, opt_HistorySize, - opt_NoHiCheck, opt_OmitBlackHoling, - opt_NoPruneDecls, opt_Static, opt_Unregisterised, opt_EmitExternalCore @@ -113,6 +104,7 @@ import FastString ( FastString, mkFastString ) import Config import Maybes ( firstJust ) +import Panic ( ghcError, GhcException(UsageError) ) import GLAEXTS import DATA_IOREF ( IORef, readIORef, writeIORef ) import UNSAFE_IO ( unsafePerformIO ) @@ -218,7 +210,7 @@ data FloatOutSwitches data DynFlag -- debugging flags - = Opt_D_dump_absC + = Opt_D_dump_cmm | Opt_D_dump_asm | Opt_D_dump_cpranal | Opt_D_dump_deriv @@ -228,7 +220,6 @@ data DynFlag | Opt_D_dump_inlinings | Opt_D_dump_occur_anal | Opt_D_dump_parsed - | Opt_D_dump_realC | Opt_D_dump_rn | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations @@ -243,7 +234,7 @@ data DynFlag | Opt_D_dump_worker_wrapper | Opt_D_dump_rn_trace | Opt_D_dump_rn_stats - | Opt_D_dump_stix + | Opt_D_dump_opt_cmm | Opt_D_dump_simpl_stats | Opt_D_dump_tc_trace | Opt_D_dump_if_trace @@ -258,6 +249,7 @@ data DynFlag | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting + | Opt_DoCmmLinting | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports @@ -274,7 +266,7 @@ data DynFlag | Opt_WarnUnusedImports | Opt_WarnUnusedMatches | Opt_WarnDeprecations - | Opt_WarnMisc + | Opt_WarnDodgyImports -- language opts | Opt_AllowOverlappingInstances @@ -292,6 +284,7 @@ data DynFlag -- optimisation opts | Opt_Strictness + | Opt_FullLaziness | Opt_CSE | Opt_IgnoreInterfacePragmas | Opt_OmitInterfacePragmas @@ -383,8 +376,9 @@ defaultDynFlags = DynFlags { Opt_Strictness, -- strictness is on by default, but this only -- applies to -O. - Opt_CSE, - -- similarly for CSE. + Opt_CSE, -- similarly for CSE. + Opt_FullLaziness, -- ...and for full laziness + Opt_DoLambdaEtaExpansion, -- This one is important for a tiresome reason: -- we want to make sure that the bindings for data @@ -395,7 +389,7 @@ defaultDynFlags = DynFlags { Opt_IgnoreInterfacePragmas, Opt_OmitInterfacePragmas - ] ++ standardWarnings, + ] ++ standardWarnings } {- @@ -488,11 +482,12 @@ opt_1_dopts = [ buildCoreToDo :: DynFlags -> [CoreToDo] buildCoreToDo dflags = core_todo where - opt_level = optLevel dflags - max_iter = maxSimplIterations dflags - strictness = dopt Opt_Strictness dflags - cse = dopt Opt_CSE dflags - rule_check = ruleCheck dflags + opt_level = optLevel dflags + max_iter = maxSimplIterations dflags + strictness = dopt Opt_Strictness dflags + full_laziness = dopt Opt_FullLaziness dflags + cse = dopt Opt_CSE dflags + rule_check = ruleCheck dflags core_todo = if opt_level == 0 then @@ -526,7 +521,9 @@ buildCoreToDo dflags = core_todo -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - CoreDoFloatOutwards (FloatOutSw False False), + if full_laziness then CoreDoFloatOutwards (FloatOutSw False False) + else CoreDoNothing, + CoreDoFloatInwards, CoreDoSimplify (SimplPhase 2) [ @@ -574,8 +571,10 @@ buildCoreToDo dflags = core_todo MaxSimplifierIterations max_iter ], - CoreDoFloatOutwards (FloatOutSw False -- Not lambdas - True), -- Float constants + if full_laziness then + CoreDoFloatOutwards (FloatOutSw False -- Not lambdas + True) -- Float constants + else CoreDoNothing, -- nofib/spectral/hartel/wang doubles in speed if you -- do full laziness late in the day. It only happens -- after fusion and other stuff, so the early pass doesn't @@ -676,7 +675,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, - Opt_WarnMisc + Opt_WarnDodgyImports ] minusWallOpts @@ -710,19 +709,36 @@ packed_static_opts = map mkFastString unpacked_static_opts lookUp sw = sw `elem` packed_static_opts -lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts) +-- (lookup_str "foo") looks for the flag -foo=X or -fooX, +-- and returns the string X +lookup_str sw + = case firstJust (map (startsWith sw) unpacked_static_opts) of + Just ('=' : str) -> Just str + Just str -> Just str + Nothing -> Nothing lookup_int sw = case (lookup_str sw) of Nothing -> Nothing - Just xx -> Just (read xx) + Just xx -> Just (try_read sw xx) lookup_def_int sw def = case (lookup_str sw) of Nothing -> def -- Use default - Just xx -> read xx + Just xx -> try_read sw xx lookup_def_float sw def = case (lookup_str sw) of Nothing -> def -- Use default - Just xx -> read xx + Just xx -> try_read sw xx + + +try_read :: Read a => String -> String -> a +-- (try_read sw str) tries to read s; if it fails, it +-- bleats about flag sw +try_read sw str + = 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 + -- and announce errors in a more civilised way. {- @@ -750,16 +766,13 @@ unpacked_opts = \begin{code} -- debugging opts -opt_PprStyle_NoPrags = lookUp FSLIT("-dppr-noprags") opt_PprStyle_Debug = lookUp FSLIT("-dppr-debug") -opt_PprStyle_RawTypes = lookUp FSLIT("-dppr-rawtypes") opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name -- profiling opts opt_AutoSccsOnAllToplevs = lookUp FSLIT("-fauto-sccs-on-all-toplevs") opt_AutoSccsOnExportedToplevs = lookUp FSLIT("-fauto-sccs-on-exported-toplevs") opt_AutoSccsOnIndividualCafs = lookUp FSLIT("-fauto-sccs-on-individual-cafs") -opt_AutoSccsOnDicts = lookUp FSLIT("-fauto-sccs-on-dicts") opt_SccProfilingOn = lookUp FSLIT("-fscc-profiling") opt_DoTickyProfiling = lookUp FSLIT("-fticky-ticky") @@ -768,14 +781,13 @@ opt_AllStrict = lookUp FSLIT("-fall-strict") opt_DictsStrict = lookUp FSLIT("-fdicts-strict") opt_IrrefutableTuples = lookUp FSLIT("-firrefutable-tuples") opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH -opt_NumbersStrict = lookUp FSLIT("-fnumbers-strict") opt_Parallel = lookUp FSLIT("-fparallel") opt_SMP = lookUp FSLIT("-fsmp") opt_Flatten = lookUp FSLIT("-fflatten") -- optimisation opts +opt_NoStateHack = lookUp FSLIT("-fno-state-hack") opt_NoMethodSharing = lookUp FSLIT("-fno-method-sharing") -opt_DoSemiTagging = lookUp FSLIT("-fsemi-tagging") opt_CprOff = lookUp FSLIT("-fcpr-off") opt_RulesOff = lookUp FSLIT("-frules-off") -- Switch off CPR analysis in the new demand analyser @@ -796,7 +808,6 @@ opt_EnsureSplittableC = lookUp FSLIT("-fglobalise-toplev-names") opt_GranMacros = lookUp FSLIT("-fgransim") opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int opt_HistorySize = lookup_def_int "-fhistory-size" 20 -opt_NoHiCheck = lookUp FSLIT("-fno-hi-version-check") opt_OmitBlackHoling = lookUp FSLIT("-dno-black-holing") opt_RuntimeTypes = lookUp FSLIT("-fruntime-types") @@ -813,13 +824,14 @@ opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) - opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Float) opt_UF_UpdateInPlace = lookUp FSLIT("-funfolding-update-in-place") -opt_UF_CheapOp = ( 1 :: Int) -- Only one instruction; and the args are charged for opt_UF_DearOp = ( 4 :: Int) -opt_NoPruneDecls = lookUp FSLIT("-fno-prune-decls") opt_Static = lookUp FSLIT("-static") opt_Unregisterised = lookUp FSLIT("-funregisterised") opt_EmitExternalCore = lookUp FSLIT("-fext-core") + +-- Include full span info in error messages, instead of just the start position. +opt_ErrorSpans = lookUp FSLIT("-ferror-spans") \end{code} %************************************************************************ @@ -840,7 +852,6 @@ isStaticHscFlag f = "fall-strict", "fdicts-strict", "firrefutable-tuples", - "fnumbers-strict", "fparallel", "fsmp", "fflatten", @@ -852,17 +863,18 @@ isStaticHscFlag f = "fno-hi-version-check", "dno-black-holing", "fno-method-sharing", + "fno-state-hack", "fruntime-types", "fno-pre-inlining", "fexcess-precision", "funfolding-update-in-place", - "fno-prune-decls", "static", "funregisterised", "fext-core", "frule-check", "frules-off", - "fcpr-off" + "fcpr-off", + "ferror-spans" ] || any (flip prefixMatch f) [ "fcontext-stack",