X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=2be4ce5d7fd768ba1a6d9f8d28de46f82621b51d;hb=5ab261bb3fd75f45a4f219f1399be84208e12463;hp=281571e3220ec21bfd073694d9f593144a8ddb64;hpb=156e58954387c143c4452108d6f3e338917bb64f;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 281571e..2be4ce5 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -14,7 +14,6 @@ module CmdLineOpts ( HscLang(..), DynFlag(..), -- needed non-abstractly by DriverFlags DynFlags(..), - defaultDynFlags, v_Static_hsc_opts, @@ -22,26 +21,35 @@ module CmdLineOpts ( switchIsOn, isStaticHscFlag, - opt_PprStyle_NoPrags, - opt_PprStyle_RawTypes, - opt_PprUserLength, - opt_PprStyle_Debug, - - dopt, - dopt_set, - dopt_unset, - - -- other dynamic flags - dopt_CoreToDo, - dopt_StgToDo, - dopt_HscLang, - dopt_OutName, + -- Manipulating DynFlags + defaultDynFlags, -- DynFlags + dopt, -- DynFlag -> DynFlags -> Bool + dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags + dopt_CoreToDo, -- DynFlags -> [CoreToDo] + dopt_StgToDo, -- DynFlags -> [StgToDo] + dopt_HscLang, -- DynFlags -> HscLang + dopt_OutName, -- DynFlags -> String + + -- Manipulating the DynFlags state + getDynFlags, -- IO DynFlags + setDynFlags, -- DynFlags -> IO () + updDynFlags, -- (DynFlags -> DynFlags) -> IO () + dynFlag, -- (DynFlags -> a) -> IO a + setDynFlag, unSetDynFlag, -- DynFlag -> IO () + saveDynFlags, -- IO () + restoreDynFlags, -- IO DynFlags -- sets of warning opts standardWarnings, minusWOpts, minusWallOpts, + -- Output style options + opt_PprStyle_NoPrags, + opt_PprStyle_RawTypes, + opt_PprUserLength, + opt_PprStyle_Debug, + -- profiling opts opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs, @@ -59,7 +67,7 @@ module CmdLineOpts ( opt_Parallel, opt_SMP, opt_NoMonomorphismRestriction, - opt_KeepStgTypes, + opt_RuntimeTypes, -- optimisation opts opt_NoMethodSharing, @@ -75,6 +83,7 @@ module CmdLineOpts ( opt_SimplDoLambdaEtaExpansion, opt_SimplCaseMerge, opt_SimplExcessPrecision, + opt_MaxWorkerArgs, -- Unfolding control opt_UF_CreationThreshold, @@ -100,14 +109,15 @@ module CmdLineOpts ( opt_NoPruneTyDecls, opt_NoPruneDecls, opt_Static, - opt_Unregisterised + opt_Unregisterised, + opt_EmitExternalCore ) where #include "HsVersions.h" import Array ( array, (//) ) import GlaExts -import IOExts ( IORef, readIORef ) +import IOExts ( IORef, readIORef, writeIORef ) import Constants -- Default values for some flags import Util import FastTypes @@ -191,6 +201,8 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoCPResult | CoreDoGlomBinds | CoreCSE + | CoreDoRuleCheck String -- Check for non-application of rules + -- matching this string | CoreDoNothing -- useful when building up lists of these things \end{code} @@ -294,6 +306,7 @@ data DynFlags = DynFlags { hscOutName :: String, -- name of the output file hscStubHOutName :: String, -- name of the .stub_h output file hscStubCOutName :: String, -- name of the .stub_c output file + extCoreName :: String, -- name of the .core output file verbosity :: Int, -- verbosity level cppFlag :: Bool, -- preprocess with cpp? stolen_x86_regs :: Int, @@ -305,16 +318,30 @@ data DynFlags = DynFlags { opt_c :: [String], opt_a :: [String], opt_m :: [String], +#ifdef ILX + opt_I :: [String], + opt_i :: [String], +#endif -- hsc dynamic flags flags :: [DynFlag] } +data HscLang + = HscC + | HscAsm + | HscJava + | HscILX + | HscInterpreted + | HscNothing + deriving (Eq, Show) + defaultDynFlags = DynFlags { coreToDo = [], stgToDo = [], hscLang = HscC, hscOutName = "", hscStubHOutName = "", hscStubCOutName = "", + extCoreName = "", verbosity = 0, cppFlag = False, stolen_x86_regs = 4, @@ -324,6 +351,10 @@ defaultDynFlags = DynFlags { opt_c = [], opt_a = [], opt_m = [], +#ifdef ILX + opt_I = [], + opt_i = [], +#endif flags = standardWarnings, } @@ -350,26 +381,61 @@ dopt_StgToDo = stgToDo dopt_OutName :: DynFlags -> String dopt_OutName = hscOutName +dopt_HscLang :: DynFlags -> HscLang +dopt_HscLang = hscLang + dopt_set :: DynFlags -> DynFlag -> DynFlags dopt_set dfs f = dfs{ flags = f : flags dfs } dopt_unset :: DynFlags -> DynFlag -> DynFlags dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } +\end{code} -data HscLang - = HscC - | HscAsm - | HscJava -#ifdef ILX - | HscILX -#endif - | HscInterpreted - deriving (Eq, Show) +----------------------------------------------------------------------------- +-- Mess about with the mutable variables holding the dynamic arguments -dopt_HscLang :: DynFlags -> HscLang -dopt_HscLang = hscLang +-- v_InitDynFlags +-- is the "baseline" dynamic flags, initialised from +-- the defaults and command line options, and updated by the +-- ':s' command in GHCi. +-- +-- v_DynFlags +-- is the dynamic flags for the current compilation. It is reset +-- to the value of v_InitDynFlags before each compilation, then +-- updated by reading any OPTIONS pragma in the current module. + +\begin{code} +GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags) +GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags) + +setDynFlags :: DynFlags -> IO () +setDynFlags dfs = writeIORef v_DynFlags dfs + +saveDynFlags :: IO () +saveDynFlags = do dfs <- readIORef v_DynFlags + writeIORef v_InitDynFlags dfs + +restoreDynFlags :: IO DynFlags +restoreDynFlags = do dfs <- readIORef v_InitDynFlags + writeIORef v_DynFlags dfs + return dfs + +getDynFlags :: IO DynFlags +getDynFlags = readIORef v_DynFlags + +updDynFlags :: (DynFlags -> DynFlags) -> IO () +updDynFlags f = do dfs <- readIORef v_DynFlags + writeIORef v_DynFlags (f dfs) + +dynFlag :: (DynFlags -> a) -> IO a +dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags) + +setDynFlag, unSetDynFlag :: DynFlag -> IO () +setDynFlag f = updDynFlags (\dfs -> dopt_set dfs f) +unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f) \end{code} + %************************************************************************ %* * \subsection{Warnings} @@ -382,7 +448,7 @@ standardWarnings Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, Opt_WarnMissingMethods, - Opt_WarnDuplicateExports, + Opt_WarnDuplicateExports ] minusWOpts @@ -497,6 +563,7 @@ opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape") opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file") opt_UsageSPOn = lookUp SLIT("-fusagesp-on") opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields") +opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int) {- The optional '-inpackage=P' flag tells what package @@ -517,7 +584,7 @@ opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check") opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing") opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas") -opt_KeepStgTypes = lookUp SLIT("-fkeep-stg-types") +opt_RuntimeTypes = lookUp SLIT("-fruntime-types") -- Simplifier switches opt_SimplNoPreInlining = lookUp SLIT("-fno-pre-inlining") @@ -542,6 +609,7 @@ opt_NoPruneDecls = lookUp SLIT("-fno-prune-decls") opt_NoPruneTyDecls = lookUp SLIT("-fno-prune-tydecls") opt_Static = lookUp SLIT("-static") opt_Unregisterised = lookUp SLIT("-funregisterised") +opt_EmitExternalCore = lookUp SLIT("-fext-core") \end{code} %************************************************************************ @@ -581,7 +649,7 @@ isStaticHscFlag f = "fno-method-sharing", "fno-monomorphism-restriction", "fomit-interface-pragmas", - "fkeep-stg-types", + "fruntime-types", "fno-pre-inlining", "fdo-eta-reduction", "fdo-lambda-eta-expansion", @@ -591,11 +659,13 @@ isStaticHscFlag f = "fno-prune-decls", "fno-prune-tydecls", "static", - "funregisterised" + "funregisterised", + "fext-core" ] || any (flip prefixMatch f) [ "fcontext-stack", "fliberate-case-threshold", + "fmax-worker-args", "fhistory-size", "funfolding-creation-threshold", "funfolding-use-threshold",