X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=6942408563bd0c9424794a122d9e1eb09436c9af;hb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;hp=b520eee21483a4009268312a4ea0f840e558e176;hpb=abbc5a0be1df84a33015470319062ed7a3aa3153;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index b520eee..6942408 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -13,6 +13,7 @@ module CmdLineOpts ( HscLang(..), DynFlag(..), -- needed non-abstractly by DriverFlags DynFlags(..), + PackageFlag(..), v_Static_hsc_opts, @@ -20,7 +21,6 @@ module CmdLineOpts ( -- Manipulating DynFlags defaultDynFlags, -- DynFlags - defaultHscLang, -- HscLang dopt, -- DynFlag -> DynFlags -> Bool dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags dopt_CoreToDo, -- DynFlags -> [CoreToDo] @@ -28,27 +28,14 @@ module CmdLineOpts ( dopt_HscLang, -- DynFlags -> HscLang dopt_OutName, -- DynFlags -> String getOpts, -- (DynFlags -> [a]) -> IO [a] - setLang, getVerbFlag, - setOptLevel, - - -- 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 + updOptLevel, -- sets of warning opts - standardWarnings, minusWOpts, minusWallOpts, -- Output style options - opt_PprStyle_NoPrags, - opt_PprStyle_RawTypes, opt_PprUserLength, opt_PprStyle_Debug, @@ -56,24 +43,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,34 +71,34 @@ module CmdLineOpts ( opt_UF_FunAppDiscount, opt_UF_KeenessFactor, opt_UF_UpdateInPlace, - opt_UF_CheapOp, opt_UF_DearOp, -- misc opts - opt_InPackage, + opt_ErrorSpans, opt_EmitCExternDecls, opt_EnsureSplittableC, opt_GranMacros, opt_HiVersion, opt_HistorySize, - opt_NoHiCheck, opt_OmitBlackHoling, - opt_NoPruneDecls, opt_Static, opt_Unregisterised, - opt_EmitExternalCore + opt_EmitExternalCore, + opt_PIC ) where #include "HsVersions.h" +import {-# SOURCE #-} Packages (PackageState) import Constants -- Default values for some flags import Util import FastString ( FastString, mkFastString ) import Config import Maybes ( firstJust ) +import Panic ( ghcError, GhcException(UsageError) ) import GLAEXTS -import DATA_IOREF ( IORef, readIORef, writeIORef ) +import DATA_IOREF ( IORef, readIORef ) import UNSAFE_IO ( unsafePerformIO ) \end{code} @@ -218,7 +202,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 +212,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,9 +226,10 @@ 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 | Opt_D_dump_splices | Opt_D_dump_BCOs | Opt_D_dump_vect @@ -257,11 +241,13 @@ data DynFlag | Opt_D_dump_minimal_imports | Opt_DoCoreLinting | Opt_DoStgLinting + | Opt_DoCmmLinting | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports | Opt_WarnHiShadows | Opt_WarnIncompletePatterns + | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields | Opt_WarnMissingMethods | Opt_WarnMissingSigs @@ -273,7 +259,7 @@ data DynFlag | Opt_WarnUnusedImports | Opt_WarnUnusedMatches | Opt_WarnDeprecations - | Opt_WarnMisc + | Opt_WarnDodgyImports -- language opts | Opt_AllowOverlappingInstances @@ -283,7 +269,6 @@ data DynFlag | Opt_GlasgowExts | Opt_FFI | Opt_PArr -- syntactic support for parallel arrays - | Opt_With -- deprecated keyword for implicit parms | Opt_Arrows -- Arrow-notation syntax | Opt_TH | Opt_ImplicitParams @@ -292,6 +277,7 @@ data DynFlag -- optimisation opts | Opt_Strictness + | Opt_FullLaziness | Opt_CSE | Opt_IgnoreInterfacePragmas | Opt_OmitInterfacePragmas @@ -319,6 +305,7 @@ data DynFlags = DynFlags { ppFlag :: Bool, -- preprocess with a Haskell Pp? stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes + importPaths :: [FilePath], -- options for particular phases opt_L :: [String], @@ -332,10 +319,30 @@ data DynFlags = DynFlags { opt_i :: [String], #endif + -- ** Package flags + extraPkgConfs :: [FilePath], + -- The -package-conf flags given on the command line, in the order + -- they appeared. + + readUserPkgConf :: Bool, + -- Whether or not to read the user package database + -- (-no-user-package-conf). + + packageFlags :: [PackageFlag], + -- The -package and -hide-package flags from the command-line + + -- ** Package state + pkgState :: PackageState, + -- hsc dynamic flags flags :: [DynFlag] } +data PackageFlag + = ExposePackage String + | HidePackage String + | IgnorePackage String + data HscLang = HscC | HscAsm @@ -366,6 +373,7 @@ defaultDynFlags = DynFlags { ppFlag = False, stolen_x86_regs = 4, cmdlineHcIncludes = [], + importPaths = ["."], opt_L = [], opt_P = [], opt_F = [], @@ -376,6 +384,12 @@ defaultDynFlags = DynFlags { opt_I = [], opt_i = [], #endif + + extraPkgConfs = [], + readUserPkgConf = True, + packageFlags = [], + pkgState = error "pkgState", + flags = [ Opt_Generics, -- Generating the helper-functions for @@ -383,14 +397,20 @@ defaultDynFlags = DynFlags { Opt_Strictness, -- strictness is on by default, but this only -- applies to -O. - Opt_CSE, - -- similarly for CSE. - Opt_DoLambdaEtaExpansion + 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 -- constructors are eta-expanded. This is probably -- a good thing anyway, but it seems fragile. - ] ++ standardWarnings, + + -- and the default no-optimisation options: + Opt_IgnoreInterfacePragmas, + Opt_OmitInterfacePragmas + + ] ++ standardWarnings } {- @@ -425,33 +445,18 @@ dopt_set dfs f = dfs{ flags = f : flags dfs } dopt_unset :: DynFlags -> DynFlag -> DynFlags dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } -getOpts :: (DynFlags -> [a]) -> IO [a] +getOpts :: DynFlags -> (DynFlags -> [a]) -> [a] -- We add to the options from the front, so we need to reverse the list -getOpts opts = dynFlag opts >>= return . reverse +getOpts dflags opts = reverse (opts dflags) --- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags --- (-fvia-C, -fasm, -filx respectively). -setLang l = updDynFlags (\ dfs -> case hscLang dfs of - HscC -> dfs{ hscLang = l } - HscAsm -> dfs{ hscLang = l } - HscILX -> dfs{ hscLang = l } - _ -> dfs) - -getVerbFlag = do - verb <- dynFlag verbosity - if verb >= 3 then return "-v" else return "" +getVerbFlag dflags + | verbosity dflags >= 3 = "-v" + | otherwise = "" ----------------------------------------------------------------------------- -- Setting the optimisation level -setOptLevel :: Int -> IO () -setOptLevel n - = do dflags <- getDynFlags - if hscLang dflags == HscInterpreted && n > 0 - then putStr "warning: -O conflicts with --interactive; -O ignored.\n" - else updDynFlags (setOptLevel' n) - -setOptLevel' n dfs +updOptLevel n dfs = if (n >= 1) then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O else dfs2{ optLevel = n } @@ -483,11 +488,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 @@ -521,7 +527,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) [ @@ -569,8 +577,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 @@ -605,51 +615,8 @@ buildCoreToDo dflags = core_todo MaxSimplifierIterations max_iter ] ] - --- -------------------------------------------------------------------------- --- Mess about with the mutable variables holding the dynamic arguments - --- 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. - -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} @@ -671,7 +638,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, - Opt_WarnMisc + Opt_WarnDodgyImports ] minusWallOpts @@ -695,7 +662,6 @@ minusWallOpts GLOBAL_VAR(v_Static_hsc_opts, [], [String]) lookUp :: FastString -> Bool -lookup_int :: String -> Maybe Int lookup_def_int :: String -> Int -> Int lookup_def_float :: String -> Float -> Float lookup_str :: String -> Maybe String @@ -705,19 +671,32 @@ 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_int sw = case (lookup_str sw) of - Nothing -> Nothing - Just xx -> Just (read xx) +-- (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_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. {- @@ -745,16 +724,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") @@ -763,35 +739,24 @@ 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 opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int) opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int) -{- - The optional '-inpackage=P' flag tells what package - we are compiling this module for. - The Prelude, for example is compiled with '-inpackage std' --} -opt_InPackage = case lookup_str "-inpackage=" of - Just p -> mkFastString p - Nothing -> FSLIT("Main") -- The package name if none is specified - opt_EmitCExternDecls = lookUp FSLIT("-femit-extern-decls") 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") @@ -808,13 +773,16 @@ 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") + +opt_PIC = lookUp FSLIT("-fPIC") \end{code} %************************************************************************ @@ -835,7 +803,6 @@ isStaticHscFlag f = "fall-strict", "fdicts-strict", "firrefutable-tuples", - "fnumbers-strict", "fparallel", "fsmp", "fflatten", @@ -847,17 +814,19 @@ 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", + "fPIC" ] || any (flip prefixMatch f) [ "fcontext-stack",