X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=19e4af29516db97a388968879a4a1941d2053c46;hb=fc9bbbab3fe56cf0ff5723abbdb0f496d257f34e;hp=14491877cf789c4938fef507b5bdcb4538b02cc6;hpb=90c32262025049ae3013e8af1e9960756dace72d;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 1449187..19e4af2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -3,17 +3,17 @@ -- -- Dynamic flags -- --- Most flags are dynamic flags, which means they can change from --- compilation to compilation using OPTIONS_GHC pragmas, and in a --- multi-session GHC each session can be using different dynamic --- flags. Dynamic flags can also be set at the prompt in GHCi. -- -- (c) The University of Glasgow 2005 -- ----------------------------------------------------------------------------- +-- | Most flags are dynamic flags, which means they can change from +-- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a +-- multi-session GHC each session can be using different dynamic +-- flags. Dynamic flags can also be set at the prompt in GHCi. module DynFlags ( - -- Dynamic flags + -- * Dynamic flags and associated configuration types DynFlag(..), DynFlags(..), HscTarget(..), isObjectTarget, defaultObjectTarget, @@ -25,40 +25,50 @@ module DynFlags ( fFlags, xFlags, DPHBackend(..), - -- Configuration of the core-to-core and stg-to-stg phases - CoreToDo(..), - StgToDo(..), - SimplifierSwitch(..), - SimplifierMode(..), FloatOutSwitches(..), - getCoreToDo, getStgToDo, - - -- Manipulating DynFlags + -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags initDynFlags, -- DynFlags -> IO DynFlags dopt, -- DynFlag -> DynFlags -> Bool dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags - getOpts, -- (DynFlags -> [a]) -> IO [a] + getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlag, + getMainFun, updOptLevel, setTmpDir, setPackageName, - -- parsing DynFlags + -- ** Parsing DynFlags parseDynamicFlags, allFlags, - -- misc stuff + supportedLanguages, languageOptions, + + -- ** DynFlag C compiler options machdepCCOpts, picCCOpts, - supportedLanguages, languageOptions, - compilerInfo, + + -- * Configuration of the core-to-core passes + CoreToDo(..), + SimplifierMode(..), + SimplifierSwitch(..), + FloatOutSwitches(..), + getCoreToDo, + + -- * Configuration of the stg-to-stg passes + StgToDo(..), + getStgToDo, + + -- * Compiler configuration suitable for display to the user + compilerInfo ) where #include "HsVersions.h" import Module import PackageConfig -import PrelNames ( mAIN ) +import PrelNames ( mAIN, main_RDR_Unqual ) +import RdrName ( RdrName, mkRdrUnqual ) +import OccName ( mkVarOccFS ) #ifdef i386_TARGET_ARCH import StaticFlags ( opt_Static ) #endif @@ -69,16 +79,16 @@ import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) -import Panic ( panic, GhcException(..) ) +import Panic import UniqFM ( UniqFM ) import Util import Maybes ( orElse ) -import SrcLoc ( SrcSpan ) +import SrcLoc +import FastString import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) import Data.IORef ( readIORef ) -import Control.Exception ( throwDyn ) import Control.Monad ( when ) import Data.Char @@ -88,6 +98,7 @@ import System.IO ( stderr, hPutChar ) -- ----------------------------------------------------------------------------- -- DynFlags +-- | Enumerates the simple on-or-off dynamic flags data DynFlag -- debugging flags @@ -174,6 +185,7 @@ data DynFlag | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs + | Opt_WarnUnrecognisedPragmas | Opt_WarnDodgyForeignImports -- language opts @@ -217,7 +229,6 @@ data DynFlag | Opt_MagicHash | Opt_EmptyDataDecls | Opt_KindSignatures - | Opt_PatternSignatures | Opt_ParallelListComp | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving @@ -229,6 +240,7 @@ data DynFlag | Opt_RankNTypes | Opt_ImpredicativeTypes | Opt_TypeOperators + | Opt_PackageImports | Opt_PrintExplicitForalls @@ -248,7 +260,7 @@ data DynFlag | Opt_UnboxStrictFields | Opt_MethodSharing | Opt_DictsCheap - | Opt_RewriteRules + | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_Vectorise | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation @@ -278,6 +290,7 @@ data DynFlag | Opt_RunCPSZ | Opt_ConvertToZipCfgAndBack | Opt_AutoLinkPackages + | Opt_ImplicitImportQualified -- keeping stuff | Opt_KeepHiDiffs @@ -288,40 +301,42 @@ data DynFlag deriving (Eq, Show) +-- | Contains not only a collection of 'DynFlag's but also a plethora of +-- information relating to the compilation of a single file or GHC session data DynFlags = DynFlags { ghcMode :: GhcMode, ghcLink :: GhcLink, coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile stgToDo :: Maybe [StgToDo], -- similarly hscTarget :: HscTarget, - hscOutName :: String, -- name of the output file - extCoreName :: String, -- name of the .core output file - verbosity :: Int, -- verbosity level - optLevel :: Int, -- optimisation level - simplPhases :: Int, -- number of simplifier phases - maxSimplIterations :: Int, -- max simplifier iterations + hscOutName :: String, -- ^ Name of the output file + extCoreName :: String, -- ^ Name of the .core output file + verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels" + optLevel :: Int, -- ^ Optimisation level + simplPhases :: Int, -- ^ Number of simplifier phases + maxSimplIterations :: Int, -- ^ Max simplifier iterations shouldDumpSimplPhase :: SimplifierMode -> Bool, ruleCheck :: Maybe String, - specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr - specConstrCount :: Maybe Int, -- Max number of specialisations for any one function - liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase + specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr + specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function + liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase stolen_x86_regs :: Int, - cmdlineHcIncludes :: [String], -- -#includes + cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], mainModIs :: Module, mainFunIs :: Maybe String, - ctxtStkDepth :: Int, -- Typechecker context stack depth + ctxtStkDepth :: Int, -- ^ Typechecker context stack depth dphBackend :: DPHBackend, thisPackage :: PackageId, -- ways - wayNames :: [WayName], -- way flags from the cmd line - buildTag :: String, -- the global "way" (eg. "p" for prof) - rtsBuildTag :: String, -- the RTS "way" + wayNames :: [WayName], -- ^ Way flags from the command line + buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof) + rtsBuildTag :: String, -- ^ The RTS \"way\" -- paths etc. objectDir :: Maybe String, @@ -336,12 +351,12 @@ data DynFlags = DynFlags { outputHi :: Maybe String, dynLibLoader :: DynLibLoader, - -- | This is set by DriverPipeline.runPipeline based on where + -- | This is set by 'DriverPipeline.runPipeline' based on where -- its output is going. dumpPrefix :: Maybe FilePath, - -- | Override the dumpPrefix set by runPipeline. - -- Set by -ddump-file-prefix + -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'. + -- Set by @-ddump-file-prefix@ dumpPrefixForce :: Maybe FilePath, includePaths :: [String], @@ -353,7 +368,7 @@ data DynFlags = DynFlags { ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto - hpcDir :: String, -- ^ path to store the .mix files + hpcDir :: String, -- ^ Path to store the .mix files -- options for particular phases opt_L :: [String], @@ -390,11 +405,11 @@ data DynFlags = DynFlags { extraPkgConfs :: [FilePath], topDir :: FilePath, -- filled in by SysTools systemPackageConfig :: FilePath, -- ditto - -- The -package-conf flags given on the command line, in the order + -- ^ The @-package-conf@ flags given on the command line, in the order -- they appeared. packageFlags :: [PackageFlag], - -- The -package and -hide-package flags from the command-line + -- ^ The @-package@ and @-hide-package@ flags from the command-line -- Package state -- NB. do not modify this field, it is calculated by @@ -405,7 +420,7 @@ data DynFlags = DynFlags { -- hsc dynamic flags flags :: [DynFlag], - -- message output + -- | Message output action: use "ErrUtils" instead of this if you can log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), haddockOptions :: Maybe String @@ -419,7 +434,7 @@ data HscTarget | HscNothing deriving (Eq, Show) --- | will this target result in an object file on the disk? +-- | Will this target result in an object file on the disk? isObjectTarget :: HscTarget -> Bool isObjectTarget HscC = True isObjectTarget HscAsm = True @@ -432,21 +447,21 @@ isObjectTarget _ = False -- imported modules, but in multi-module mode we look for source files -- in order to check whether they need to be recompiled. data GhcMode - = CompManager -- ^ --make, GHCi, etc. - | OneShot -- ^ ghc -c Foo.hs - | MkDepend -- ^ ghc -M, see Finder for why we need this + = CompManager -- ^ @\-\-make@, GHCi, etc. + | OneShot -- ^ @ghc -c Foo.hs@ + | MkDepend -- ^ @ghc -M@, see "Finder" for why we need this deriving Eq isOneShot :: GhcMode -> Bool isOneShot OneShot = True isOneShot _other = False --- | What kind of linking to do. -data GhcLink -- What to do in the link step, if there is one - = NoLink -- Don't link at all - | LinkBinary -- Link object code into a binary - | LinkInMemory -- Use the in-memory dynamic linker - | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) +-- | What to do in the link step, if there is one. +data GhcLink + = NoLink -- ^ Don't link at all + | LinkBinary -- ^ Link object code into a binary + | LinkInMemory -- ^ Use the in-memory dynamic linker + | LinkDynLib -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) deriving (Eq, Show) isNoLink :: GhcLink -> Bool @@ -462,7 +477,7 @@ data PackageFlag defaultHscTarget :: HscTarget defaultHscTarget = defaultObjectTarget --- | the 'HscTarget' value corresponding to the default way to create +-- | The 'HscTarget' value corresponding to the default way to create -- object files on the current platform. defaultObjectTarget :: HscTarget defaultObjectTarget @@ -475,6 +490,7 @@ data DynLibLoader | SystemDependent deriving Eq +-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do -- someday these will be dynamic flags @@ -487,6 +503,8 @@ initDynFlags dflags = do rtsBuildTag = rts_build_tag } +-- | The normal 'DynFlags'. Note that they is not suitable for use in this form +-- and must be fully initialized by 'GHC.newSession' first. defaultDynFlags :: DynFlags defaultDynFlags = DynFlags { @@ -618,6 +636,7 @@ defaultDynFlags = } {- + #verbosity_levels# Verbosity levels: 0 | print errors & warnings only @@ -628,19 +647,27 @@ defaultDynFlags = 5 | "ghc -v -ddump-all" -} +-- | Test whether a 'DynFlag' is set dopt :: DynFlag -> DynFlags -> Bool dopt f dflags = f `elem` (flags dflags) +-- | Set a 'DynFlag' dopt_set :: DynFlags -> DynFlag -> DynFlags dopt_set dfs f = dfs{ flags = f : flags dfs } +-- | Unset a 'DynFlag' dopt_unset :: DynFlags -> DynFlag -> DynFlags dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } -getOpts :: DynFlags -> (DynFlags -> [a]) -> [a] +-- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order +getOpts :: DynFlags -- ^ 'DynFlags' to retrieve the options from + -> (DynFlags -> [a]) -- ^ Relevant record accessor: one of the @opt_*@ accessors + -> [a] -- ^ Correctly ordered extracted options getOpts dflags opts = reverse (opts dflags) -- We add to the options from the front, so we need to reverse the list +-- | Gets the verbosity flag for the current verbosity level. This is fed to +-- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included getVerbFlag :: DynFlags -> String getVerbFlag dflags | verbosity dflags >= 3 = "-v" @@ -732,13 +759,12 @@ addHaddockOpts f d = d{ haddockOptions = Just f} -- ----------------------------------------------------------------------------- -- Command-line options --- When invoking external tools as part of the compilation pipeline, we +-- | When invoking external tools as part of the compilation pipeline, we -- pass these a sequence of options on the command-line. Rather than -- just using a list of Strings, we use a type that allows us to distinguish --- between filepaths and 'other stuff'. [The reason being, of course, that +-- between filepaths and 'other stuff'. The reason for this is that -- this type gives us a handle on transforming filenames, and filenames only, --- to whatever format they're expected to be on a particular platform.] - +-- to whatever format they're expected to be on a particular platform. data Option = FileOption -- an entry that _contains_ filename(s) / filepaths. String -- a non-filepath prefix that shouldn't be @@ -750,7 +776,7 @@ data Option -- Setting the optimisation level updOptLevel :: Int -> DynFlags -> DynFlags --- Set dynflags appropriate to the optimisation level +-- ^ Sets the 'DynFlags' to be appropriate to the optimisation level updOptLevel n dfs = dfs2{ optLevel = final_n } where @@ -767,8 +793,8 @@ optLevelFlags , ([0], Opt_OmitInterfacePragmas) , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] - -- in PrelRules + , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] + -- in PrelRules , ([1,2], Opt_DoEtaReduction) , ([1,2], Opt_CaseMerge) , ([1,2], Opt_Strictness) @@ -793,6 +819,7 @@ standardWarnings :: [DynFlag] standardWarnings = [ Opt_WarnWarningsDeprecations, Opt_WarnDeprecatedFlags, + Opt_WarnUnrecognisedPragmas, Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, Opt_WarnMissingMethods, @@ -828,6 +855,7 @@ minuswRemovesOpts Opt_WarnIncompletePatternsRecUpd, Opt_WarnSimplePatterns, Opt_WarnMonomorphism, + Opt_WarnUnrecognisedPragmas, Opt_WarnTabs ] @@ -1106,15 +1134,24 @@ dynamic_flags = [ Supported -------- ghc -M ----------------------------------------------------- - , Flag "optdep-s" (HasArg (upd . addDepSuffix)) Supported - , Flag "optdep-f" (HasArg (upd . setDepMakefile)) Supported + , Flag "dep-suffix" (HasArg (upd . addDepSuffix)) Supported + , Flag "optdep-s" (HasArg (upd . addDepSuffix)) + (Deprecated "Use -dep-suffix instead") + , Flag "dep-makefile" (HasArg (upd . setDepMakefile)) Supported + , Flag "optdep-f" (HasArg (upd . setDepMakefile)) + (Deprecated "Use -dep-makefile instead") , Flag "optdep-w" (NoArg (upd (setDepWarnings False))) (Deprecated "-optdep-w doesn't do anything") + , Flag "include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported , Flag "optdep--include-prelude" (NoArg (upd (setDepIncludePkgDeps True))) - (Deprecated "Use -optdep--include-pkg-deps instead") - , Flag "optdep--include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported - , Flag "optdep--exclude-module" (HasArg (upd . addDepExcludeMod)) Supported - , Flag "optdep-x" (HasArg (upd . addDepExcludeMod)) Supported + (Deprecated "Use -include-pkg-deps instead") + , Flag "optdep--include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) + (Deprecated "Use -include-pkg-deps instead") + , Flag "exclude-module" (HasArg (upd . addDepExcludeMod)) Supported + , Flag "optdep--exclude-module" (HasArg (upd . addDepExcludeMod)) + (Deprecated "Use -exclude-module instead") + , Flag "optdep-x" (HasArg (upd . addDepExcludeMod)) + (Deprecated "Use -exclude-module instead") -------- Linking ---------------------------------------------------- , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) @@ -1417,8 +1454,8 @@ dynamic_flags = [ ++ map (mkFlag True "X" setDynFlag ) xFlags ++ map (mkFlag False "XNo" unSetDynFlag) xFlags -mkFlag :: Bool -- True => turn it on, False => turn it off - -> String +mkFlag :: Bool -- ^ True <=> it should be turned on + -> String -- ^ The flag prefix -> (DynFlag -> DynP ()) -> (String, DynFlag, Bool -> Deprecated) -> Flag DynP @@ -1426,12 +1463,19 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated) = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn) deprecatedForLanguage :: String -> Bool -> Deprecated -deprecatedForLanguage lang turnOn = - Deprecated ("Use the " ++ prefix ++ lang ++ " language instead") - where prefix = if turnOn then "" else "No" - --- these -f flags can all be reversed with -fno- +deprecatedForLanguage lang turn_on + = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead") + where + flag | turn_on = lang + | otherwise = "No"++lang + +useInstead :: String -> Bool -> Deprecated +useInstead flag turn_on + = Deprecated ("Use -f" ++ no ++ flag ++ " instead") + where + no = if turn_on then "" else "no-" +-- | These @-f\@ flags can all be reversed with @-fno-\@ fFlags :: [(String, DynFlag, Bool -> Deprecated)] fFlags = [ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), @@ -1453,9 +1497,11 @@ fFlags = [ ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ), ( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ), ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ), + ( "warn-deprecations", Opt_WarnWarningsDeprecations, const Supported ), ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ), ( "warn-orphans", Opt_WarnOrphans, const Supported ), ( "warn-tabs", Opt_WarnTabs, const Supported ), + ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), ( "strictness", Opt_Strictness, const Supported ), ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), @@ -1477,7 +1523,8 @@ fFlags = [ ( "print-bind-result", Opt_PrintBindResult, const Supported ), ( "force-recomp", Opt_ForceRecomp, const Supported ), ( "hpc-no-auto", Opt_Hpc_No_Auto, const Supported ), - ( "rewrite-rules", Opt_RewriteRules, const Supported ), + ( "rewrite-rules", Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ), + ( "enable-rewrite-rules", Opt_EnableRewriteRules, const Supported ), ( "break-on-exception", Opt_BreakOnException, const Supported ), ( "break-on-error", Opt_BreakOnError, const Supported ), ( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ), @@ -1520,7 +1567,8 @@ fFlags = [ ( "allow-incoherent-instances", Opt_IncoherentInstances, deprecatedForLanguage "IncoherentInstances" ), ( "gen-manifest", Opt_GenManifest, const Supported ), - ( "embed-manifest", Opt_EmbedManifest, const Supported ) + ( "embed-manifest", Opt_EmbedManifest, const Supported ), + ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported ) ] supportedLanguages :: [String] @@ -1530,7 +1578,7 @@ supportedLanguages = [ name | (name, _, _) <- xFlags ] languageOptions :: [DynFlag] languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ] --- These -X flags can all be reversed with -XNo +-- | These -X flags can all be reversed with -XNo xFlags :: [(String, DynFlag, Bool -> Deprecated)] xFlags = [ ( "CPP", Opt_Cpp, const Supported ), @@ -1541,7 +1589,6 @@ xFlags = [ ( "PolymorphicComponents", Opt_PolymorphicComponents, const Supported ), ( "ExistentialQuantification", Opt_ExistentialQuantification, const Supported ), ( "KindSignatures", Opt_KindSignatures, const Supported ), - ( "PatternSignatures", Opt_PatternSignatures, const Supported ), ( "EmptyDataDecls", Opt_EmptyDataDecls, const Supported ), ( "ParallelListComp", Opt_ParallelListComp, const Supported ), ( "TransformListComp", Opt_TransformListComp, const Supported ), @@ -1578,6 +1625,10 @@ xFlags = [ ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ImplicitParams", Opt_ImplicitParams, const Supported ), ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), + + ( "PatternSignatures", Opt_ScopedTypeVariables, + deprecatedForLanguage "ScopedTypeVariables" ), + ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), @@ -1590,7 +1641,8 @@ xFlags = [ ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ), ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ), ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), - ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ) + ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ), + ( "PackageImports", Opt_PackageImports, const Supported ) ] impliedFlags :: [(DynFlag, [DynFlag])] @@ -1632,14 +1684,14 @@ glasgowExtsFlags = [ , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures - , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving , Opt_TypeFamilies ] -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. -parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String]) +parseDynamicFlags :: DynFlags -> [Located String] + -> IO (DynFlags, [Located String], [Located String]) parseDynamicFlags dflags args = do -- XXX Legacy support code -- We used to accept things like @@ -1648,14 +1700,13 @@ parseDynamicFlags dflags args = do -- optdep -f -optdepdepend -- optdep -f -optdep depend -- but the spaces trip up proper argument handling. So get rid of them. - let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs + let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs f (x : xs) = x : f xs f xs = xs args' = f args let ((leftover, errs, warns), dflags') = runCmdLine (processArgs dynamic_flags args') dflags - when (not (null errs)) $ do - throwDyn (UsageError (unlines errs)) + when (not (null errs)) $ ghcError $ errorsToGhcException errs return (dflags', leftover, warns) type DynP = CmdLineP DynFlags @@ -1747,7 +1798,7 @@ ignorePackage p = setPackageName :: String -> DynFlags -> DynFlags setPackageName p | Nothing <- unpackPackageId pid - = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) + = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) | otherwise = \s -> s{ thisPackage = pid } where @@ -1821,6 +1872,13 @@ setMainIs arg where (main_mod, main_fn) = splitLongestPrefix arg (== '.') +-- | Get the unqualified name of the function to use as the \"main\" for the main module. +-- Either returns the default name or the one configured on the command line with -main-is +getMainFun :: DynFlags -> RdrName +getMainFun dflags = case (mainFunIs dflags) of + Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) + Nothing -> main_RDR_Unqual + ----------------------------------------------------------------------------- -- Paths & Libraries