X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=64ed4adaf5d9170b37983b0f99bca6ff63f731b6;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=5faf8ac67297999fced45f468c3f0588c1f2cf11;hpb=687fa3b2ed2db125575dc7065d4b7044924e66a1;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 5faf8ac..64ed4ad 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -65,7 +65,8 @@ module CmdLineOpts ( opt_Flatten, -- optimisation opts - opt_NoMethodSharing, + opt_NoMethodSharing, + opt_NoStateHack, opt_LiberateCaseThreshold, opt_CprOff, opt_RulesOff, @@ -82,6 +83,7 @@ module CmdLineOpts ( opt_UF_DearOp, -- misc opts + opt_ErrorSpans, opt_InPackage, opt_EmitCExternDecls, opt_EnsureSplittableC, @@ -102,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 ) @@ -207,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 @@ -217,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 @@ -232,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 @@ -247,6 +249,7 @@ data DynFlag | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting + | Opt_DoCmmLinting | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports @@ -263,7 +266,7 @@ data DynFlag | Opt_WarnUnusedImports | Opt_WarnUnusedMatches | Opt_WarnDeprecations - | Opt_WarnMisc + | Opt_WarnDodgyImports -- language opts | Opt_AllowOverlappingInstances @@ -281,6 +284,7 @@ data DynFlag -- optimisation opts | Opt_Strictness + | Opt_FullLaziness | Opt_CSE | Opt_IgnoreInterfacePragmas | Opt_OmitInterfacePragmas @@ -372,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 @@ -477,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 @@ -515,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) [ @@ -563,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 @@ -665,7 +675,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, - Opt_WarnMisc + Opt_WarnDodgyImports ] minusWallOpts @@ -699,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. {- @@ -759,6 +786,7 @@ 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_CprOff = lookUp FSLIT("-fcpr-off") opt_RulesOff = lookUp FSLIT("-frules-off") @@ -801,6 +829,9 @@ opt_UF_DearOp = ( 4 :: Int) 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} %************************************************************************ @@ -832,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",