X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=64ed4adaf5d9170b37983b0f99bca6ff63f731b6;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=cedf8cc82d6479b02876c51d09b3f26c55b5d04d;hpb=550421384b8364cdaf3135f7859c9f7d7ee1fff1;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index cedf8cc..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, @@ -103,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 ) @@ -208,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 @@ -218,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 @@ -233,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 @@ -248,6 +249,7 @@ data DynFlag | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting + | Opt_DoCmmLinting | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports @@ -264,7 +266,7 @@ data DynFlag | Opt_WarnUnusedImports | Opt_WarnUnusedMatches | Opt_WarnDeprecations - | Opt_WarnMisc + | Opt_WarnDodgyImports -- language opts | Opt_AllowOverlappingInstances @@ -282,6 +284,7 @@ data DynFlag -- optimisation opts | Opt_Strictness + | Opt_FullLaziness | Opt_CSE | Opt_IgnoreInterfacePragmas | Opt_OmitInterfacePragmas @@ -373,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 @@ -478,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 @@ -516,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) [ @@ -564,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 @@ -666,7 +675,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, - Opt_WarnMisc + Opt_WarnDodgyImports ] minusWallOpts @@ -700,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. {- @@ -760,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") @@ -836,11 +863,11 @@ 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",