X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=2d4b4e9d78b05484271986419736bdfc5f2d7ac4;hb=153b9cb9b11e05c4edb1b6bc0a7b972660e41f70;hp=6042f15763fcbe28d2eef56b4bb25e2a5ce415b3;hpb=b4d045ae655e5eae25b88917cfe75d7dc7689c21;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index 6042f15..2d4b4e9 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -10,9 +10,10 @@ module CmdLineOpts ( SimplifierSwitch(..), SimplifierMode(..), FloatOutSwitches(..), - HscLang(..), + HscTarget(..), DynFlag(..), -- needed non-abstractly by DriverFlags DynFlags(..), + PackageFlag(..), v_Static_hsc_opts, @@ -24,21 +25,11 @@ module CmdLineOpts ( dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags dopt_CoreToDo, -- DynFlags -> [CoreToDo] dopt_StgToDo, -- DynFlags -> [StgToDo] - dopt_HscLang, -- DynFlags -> HscLang + dopt_HscTarget, -- DynFlags -> HscTarget 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 minusWOpts, @@ -84,7 +75,6 @@ module CmdLineOpts ( -- misc opts opt_ErrorSpans, - opt_InPackage, opt_EmitCExternDecls, opt_EnsureSplittableC, opt_GranMacros, @@ -99,6 +89,8 @@ module CmdLineOpts ( #include "HsVersions.h" +import {-# SOURCE #-} Packages (PackageState) +import DriverPhases ( HscTarget(..) ) import Constants -- Default values for some flags import Util import FastString ( FastString, mkFastString ) @@ -107,7 +99,7 @@ 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} @@ -256,6 +248,7 @@ data DynFlag | Opt_WarnDuplicateExports | Opt_WarnHiShadows | Opt_WarnIncompletePatterns + | Opt_WarnIncompletePatternsRecUpd | Opt_WarnMissingFields | Opt_WarnMissingMethods | Opt_WarnMissingSigs @@ -268,12 +261,13 @@ data DynFlag | Opt_WarnUnusedMatches | Opt_WarnDeprecations | Opt_WarnDodgyImports + | Opt_WarnOrphans -- language opts | Opt_AllowOverlappingInstances | Opt_AllowUndecidableInstances | Opt_AllowIncoherentInstances - | Opt_NoMonomorphismRestriction + | Opt_MonomorphismRestriction | Opt_GlasgowExts | Opt_FFI | Opt_PArr -- syntactic support for parallel arrays @@ -281,7 +275,8 @@ data DynFlag | Opt_TH | Opt_ImplicitParams | Opt_Generics - | Opt_NoImplicitPrelude + | Opt_ImplicitPrelude + | Opt_ScopedTypeVariables -- optimisation opts | Opt_Strictness @@ -300,7 +295,7 @@ data DynFlag data DynFlags = DynFlags { coreToDo :: Maybe [CoreToDo], -- reserved for use with -Ofile stgToDo :: [StgToDo], - hscLang :: HscLang, + hscTarget :: HscTarget, 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 @@ -311,8 +306,10 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, cppFlag :: Bool, -- preprocess with cpp? ppFlag :: Bool, -- preprocess with a Haskell Pp? + recompFlag :: Bool, -- True <=> recompilation checker is on stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes + importPaths :: [FilePath], -- options for particular phases opt_L :: [String], @@ -326,29 +323,39 @@ 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 HscLang - = HscC - | HscAsm - | HscJava - | HscILX - | HscInterpreted - | HscNothing - deriving (Eq, Show) - -defaultHscLang - | cGhcWithNativeCodeGen == "YES" && - (prefixMatch "i386" cTARGETPLATFORM || - prefixMatch "sparc" cTARGETPLATFORM || - prefixMatch "powerpc" cTARGETPLATFORM) = HscAsm - | otherwise = HscC +data PackageFlag + = ExposePackage String + | HidePackage String + | IgnorePackage String + +defaultHscTarget +#if defined(i386_TARGET_ARCH) || defined(sparc_TARGET_ARCH) || defined(powerpc_TARGET_ARCH) + | cGhcWithNativeCodeGen == "YES" = HscAsm +#endif + | otherwise = HscC defaultDynFlags = DynFlags { coreToDo = Nothing, stgToDo = [], - hscLang = defaultHscLang, + hscTarget = defaultHscTarget, hscOutName = "", hscStubHOutName = "", hscStubCOutName = "", extCoreName = "", @@ -358,8 +365,10 @@ defaultDynFlags = DynFlags { ruleCheck = Nothing, cppFlag = False, ppFlag = False, + recompFlag = True, stolen_x86_regs = 4, cmdlineHcIncludes = [], + importPaths = ["."], opt_L = [], opt_P = [], opt_F = [], @@ -370,7 +379,15 @@ defaultDynFlags = DynFlags { opt_I = [], opt_i = [], #endif + + extraPkgConfs = [], + readUserPkgConf = True, + packageFlags = [], + pkgState = error "pkgState", + flags = [ + Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, Opt_Generics, -- Generating the helper-functions for -- generics is now on by default @@ -416,8 +433,8 @@ dopt_StgToDo = stgToDo dopt_OutName :: DynFlags -> String dopt_OutName = hscOutName -dopt_HscLang :: DynFlags -> HscLang -dopt_HscLang = hscLang +dopt_HscTarget :: DynFlags -> HscTarget +dopt_HscTarget = hscTarget dopt_set :: DynFlags -> DynFlag -> DynFlags dopt_set dfs f = dfs{ flags = f : flags dfs } @@ -425,35 +442,20 @@ 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 + then dfs2{ hscTarget = HscC, optLevel = n } -- turn on -fvia-C with -O else dfs2{ optLevel = n } where dfs1 = foldr (flip dopt_unset) dfs remove_dopts @@ -610,51 +612,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} @@ -684,7 +643,8 @@ minusWallOpts [ Opt_WarnTypeDefaults, Opt_WarnNameShadowing, Opt_WarnMissingSigs, - Opt_WarnHiShadows + Opt_WarnHiShadows, + Opt_WarnOrphans ] \end{code} @@ -700,7 +660,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 @@ -718,10 +677,6 @@ lookup_str sw Just str -> Just str Nothing -> Nothing -lookup_int sw = case (lookup_str sw) of - Nothing -> Nothing - Just xx -> Just (try_read sw xx) - lookup_def_int sw def = case (lookup_str sw) of Nothing -> def -- Use default Just xx -> try_read sw xx @@ -778,7 +733,6 @@ opt_SccProfilingOn = lookUp FSLIT("-fscc-profiling") opt_DoTickyProfiling = lookUp FSLIT("-fticky-ticky") -- language opts -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 @@ -795,15 +749,6 @@ opt_RulesOff = lookUp FSLIT("-frules-off") 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") @@ -908,10 +853,4 @@ startsWith [] str = Just str startsWith (c:cs) (s:ss) = if c /= s then Nothing else startsWith cs ss startsWith _ [] = Nothing - -endsWith :: String -> String -> Maybe String -endsWith cs ss - = case (startsWith (reverse cs) (reverse ss)) of - Nothing -> Nothing - Just rs -> Just (reverse rs) \end{code}