X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=5d2338c60afd7325aee01e7c2da2debbbc0e0da2;hb=026b7e0c913c10b231eafa56d5dc8ac88145a48a;hp=745992958d463ed206470572de146fec17fe8812;hpb=4e1141827fe86474b99adbd00b7d6b37e83a8249;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 7459929..5d2338c 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -10,15 +10,20 @@ module CmdLineOpts ( SimplifierSwitch(..), isAmongSimpl, StgToDo(..), SwitchResult(..), + HscLang(..), DynFlag(..), -- needed non-abstractly by DriverFlags - DynFlags, -- abstract + DynFlags(..), + defaultDynFlags, + + v_Static_hsc_opts, intSwitchSet, switchIsOn, isStaticHscFlag, opt_PprStyle_NoPrags, + opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, @@ -28,6 +33,7 @@ module CmdLineOpts ( dopt_CoreToDo, dopt_StgToDo, dopt_HscLang, + dopt_OutName, -- profiling opts opt_AutoSccsOnAllToplevs, @@ -45,6 +51,7 @@ module CmdLineOpts ( opt_NumbersStrict, opt_Parallel, opt_SMP, + opt_NoMonomorphismRestriction, -- optimisation opts opt_DoSemiTagging, @@ -82,24 +89,23 @@ module CmdLineOpts ( opt_IgnoreAsserts, opt_IgnoreIfacePragmas, opt_NoHiCheck, - opt_NoImplicitPrelude, opt_OmitBlackHoling, opt_OmitInterfacePragmas, opt_NoPruneTyDecls, opt_NoPruneDecls, opt_Static, - opt_Unregisterised, - opt_Verbose + opt_Unregisterised ) where #include "HsVersions.h" import Array ( array, (//) ) import GlaExts -import Argv +import IOExts ( IORef, readIORef ) import Constants -- Default values for some flags import Util import FastTypes +import Config import Maybes ( firstJust ) import Panic ( panic ) @@ -184,9 +190,7 @@ data CoreToDo -- These are diff core-to-core passes, \begin{code} data StgToDo - = StgDoStaticArgs - | StgDoLambdaLift - | StgDoMassageForProfiling -- should be (next to) last + = StgDoMassageForProfiling -- should be (next to) last -- There's also setStgVarInfo, but its absolute "lastness" -- is so critical that it is hardwired in (no flag). | D_stg_stats @@ -211,9 +215,7 @@ data SimplifierSwitch data DynFlag -- debugging flags - = Opt_D_dump_all - | Opt_D_dump_most - | Opt_D_dump_absC + = Opt_D_dump_absC | Opt_D_dump_asm | Opt_D_dump_cpranal | Opt_D_dump_deriv @@ -228,6 +230,7 @@ data DynFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec + | Opt_D_dump_sat | Opt_D_dump_stg | Opt_D_dump_stranal | Opt_D_dump_tc @@ -236,14 +239,15 @@ data DynFlag | Opt_D_dump_usagesp | Opt_D_dump_cse | Opt_D_dump_worker_wrapper - | Opt_D_show_passes | Opt_D_dump_rn_trace | Opt_D_dump_rn_stats | Opt_D_dump_stix | Opt_D_dump_simpl_stats + | Opt_D_dump_BCOs | Opt_D_source_stats | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg + | Opt_D_dump_hi | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports | Opt_DoCoreLinting @@ -270,32 +274,56 @@ data DynFlag | Opt_AllowUndecidableInstances | Opt_GlasgowExts | Opt_Generics + | Opt_NoImplicitPrelude -- misc | Opt_ReportCompile deriving (Eq) data DynFlags = DynFlags { - coreToDo :: CoreToDo, - stgToDo :: StgToDo, - hscLang :: HscLang, - flags :: [DynFlag] + coreToDo :: [CoreToDo], + stgToDo :: [StgToDo], + hscLang :: HscLang, + hscOutName :: String, -- name of the file in which to place output + verbosity :: Int, -- verbosity level + flags :: [DynFlag] } +defaultDynFlags = DynFlags { + coreToDo = [], stgToDo = [], + hscLang = HscC, hscOutName = "", + verbosity = 0, flags = [] + } + +{- + Verbosity levels: + + 0 | print errors & warnings only + 1 | minimal verbosity: print "compiling M ... done." for each module. + 2 | equivalent to -dshow-passes + 3 | equivalent to existing "ghc -v" + 4 | "ghc -v -ddump-most" + 5 | "ghc -v -ddump-all" +-} + dopt :: DynFlag -> DynFlags -> Bool dopt f dflags = f `elem` (flags dflags) -dopt_CoreToDo :: DynFlags -> CoreToDo +dopt_CoreToDo :: DynFlags -> [CoreToDo] dopt_CoreToDo = coreToDo -dopt_StgToDo :: DynFlags -> StgToDo +dopt_StgToDo :: DynFlags -> [StgToDo] dopt_StgToDo = stgToDo +dopt_OutName :: DynFlags -> String +dopt_OutName = hscOutName + data HscLang - = HscC String -- String is the filename to put output into - | HscAsm String -- ditto - | HscJava String -- ditto - | HscInterpreter + = HscC + | HscAsm + | HscJava + | HscInterpreted + deriving (Eq, Show) dopt_HscLang :: DynFlags -> HscLang dopt_HscLang = hscLang @@ -308,15 +336,22 @@ dopt_HscLang = hscLang %************************************************************************ \begin{code} +-- v_Statis_hsc_opts is here to avoid a circular dependency with +-- main/DriverState. +GLOBAL_VAR(v_Static_hsc_opts, [], [String]) + lookUp :: FAST_STRING -> Bool lookup_int :: String -> Maybe Int lookup_def_int :: String -> Int -> Int lookup_def_float :: String -> Float -> Float lookup_str :: String -> Maybe String -lookUp sw = sw `elem` argv +unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts) +packed_static_opts = map _PK_ unpacked_static_opts + +lookUp sw = sw `elem` packed_static_opts -lookup_str sw = firstJust (map (startsWith sw) unpacked_opts) +lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts) lookup_int sw = case (lookup_str sw) of Nothing -> Nothing @@ -326,15 +361,10 @@ lookup_def_int sw def = case (lookup_str sw) of Nothing -> def -- Use default Just xx -> read xx -lookup_def_char sw def = case (lookup_str sw) of - Just (xx:_) -> xx - _ -> def -- Use default - lookup_def_float sw def = case (lookup_str sw) of Nothing -> def -- Use default Just xx -> read xx -unpacked_opts = map _UNPK_ argv {- Putting the compiler options into temporary at-files @@ -346,7 +376,7 @@ unpacked_opts :: [String] unpacked_opts = concat $ map (expandAts) $ - map _UNPK_ argv + map _UNPK_ argv -- NOT ARGV any more: v_Static_hsc_opts where expandAts ('@':fname) = words (unsafePerformIO (readFile fname)) expandAts l = [l] @@ -363,6 +393,7 @@ unpacked_opts = -- debugging opts opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags") opt_PprStyle_Debug = lookUp SLIT("-dppr-debug") +opt_PprStyle_RawTypes = lookUp SLIT("-dppr-rawtypes") opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name -- profiling opts @@ -375,6 +406,7 @@ opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky") -- language opts opt_AllStrict = lookUp SLIT("-fall-strict") +opt_NoMonomorphismRestriction = lookUp SLIT("-fno-monomorphism-restriction") opt_DictsStrict = lookUp SLIT("-fdicts-strict") opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples") opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH @@ -403,12 +435,11 @@ opt_InPackage = case lookup_str "-inpackage=" of opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls") opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names") opt_GranMacros = lookUp SLIT("-fgransim") -opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling. +opt_HiVersion = read cProjectVersionInt :: Int opt_HistorySize = lookup_def_int "-fhistory-size" 20 opt_IgnoreAsserts = lookUp SLIT("-fignore-asserts") opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check") -opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude") opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing") opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas") @@ -438,7 +469,6 @@ 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_Verbose = lookUp SLIT("-v") \end{code} %************************************************************************ @@ -450,58 +480,55 @@ opt_Verbose = lookUp SLIT("-v") \begin{code} isStaticHscFlag f = f `elem` [ - "-fauto-sccs-on-all-toplevs", - "-fauto-sccs-on-exported-toplevs", - "-fauto-sccs-on-individual-cafs", - "-fauto-sccs-on-dicts", - "-fscc-profiling", - "-fticky-ticky", - "-fall-strict", - "-fdicts-strict", - "-fgenerics", - "-firrefutable-tuples", - "-fnumbers-strict", - "-fparallel", - "-fsmp", - "-fsemi-tagging", - "-ffoldr-build-on", - "-flet-no-escape", - "-funfold-casms-in-hi-file", - "-fusagesp-on", - "-funbox-strict-fields", - "-femit-extern-decls", - "-fglobalise-toplev-names", - "-fgransim", - "-fignore-asserts", - "-fignore-interface-pragmas", - "-fno-hi-version-check", - "-fno-implicit-prelude", - "-dno-black-holing", - "-fomit-interface-pragmas", - "-fno-pre-inlining", - "-fdo-eta-reduction", - "-fdo-lambda-eta-expansion", - "-fcase-of-case", - "-fcase-merge", - "-fpedantic-bottoms", - "-fexcess-precision", - "-funfolding-update-in-place", - "-freport-compile", - "-fno-prune-decls", - "-fno-prune-tydecls", - "-static", - "-funregisterised", - "-v" ] + "fauto-sccs-on-all-toplevs", + "fauto-sccs-on-exported-toplevs", + "fauto-sccs-on-individual-cafs", + "fauto-sccs-on-dicts", + "fscc-profiling", + "fticky-ticky", + "fall-strict", + "fdicts-strict", + "firrefutable-tuples", + "fnumbers-strict", + "fparallel", + "fsmp", + "fsemi-tagging", + "ffoldr-build-on", + "flet-no-escape", + "funfold-casms-in-hi-file", + "fusagesp-on", + "funbox-strict-fields", + "femit-extern-decls", + "fglobalise-toplev-names", + "fgransim", + "fignore-asserts", + "fignore-interface-pragmas", + "fno-hi-version-check", + "dno-black-holing", + "fomit-interface-pragmas", + "fno-pre-inlining", + "fdo-eta-reduction", + "fdo-lambda-eta-expansion", + "fcase-of-case", + "fcase-merge", + "fpedantic-bottoms", + "fexcess-precision", + "funfolding-update-in-place", + "freport-compile", + "fno-prune-decls", + "fno-prune-tydecls", + "static", + "funregisterised" + ] || any (flip prefixMatch f) [ - "-fcontext-stack", - "-fliberate-case-threshold", - "-fhi-version=", - "-fhistory-size", - "-funfolding-interface-threshold", - "-funfolding-creation-threshold", - "-funfolding-use-threshold", - "-funfolding-fun-discount", - "-funfolding-keeness-factor" + "fcontext-stack", + "fliberate-case-threshold", + "fhistory-size", + "funfolding-interface-threshold", + "funfolding-creation-threshold", + "funfolding-use-threshold", + "funfolding-fun-discount", + "funfolding-keeness-factor" ] \end{code} @@ -592,11 +619,6 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* || sw `is_elem` ss \end{code} -Default settings for simplifier switches - -\begin{code} -defaultSimplSwitches = [MaxSimplifierIterations 1] -\end{code} %************************************************************************ %* *