compiler/main/DynFlags.hs

   1 {-# OPTIONS_GHC -w #-}
   2 -- Temporary, until rtsIsProfiled is fixed
   3
   4 -- |
   5 -- Dynamic flags
   6 --
   7 --
   8 -- (c) The University of Glasgow 2005
   9 --
  10
  11 -- Most flags are dynamic flags, which means they can change from
  12 -- compilation to compilation using @OPTIONS_GHC@ pragmas, and in a
  13 -- multi-session GHC each session can be using different dynamic
  14 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
  15 module DynFlags (
  16         -- * Dynamic flags and associated configuration types
  17         DynFlag(..),
  18         ExtensionFlag(..),
  19         glasgowExtsFlags,
  20         dopt,
  21         dopt_set,
  22         dopt_unset,
  23         xopt,
  24         xopt_set,
  25         xopt_unset,
  26         DynFlags(..),
  27         RtsOptsEnabled(..),
  28         HscTarget(..), isObjectTarget, defaultObjectTarget,
  29         GhcMode(..), isOneShot,
  30         GhcLink(..), isNoLink,
  31         PackageFlag(..),
  32         Option(..), showOpt,
  33         DynLibLoader(..),
  34         fFlags, fLangFlags, xFlags,
  35         dphPackage,
  36         wayNames,
  37
  38         -- ** Manipulating DynFlags
  39         defaultDynFlags,                -- DynFlags
  40         initDynFlags,                   -- DynFlags -> IO DynFlags
  41
  42         getOpts,                        -- DynFlags -> (DynFlags -> [a]) -> [a]
  43         getVerbFlag,
  44         updOptLevel,
  45         setTmpDir,
  46         setPackageName,
  47         doingTickyProfiling,
  48
  49         -- ** Parsing DynFlags
  50         parseDynamicFlags,
  51         parseDynamicNoPackageFlags,
  52         allFlags,
  53
  54         supportedLanguagesAndExtensions,
  55
  56         -- ** DynFlag C compiler options
  57         machdepCCOpts, picCCOpts,
  58
  59         -- * Configuration of the stg-to-stg passes
  60         StgToDo(..),
  61         getStgToDo,
  62
  63         -- * Compiler configuration suitable for display to the user
  64         Printable(..),
  65         compilerInfo
  66 #ifdef GHCI
  67 -- Only in stage 2 can we be sure that the RTS
  68 -- exposes the appropriate runtime boolean
  69         , rtsIsProfiled
  70 #endif
  71   ) where
  72
  73 #include "HsVersions.h"
  74
  75 #ifndef OMIT_NATIVE_CODEGEN
  76 import Platform
  77 #endif
  78 import Module
  79 import PackageConfig
  80 import PrelNames        ( mAIN )
  81 import StaticFlags
  82 import {-# SOURCE #-} Packages (PackageState)
  83 import DriverPhases     ( Phase(..), phaseInputExt )
  84 import Config
  85 import CmdLineParser
  86 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
  87 import Panic
  88 import Util
  89 import Maybes           ( orElse )
  90 import SrcLoc
  91 import FastString
  92 import Outputable
  93 import Foreign.C        ( CInt )
  94 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
  95
  96 import System.IO.Unsafe ( unsafePerformIO )
  97 import Data.IORef
  98 import Control.Monad    ( when )
  99
 100 import Data.Char
 101 import Data.List
 102 import Data.Map (Map)
 103 import qualified Data.Map as Map
 104 import System.FilePath
 105 import System.IO        ( stderr, hPutChar )
 106
 107 -- -----------------------------------------------------------------------------
 108 -- DynFlags
 109
 110 -- | Enumerates the simple on-or-off dynamic flags
 111 data DynFlag
 112
 113    -- debugging flags
 114    = Opt_D_dump_cmm
 115    | Opt_D_dump_cmmz
 116    | Opt_D_dump_cmmz_pretty
 117    | Opt_D_dump_cps_cmm
 118    | Opt_D_dump_cvt_cmm
 119    | Opt_D_dump_asm
 120    | Opt_D_dump_asm_native
 121    | Opt_D_dump_asm_liveness
 122    | Opt_D_dump_asm_coalesce
 123    | Opt_D_dump_asm_regalloc
 124    | Opt_D_dump_asm_regalloc_stages
 125    | Opt_D_dump_asm_conflicts
 126    | Opt_D_dump_asm_stats
 127    | Opt_D_dump_asm_expanded
 128    | Opt_D_dump_llvm
 129    | Opt_D_dump_cpranal
 130    | Opt_D_dump_deriv
 131    | Opt_D_dump_ds
 132    | Opt_D_dump_flatC
 133    | Opt_D_dump_foreign
 134    | Opt_D_dump_inlinings
 135    | Opt_D_dump_rule_firings
 136    | Opt_D_dump_occur_anal
 137    | Opt_D_dump_parsed
 138    | Opt_D_dump_rn
 139    | Opt_D_dump_simpl
 140    | Opt_D_dump_simpl_iterations
 141    | Opt_D_dump_simpl_phases
 142    | Opt_D_dump_spec
 143    | Opt_D_dump_prep
 144    | Opt_D_dump_stg
 145    | Opt_D_dump_stranal
 146    | Opt_D_dump_tc
 147    | Opt_D_dump_types
 148    | Opt_D_dump_rules
 149    | Opt_D_dump_cse
 150    | Opt_D_dump_worker_wrapper
 151    | Opt_D_dump_rn_trace
 152    | Opt_D_dump_rn_stats
 153    | Opt_D_dump_opt_cmm
 154    | Opt_D_dump_simpl_stats
 155    | Opt_D_dump_tc_trace
 156    | Opt_D_dump_if_trace
 157    | Opt_D_dump_splices
 158    | Opt_D_dump_BCOs
 159    | Opt_D_dump_vect
 160    | Opt_D_dump_hpc
 161    | Opt_D_dump_rtti
 162    | Opt_D_source_stats
 163    | Opt_D_verbose_core2core
 164    | Opt_D_verbose_stg2stg
 165    | Opt_D_dump_hi
 166    | Opt_D_dump_hi_diffs
 167    | Opt_D_dump_minimal_imports
 168    | Opt_D_dump_mod_cycles
 169    | Opt_D_dump_view_pattern_commoning
 170    | Opt_D_faststring_stats
 171    | Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.
 172    | Opt_D_no_debug_output
 173    | Opt_DoCoreLinting
 174    | Opt_DoStgLinting
 175    | Opt_DoCmmLinting
 176    | Opt_DoAsmLinting
 177
 178    | Opt_WarnIsError                    -- -Werror; makes warnings fatal
 179    | Opt_WarnDuplicateExports
 180    | Opt_WarnHiShadows
 181    | Opt_WarnImplicitPrelude
 182    | Opt_WarnIncompletePatterns
 183    | Opt_WarnIncompletePatternsRecUpd
 184    | Opt_WarnMissingFields
 185    | Opt_WarnMissingImportList
 186    | Opt_WarnMissingMethods
 187    | Opt_WarnMissingSigs
 188    | Opt_WarnMissingLocalSigs
 189    | Opt_WarnNameShadowing
 190    | Opt_WarnOverlappingPatterns
 191    | Opt_WarnTypeDefaults
 192    | Opt_WarnMonomorphism
 193    | Opt_WarnUnusedBinds
 194    | Opt_WarnUnusedImports
 195    | Opt_WarnUnusedMatches
 196    | Opt_WarnWarningsDeprecations
 197    | Opt_WarnDeprecatedFlags
 198    | Opt_WarnDodgyExports
 199    | Opt_WarnDodgyImports
 200    | Opt_WarnOrphans
 201    | Opt_WarnAutoOrphans
 202    | Opt_WarnIdentities
 203    | Opt_WarnTabs
 204    | Opt_WarnUnrecognisedPragmas
 205    | Opt_WarnDodgyForeignImports
 206    | Opt_WarnLazyUnliftedBindings
 207    | Opt_WarnUnusedDoBind
 208    | Opt_WarnWrongDoBind
 209    | Opt_WarnAlternativeLayoutRuleTransitional
 210
 211    | Opt_PrintExplicitForalls
 212
 213    -- optimisation opts
 214    | Opt_Strictness
 215    | Opt_FullLaziness
 216    | Opt_FloatIn
 217    | Opt_Specialise
 218    | Opt_StaticArgumentTransformation
 219    | Opt_CSE
 220    | Opt_LiberateCase
 221    | Opt_SpecConstr
 222    | Opt_DoLambdaEtaExpansion
 223    | Opt_IgnoreAsserts
 224    | Opt_DoEtaReduction
 225    | Opt_CaseMerge
 226    | Opt_UnboxStrictFields
 227    | Opt_MethodSharing  -- Now a no-op; remove in GHC 7.2
 228    | Opt_DictsCheap
 229    | Opt_EnableRewriteRules             -- Apply rewrite rules during simplification
 230    | Opt_Vectorise
 231    | Opt_RegsGraph                      -- do graph coloring register allocation
 232    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
 233
 234    -- Interface files
 235    | Opt_IgnoreInterfacePragmas
 236    | Opt_OmitInterfacePragmas
 237    | Opt_ExposeAllUnfoldings
 238
 239    -- profiling opts
 240    | Opt_AutoSccsOnAllToplevs
 241    | Opt_AutoSccsOnExportedToplevs
 242    | Opt_AutoSccsOnIndividualCafs
 243
 244    -- misc opts
 245    | Opt_Pp
 246    | Opt_ForceRecomp
 247    | Opt_DryRun
 248    | Opt_DoAsmMangling
 249    | Opt_ExcessPrecision
 250    | Opt_EagerBlackHoling
 251    | Opt_ReadUserPackageConf
 252    | Opt_NoHsMain
 253    | Opt_SplitObjs
 254    | Opt_StgStats
 255    | Opt_HideAllPackages
 256    | Opt_PrintBindResult
 257    | Opt_Haddock
 258    | Opt_HaddockOptions
 259    | Opt_Hpc_No_Auto
 260    | Opt_BreakOnException
 261    | Opt_BreakOnError
 262    | Opt_PrintEvldWithShow
 263    | Opt_PrintBindContents
 264    | Opt_GenManifest
 265    | Opt_EmbedManifest
 266    | Opt_EmitExternalCore
 267    | Opt_SharedImplib
 268    | Opt_BuildingCabalPackage
 269    | Opt_SSE2
 270    | Opt_GhciSandbox
 271
 272         -- temporary flags
 273    | Opt_RunCPS
 274    | Opt_RunCPSZ
 275    | Opt_ConvertToZipCfgAndBack
 276    | Opt_AutoLinkPackages
 277    | Opt_ImplicitImportQualified
 278    | Opt_TryNewCodeGen
 279
 280    -- keeping stuff
 281    | Opt_KeepHiDiffs
 282    | Opt_KeepHcFiles
 283    | Opt_KeepSFiles
 284    | Opt_KeepRawSFiles
 285    | Opt_KeepTmpFiles
 286    | Opt_KeepRawTokenStream
 287    | Opt_KeepLlvmFiles
 288
 289    deriving (Eq, Show)
 290
 291 data Language = Haskell98 | Haskell2010
 292
 293 data ExtensionFlag
 294    = Opt_Cpp
 295    | Opt_OverlappingInstances
 296    | Opt_UndecidableInstances
 297    | Opt_IncoherentInstances
 298    | Opt_MonomorphismRestriction
 299    | Opt_MonoPatBinds
 300    | Opt_MonoLocalBinds
 301    | Opt_RelaxedPolyRec         -- Deprecated
 302    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
 303    | Opt_ForeignFunctionInterface
 304    | Opt_UnliftedFFITypes
 305    | Opt_GHCForeignImportPrim
 306    | Opt_PArr                           -- Syntactic support for parallel arrays
 307    | Opt_Arrows                         -- Arrow-notation syntax
 308    | Opt_TemplateHaskell
 309    | Opt_QuasiQuotes
 310    | Opt_ImplicitParams
 311    | Opt_Generics                       -- "Derivable type classes"
 312    | Opt_ImplicitPrelude
 313    | Opt_ScopedTypeVariables
 314    | Opt_UnboxedTuples
 315    | Opt_BangPatterns
 316    | Opt_TypeFamilies
 317    | Opt_OverloadedStrings
 318    | Opt_DisambiguateRecordFields
 319    | Opt_RecordWildCards
 320    | Opt_RecordPuns
 321    | Opt_ViewPatterns
 322    | Opt_GADTs
 323    | Opt_NPlusKPatterns
 324    | Opt_DoAndIfThenElse
 325    | Opt_RebindableSyntax
 326
 327    | Opt_StandaloneDeriving
 328    | Opt_DeriveDataTypeable
 329    | Opt_DeriveFunctor
 330    | Opt_DeriveTraversable
 331    | Opt_DeriveFoldable
 332
 333    | Opt_TypeSynonymInstances
 334    | Opt_FlexibleContexts
 335    | Opt_FlexibleInstances
 336    | Opt_ConstrainedClassMethods
 337    | Opt_MultiParamTypeClasses
 338    | Opt_FunctionalDependencies
 339    | Opt_UnicodeSyntax
 340    | Opt_PolymorphicComponents
 341    | Opt_ExistentialQuantification
 342    | Opt_MagicHash
 343    | Opt_EmptyDataDecls
 344    | Opt_KindSignatures
 345    | Opt_ParallelListComp
 346    | Opt_TransformListComp
 347    | Opt_GeneralizedNewtypeDeriving
 348    | Opt_RecursiveDo
 349    | Opt_DoRec
 350    | Opt_PostfixOperators
 351    | Opt_TupleSections
 352    | Opt_PatternGuards
 353    | Opt_LiberalTypeSynonyms
 354    | Opt_Rank2Types
 355    | Opt_RankNTypes
 356    | Opt_ImpredicativeTypes
 357    | Opt_TypeOperators
 358    | Opt_PackageImports
 359    | Opt_NewQualifiedOperators
 360    | Opt_ExplicitForAll
 361    | Opt_AlternativeLayoutRule
 362    | Opt_AlternativeLayoutRuleTransitional
 363    | Opt_DatatypeContexts
 364    deriving (Eq, Show)
 365
 366 -- | Contains not only a collection of 'DynFlag's but also a plethora of
 367 -- information relating to the compilation of a single file or GHC session
 368 data DynFlags = DynFlags {
 369   ghcMode               :: GhcMode,
 370   ghcLink               :: GhcLink,
 371   hscTarget             :: HscTarget,
 372   hscOutName            :: String,      -- ^ Name of the output file
 373   extCoreName           :: String,      -- ^ Name of the .hcr output file
 374   verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]
 375   optLevel              :: Int,         -- ^ Optimisation level
 376   simplPhases           :: Int,         -- ^ Number of simplifier phases
 377   maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
 378   shouldDumpSimplPhase  :: Maybe String,
 379   ruleCheck             :: Maybe String,
 380   strictnessBefore      :: [Int],       -- ^ Additional demand analysis
 381
 382   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
 383   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
 384   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
 385   floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating
 386                                         --   See CoreMonad.FloatOutSwitches
 387
 388 #ifndef OMIT_NATIVE_CODEGEN
 389   targetPlatform        :: Platform,    -- ^ The platform we're compiling for. Used by the NCG.
 390 #endif
 391   stolen_x86_regs       :: Int,
 392   cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
 393   importPaths           :: [FilePath],
 394   mainModIs             :: Module,
 395   mainFunIs             :: Maybe String,
 396   ctxtStkDepth          :: Int,         -- ^ Typechecker context stack depth
 397
 398   dphBackend            :: DPHBackend,
 399
 400   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 401
 402   -- ways
 403   ways                  :: [Way],       -- ^ Way flags from the command line
 404   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
 405   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 406
 407   -- For object splitting
 408   splitInfo             :: Maybe (String,Int),
 409
 410   -- paths etc.
 411   objectDir             :: Maybe String,
 412   dylibInstallName      :: Maybe String,
 413   hiDir                 :: Maybe String,
 414   stubDir               :: Maybe String,
 415
 416   objectSuf             :: String,
 417   hcSuf                 :: String,
 418   hiSuf                 :: String,
 419
 420   outputFile            :: Maybe String,
 421   outputHi              :: Maybe String,
 422   dynLibLoader          :: DynLibLoader,
 423
 424   -- | This is set by 'DriverPipeline.runPipeline' based on where
 425   --    its output is going.
 426   dumpPrefix            :: Maybe FilePath,
 427
 428   -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
 429   --    Set by @-ddump-file-prefix@
 430   dumpPrefixForce       :: Maybe FilePath,
 431
 432   includePaths          :: [String],
 433   libraryPaths          :: [String],
 434   frameworkPaths        :: [String],    -- used on darwin only
 435   cmdlineFrameworks     :: [String],    -- ditto
 436   tmpDir                :: String,      -- no trailing '/'
 437
 438   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
 439   ghciUsagePath         :: FilePath,    -- ditto
 440   rtsOpts               :: Maybe String,
 441   rtsOptsEnabled        :: RtsOptsEnabled,
 442
 443   hpcDir                :: String,      -- ^ Path to store the .mix files
 444
 445   -- options for particular phases
 446   opt_L                 :: [String],
 447   opt_P                 :: [String],
 448   opt_F                 :: [String],
 449   opt_c                 :: [String],
 450   opt_m                 :: [String],
 451   opt_a                 :: [String],
 452   opt_l                 :: [String],
 453   opt_windres           :: [String],
 454   opt_lo                :: [String], -- LLVM: llvm optimiser
 455   opt_lc                :: [String], -- LLVM: llc static compiler
 456
 457   -- commands for particular phases
 458   pgm_L                 :: String,
 459   pgm_P                 :: (String,[Option]),
 460   pgm_F                 :: String,
 461   pgm_c                 :: (String,[Option]),
 462   pgm_m                 :: (String,[Option]),
 463   pgm_s                 :: (String,[Option]),
 464   pgm_a                 :: (String,[Option]),
 465   pgm_l                 :: (String,[Option]),
 466   pgm_dll               :: (String,[Option]),
 467   pgm_T                 :: String,
 468   pgm_sysman            :: String,
 469   pgm_windres           :: String,
 470   pgm_lo                :: (String,[Option]), -- LLVM: opt llvm optimiser
 471   pgm_lc                :: (String,[Option]), -- LLVM: llc static compiler
 472
 473   --  For ghc -M
 474   depMakefile           :: FilePath,
 475   depIncludePkgDeps     :: Bool,
 476   depExcludeMods        :: [ModuleName],
 477   depSuffixes           :: [String],
 478
 479   --  Package flags
 480   extraPkgConfs         :: [FilePath],
 481   topDir                :: FilePath,    -- filled in by SysTools
 482   systemPackageConfig   :: FilePath,    -- ditto
 483         -- ^ The @-package-conf@ flags given on the command line, in the order
 484         -- they appeared.
 485
 486   packageFlags          :: [PackageFlag],
 487         -- ^ The @-package@ and @-hide-package@ flags from the command-line
 488
 489   -- Package state
 490   -- NB. do not modify this field, it is calculated by
 491   -- Packages.initPackages and Packages.updatePackages.
 492   pkgDatabase           :: Maybe [PackageConfig],
 493   pkgState              :: PackageState,
 494
 495   -- Temporary files
 496   -- These have to be IORefs, because the defaultCleanupHandler needs to
 497   -- know what to clean when an exception happens
 498   filesToClean          :: IORef [FilePath],
 499   dirsToClean           :: IORef (Map FilePath FilePath),
 500
 501   -- hsc dynamic flags
 502   flags                 :: [DynFlag],
 503   -- Don't change this without updating extensionFlags:
 504   language              :: Maybe Language,
 505   -- Don't change this without updating extensionFlags:
 506   extensions            :: [OnOff ExtensionFlag],
 507   -- extensionFlags should always be equal to
 508   --     flattenExtensionFlags language extensions
 509   extensionFlags        :: [ExtensionFlag],
 510
 511   -- | Message output action: use "ErrUtils" instead of this if you can
 512   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 513
 514   haddockOptions :: Maybe String
 515  }
 516
 517 wayNames :: DynFlags -> [WayName]
 518 wayNames = map wayName . ways
 519
 520 -- | The target code type of the compilation (if any).
 521 --
 522 -- Whenever you change the target, also make sure to set 'ghcLink' to
 523 -- something sensible.
 524 --
 525 -- 'HscNothing' can be used to avoid generating any output, however, note
 526 -- that:
 527 --
 528 --  * This will not run the desugaring step, thus no warnings generated in
 529 --    this step will be output.  In particular, this includes warnings related
 530 --    to pattern matching.  You can run the desugarer manually using
 531 --    'GHC.desugarModule'.
 532 --
 533 --  * If a program uses Template Haskell the typechecker may try to run code
 534 --    from an imported module.  This will fail if no code has been generated
 535 --    for this module.  You can use 'GHC.needsTemplateHaskell' to detect
 536 --    whether this might be the case and choose to either switch to a
 537 --    different target or avoid typechecking such modules.  (The latter may
 538 --    preferable for security reasons.)
 539 --
 540 data HscTarget
 541   = HscC           -- ^ Generate C code.
 542   | HscAsm         -- ^ Generate assembly using the native code generator.
 543   | HscLlvm        -- ^ Generate assembly using the llvm code generator.
 544   | HscJava        -- ^ Generate Java bytecode.
 545   | HscInterpreted -- ^ Generate bytecode.  (Requires 'LinkInMemory')
 546   | HscNothing     -- ^ Don't generate any code.  See notes above.
 547   deriving (Eq, Show)
 548
 549 -- | Will this target result in an object file on the disk?
 550 isObjectTarget :: HscTarget -> Bool
 551 isObjectTarget HscC     = True
 552 isObjectTarget HscAsm   = True
 553 isObjectTarget HscLlvm  = True
 554 isObjectTarget _        = False
 555
 556 -- | The 'GhcMode' tells us whether we're doing multi-module
 557 -- compilation (controlled via the "GHC" API) or one-shot
 558 -- (single-module) compilation.  This makes a difference primarily to
 559 -- the "Finder": in one-shot mode we look for interface files for
 560 -- imported modules, but in multi-module mode we look for source files
 561 -- in order to check whether they need to be recompiled.
 562 data GhcMode
 563   = CompManager         -- ^ @\-\-make@, GHCi, etc.
 564   | OneShot             -- ^ @ghc -c Foo.hs@
 565   | MkDepend            -- ^ @ghc -M@, see "Finder" for why we need this
 566   deriving Eq
 567
 568 instance Outputable GhcMode where
 569   ppr CompManager = ptext (sLit "CompManager")
 570   ppr OneShot     = ptext (sLit "OneShot")
 571   ppr MkDepend    = ptext (sLit "MkDepend")
 572
 573 isOneShot :: GhcMode -> Bool
 574 isOneShot OneShot = True
 575 isOneShot _other  = False
 576
 577 -- | What to do in the link step, if there is one.
 578 data GhcLink
 579   = NoLink              -- ^ Don't link at all
 580   | LinkBinary          -- ^ Link object code into a binary
 581   | LinkInMemory        -- ^ Use the in-memory dynamic linker (works for both
 582                         --   bytecode and object code).
 583   | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
 584   deriving (Eq, Show)
 585
 586 isNoLink :: GhcLink -> Bool
 587 isNoLink NoLink = True
 588 isNoLink _      = False
 589
 590 -- Is it worth evaluating this Bool and caching it in the DynFlags value
 591 -- during initDynFlags?
 592 doingTickyProfiling :: DynFlags -> Bool
 593 doingTickyProfiling _ = opt_Ticky
 594   -- XXX -ticky is a static flag, because it implies -debug which is also
 595   -- static.  If the way flags were made dynamic, we could fix this.
 596
 597 data PackageFlag
 598   = ExposePackage  String
 599   | ExposePackageId String
 600   | HidePackage    String
 601   | IgnorePackage  String
 602   deriving Eq
 603
 604 defaultHscTarget :: HscTarget
 605 defaultHscTarget = defaultObjectTarget
 606
 607 -- | The 'HscTarget' value corresponding to the default way to create
 608 -- object files on the current platform.
 609 defaultObjectTarget :: HscTarget
 610 defaultObjectTarget
 611   | cGhcWithNativeCodeGen == "YES"      =  HscAsm
 612   | otherwise                           =  HscC
 613
 614 data DynLibLoader
 615   = Deployable
 616   | SystemDependent
 617   deriving Eq
 618
 619 data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
 620
 621 -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
 622 initDynFlags :: DynFlags -> IO DynFlags
 623 initDynFlags dflags = do
 624  -- someday these will be dynamic flags
 625  ways <- readIORef v_Ways
 626  refFilesToClean <- newIORef []
 627  refDirsToClean <- newIORef Map.empty
 628  return dflags{
 629         ways            = ways,
 630         buildTag        = mkBuildTag (filter (not . wayRTSOnly) ways),
 631         rtsBuildTag     = mkBuildTag ways,
 632         filesToClean    = refFilesToClean,
 633         dirsToClean     = refDirsToClean
 634         }
 635
 636 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
 637 -- and must be fully initialized by 'GHC.newSession' first.
 638 defaultDynFlags :: DynFlags
 639 defaultDynFlags =
 640      DynFlags {
 641         ghcMode                 = CompManager,
 642         ghcLink                 = LinkBinary,
 643         hscTarget               = defaultHscTarget,
 644         hscOutName              = "",
 645         extCoreName             = "",
 646         verbosity               = 0,
 647         optLevel                = 0,
 648         simplPhases             = 2,
 649         maxSimplIterations      = 4,
 650         shouldDumpSimplPhase    = Nothing,
 651         ruleCheck               = Nothing,
 652         specConstrThreshold     = Just 200,
 653         specConstrCount         = Just 3,
 654         liberateCaseThreshold   = Just 200,
 655         floatLamArgs            = Just 0,       -- Default: float only if no fvs
 656         strictnessBefore        = [],
 657
 658 #ifndef OMIT_NATIVE_CODEGEN
 659         targetPlatform          = defaultTargetPlatform,
 660 #endif
 661         stolen_x86_regs         = 4,
 662         cmdlineHcIncludes       = [],
 663         importPaths             = ["."],
 664         mainModIs               = mAIN,
 665         mainFunIs               = Nothing,
 666         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 667
 668         dphBackend              = DPHPar,
 669
 670         thisPackage             = mainPackageId,
 671
 672         objectDir               = Nothing,
 673         dylibInstallName        = Nothing,
 674         hiDir                   = Nothing,
 675         stubDir                 = Nothing,
 676
 677         objectSuf               = phaseInputExt StopLn,
 678         hcSuf                   = phaseInputExt HCc,
 679         hiSuf                   = "hi",
 680
 681         outputFile              = Nothing,
 682         outputHi                = Nothing,
 683         dynLibLoader            = SystemDependent,
 684         dumpPrefix              = Nothing,
 685         dumpPrefixForce         = Nothing,
 686         includePaths            = [],
 687         libraryPaths            = [],
 688         frameworkPaths          = [],
 689         cmdlineFrameworks       = [],
 690         tmpDir                  = cDEFAULT_TMPDIR,
 691         rtsOpts                 = Nothing,
 692         rtsOptsEnabled          = RtsOptsSafeOnly,
 693
 694         hpcDir                  = ".hpc",
 695
 696         opt_L                   = [],
 697         opt_P                   = (if opt_PIC
 698                                    then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
 699                                    else []),
 700         opt_F                   = [],
 701         opt_c                   = [],
 702         opt_a                   = [],
 703         opt_m                   = [],
 704         opt_l                   = [],
 705         opt_windres             = [],
 706         opt_lo                  = [],
 707         opt_lc                  = [],
 708
 709         extraPkgConfs           = [],
 710         packageFlags            = [],
 711         pkgDatabase             = Nothing,
 712         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
 713         ways                    = panic "defaultDynFlags: No ways",
 714         buildTag                = panic "defaultDynFlags: No buildTag",
 715         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
 716         splitInfo               = Nothing,
 717         -- initSysTools fills all these in
 718         ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
 719         ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
 720         topDir                  = panic "defaultDynFlags: No topDir",
 721         systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
 722         pgm_L                   = panic "defaultDynFlags: No pgm_L",
 723         pgm_P                   = panic "defaultDynFlags: No pgm_P",
 724         pgm_F                   = panic "defaultDynFlags: No pgm_F",
 725         pgm_c                   = panic "defaultDynFlags: No pgm_c",
 726         pgm_m                   = panic "defaultDynFlags: No pgm_m",
 727         pgm_s                   = panic "defaultDynFlags: No pgm_s",
 728         pgm_a                   = panic "defaultDynFlags: No pgm_a",
 729         pgm_l                   = panic "defaultDynFlags: No pgm_l",
 730         pgm_dll                 = panic "defaultDynFlags: No pgm_dll",
 731         pgm_T                   = panic "defaultDynFlags: No pgm_T",
 732         pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
 733         pgm_windres             = panic "defaultDynFlags: No pgm_windres",
 734         pgm_lo                  = panic "defaultDynFlags: No pgm_lo",
 735         pgm_lc                  = panic "defaultDynFlags: No pgm_lc",
 736         -- end of initSysTools values
 737         -- ghc -M values
 738         depMakefile       = "Makefile",
 739         depIncludePkgDeps = False,
 740         depExcludeMods    = [],
 741         depSuffixes       = [],
 742         -- end of ghc -M values
 743         filesToClean   = panic "defaultDynFlags: No filesToClean",
 744         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
 745         haddockOptions = Nothing,
 746         flags = defaultFlags,
 747         language = Nothing,
 748         extensions = [],
 749         extensionFlags = flattenExtensionFlags Nothing [],
 750
 751         log_action = \severity srcSpan style msg ->
 752                         case severity of
 753                           SevOutput -> printOutput (msg style)
 754                           SevInfo   -> printErrs (msg style)
 755                           SevFatal  -> printErrs (msg style)
 756                           _         -> do
 757                                 hPutChar stderr '\n'
 758                                 printErrs ((mkLocMessage srcSpan msg) style)
 759                      -- careful (#2302): printErrs prints in UTF-8, whereas
 760                      -- converting to string first and using hPutStr would
 761                      -- just emit the low 8 bits of each unicode char.
 762       }
 763
 764 {-
 765 Note [Verbosity levels]
 766 ~~~~~~~~~~~~~~~~~~~~~~~
 767     0   |   print errors & warnings only
 768     1   |   minimal verbosity: print "compiling M ... done." for each module.
 769     2   |   equivalent to -dshow-passes
 770     3   |   equivalent to existing "ghc -v"
 771     4   |   "ghc -v -ddump-most"
 772     5   |   "ghc -v -ddump-all"
 773 -}
 774
 775 data OnOff a = On a
 776              | Off a
 777
 778 -- OnOffs accumulate in reverse order, so we use foldr in order to
 779 -- process them in the right order
 780 flattenExtensionFlags :: Maybe Language -> [OnOff ExtensionFlag]
 781                       -> [ExtensionFlag]
 782 flattenExtensionFlags ml = foldr f defaultExtensionFlags
 783     where f (On f)  flags = f : delete f flags
 784           f (Off f) flags =     delete f flags
 785           defaultExtensionFlags = languageExtensions ml
 786
 787 languageExtensions :: Maybe Language -> [ExtensionFlag]
 788
 789 languageExtensions Nothing
 790     -- Nothing => the default case
 791     = Opt_MonoPatBinds   -- Experimentally, I'm making this non-standard
 792                          -- behaviour the default, to see if anyone notices
 793                          -- SLPJ July 06
 794       -- In due course I'd like Opt_MonoLocalBinds to be on by default
 795       -- But NB it's implied by GADTs etc
 796       -- SLPJ September 2010
 797     : languageExtensions (Just Haskell2010)
 798
 799 languageExtensions (Just Haskell98)
 800     = [Opt_ImplicitPrelude,
 801        Opt_MonomorphismRestriction,
 802        Opt_NPlusKPatterns,
 803        Opt_DatatypeContexts]
 804
 805 languageExtensions (Just Haskell2010)
 806     = [Opt_ImplicitPrelude,
 807        Opt_MonomorphismRestriction,
 808        Opt_DatatypeContexts,
 809        Opt_EmptyDataDecls,
 810        Opt_ForeignFunctionInterface,
 811        Opt_PatternGuards,
 812        Opt_DoAndIfThenElse,
 813        Opt_RelaxedPolyRec]
 814
 815 -- | Test whether a 'DynFlag' is set
 816 dopt :: DynFlag -> DynFlags -> Bool
 817 dopt f dflags  = f `elem` (flags dflags)
 818
 819 -- | Set a 'DynFlag'
 820 dopt_set :: DynFlags -> DynFlag -> DynFlags
 821 dopt_set dfs f = dfs{ flags = f : flags dfs }
 822
 823 -- | Unset a 'DynFlag'
 824 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 825 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 826
 827 -- | Test whether a 'ExtensionFlag' is set
 828 xopt :: ExtensionFlag -> DynFlags -> Bool
 829 xopt f dflags = f `elem` extensionFlags dflags
 830
 831 -- | Set a 'ExtensionFlag'
 832 xopt_set :: DynFlags -> ExtensionFlag -> DynFlags
 833 xopt_set dfs f
 834     = let onoffs = On f : extensions dfs
 835       in dfs { extensions = onoffs,
 836                extensionFlags = flattenExtensionFlags (language dfs) onoffs }
 837
 838 -- | Unset a 'ExtensionFlag'
 839 xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags
 840 xopt_unset dfs f
 841     = let onoffs = Off f : extensions dfs
 842       in dfs { extensions = onoffs,
 843                extensionFlags = flattenExtensionFlags (language dfs) onoffs }
 844
 845 setLanguage :: Language -> DynP ()
 846 setLanguage l = upd f
 847     where f dfs = let mLang = Just l
 848                       oneoffs = extensions dfs
 849                   in dfs {
 850                          language = mLang,
 851                          extensionFlags = flattenExtensionFlags mLang oneoffs
 852                      }
 853
 854 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 855 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
 856         -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
 857         -> [a]                  -- ^ Correctly ordered extracted options
 858 getOpts dflags opts = reverse (opts dflags)
 859         -- We add to the options from the front, so we need to reverse the list
 860
 861 -- | Gets the verbosity flag for the current verbosity level. This is fed to
 862 -- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
 863 getVerbFlag :: DynFlags -> String
 864 getVerbFlag dflags
 865   | verbosity dflags >= 3  = "-v"
 866   | otherwise =  ""
 867
 868 setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName,
 869          setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
 870          setPgmP, addOptl, addOptP,
 871          addCmdlineFramework, addHaddockOpts
 872    :: String -> DynFlags -> DynFlags
 873 setOutputFile, setOutputHi, setDumpPrefixForce
 874    :: Maybe String -> DynFlags -> DynFlags
 875
 876 setObjectDir  f d = d{ objectDir  = Just f}
 877 setHiDir      f d = d{ hiDir      = Just f}
 878 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
 879   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
 880   -- \#included from the .hc file when compiling with -fvia-C.
 881 setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
 882 setDylibInstallName  f d = d{ dylibInstallName = Just f}
 883
 884 setObjectSuf  f d = d{ objectSuf  = f}
 885 setHiSuf      f d = d{ hiSuf      = f}
 886 setHcSuf      f d = d{ hcSuf      = f}
 887
 888 setOutputFile f d = d{ outputFile = f}
 889 setOutputHi   f d = d{ outputHi   = f}
 890
 891 parseDynLibLoaderMode f d =
 892  case splitAt 8 f of
 893    ("deploy", "")       -> d{ dynLibLoader = Deployable }
 894    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
 895    _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 896
 897 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 898
 899 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 900 -- Config.hs should really use Option.
 901 setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
 902 addOptl   f d = d{ opt_l   = f : opt_l d}
 903 addOptP   f d = d{ opt_P   = f : opt_P d}
 904
 905
 906 setDepMakefile :: FilePath -> DynFlags -> DynFlags
 907 setDepMakefile f d = d { depMakefile = deOptDep f }
 908
 909 setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
 910 setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
 911
 912 addDepExcludeMod :: String -> DynFlags -> DynFlags
 913 addDepExcludeMod m d
 914     = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
 915
 916 addDepSuffix :: FilePath -> DynFlags -> DynFlags
 917 addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
 918
 919 -- XXX Legacy code:
 920 -- We used to use "-optdep-flag -optdeparg", so for legacy applications
 921 -- we need to strip the "-optdep" off of the arg
 922 deOptDep :: String -> String
 923 deOptDep x = case stripPrefix "-optdep" x of
 924              Just rest -> rest
 925              Nothing -> x
 926
 927 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 928
 929 addHaddockOpts f d = d{ haddockOptions = Just f}
 930
 931 -- -----------------------------------------------------------------------------
 932 -- Command-line options
 933
 934 -- | When invoking external tools as part of the compilation pipeline, we
 935 -- pass these a sequence of options on the command-line. Rather than
 936 -- just using a list of Strings, we use a type that allows us to distinguish
 937 -- between filepaths and 'other stuff'. The reason for this is that
 938 -- this type gives us a handle on transforming filenames, and filenames only,
 939 -- to whatever format they're expected to be on a particular platform.
 940 data Option
 941  = FileOption -- an entry that _contains_ filename(s) / filepaths.
 942               String  -- a non-filepath prefix that shouldn't be
 943                       -- transformed (e.g., "/out=")
 944               String  -- the filepath/filename portion
 945  | Option     String
 946
 947 showOpt :: Option -> String
 948 showOpt (FileOption pre f) = pre ++ f
 949 showOpt (Option s)  = s
 950
 951 -----------------------------------------------------------------------------
 952 -- Setting the optimisation level
 953
 954 updOptLevel :: Int -> DynFlags -> DynFlags
 955 -- ^ Sets the 'DynFlags' to be appropriate to the optimisation level
 956 updOptLevel n dfs
 957   = dfs2{ optLevel = final_n }
 958   where
 959    final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2
 960    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
 961    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
 962
 963    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
 964    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 965
 966 -- -----------------------------------------------------------------------------
 967 -- StgToDo:  abstraction of stg-to-stg passes to run.
 968
 969 data StgToDo
 970   = StgDoMassageForProfiling  -- should be (next to) last
 971   -- There's also setStgVarInfo, but its absolute "lastness"
 972   -- is so critical that it is hardwired in (no flag).
 973   | D_stg_stats
 974
 975 getStgToDo :: DynFlags -> [StgToDo]
 976 getStgToDo dflags
 977   = todo2
 978   where
 979         stg_stats = dopt Opt_StgStats dflags
 980
 981         todo1 = if stg_stats then [D_stg_stats] else []
 982
 983         todo2 | WayProf `elem` wayNames dflags
 984               = StgDoMassageForProfiling : todo1
 985               | otherwise
 986               = todo1
 987
 988 {- **********************************************************************
 989 %*                                                                      *
 990                 DynFlags parser
 991 %*                                                                      *
 992 %********************************************************************* -}
 993
 994 -- -----------------------------------------------------------------------------
 995 -- Parsing the dynamic flags.
 996
 997 -- | Parse dynamic flags from a list of command line arguments.  Returns the
 998 -- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
 999 -- Throws a 'UsageError' if errors occurred during parsing (such as unknown
1000 -- flags or missing arguments).
1001 parseDynamicFlags :: Monad m =>
1002                      DynFlags -> [Located String]
1003                   -> m (DynFlags, [Located String], [Located String])
1004                      -- ^ Updated 'DynFlags', left-over arguments, and
1005                      -- list of warnings.
1006 parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
1007
1008 -- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
1009 -- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
1010 parseDynamicNoPackageFlags :: Monad m =>
1011                      DynFlags -> [Located String]
1012                   -> m (DynFlags, [Located String], [Located String])
1013                      -- ^ Updated 'DynFlags', left-over arguments, and
1014                      -- list of warnings.
1015 parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
1016
1017 parseDynamicFlags_ :: Monad m =>
1018                       DynFlags -> [Located String] -> Bool
1019                   -> m (DynFlags, [Located String], [Located String])
1020 parseDynamicFlags_ dflags0 args pkg_flags = do
1021   -- XXX Legacy support code
1022   -- We used to accept things like
1023   --     optdep-f  -optdepdepend
1024   --     optdep-f  -optdep depend
1025   --     optdep -f -optdepdepend
1026   --     optdep -f -optdep depend
1027   -- but the spaces trip up proper argument handling. So get rid of them.
1028   let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
1029       f (x : xs) = x : f xs
1030       f xs = xs
1031       args' = f args
1032
1033       -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
1034       flag_spec | pkg_flags = package_flags ++ dynamic_flags
1035                 | otherwise = dynamic_flags
1036
1037   let ((leftover, errs, warns), dflags1)
1038           = runCmdLine (processArgs flag_spec args') dflags0
1039   when (not (null errs)) $ ghcError $ errorsToGhcException errs
1040
1041   -- Cannot use -fPIC with registerised -fvia-C, because the mangler
1042   -- isn't up to the job.  We know that if hscTarget == HscC, then the
1043   -- user has explicitly used -fvia-C, because -fasm is the default,
1044   -- unless there is no NCG on this platform.  The latter case is
1045   -- checked when the -fPIC flag is parsed.
1046   --
1047   let (pic_warns, dflags2)
1048         | opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO"
1049         = ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"],
1050                 dflags1{ hscTarget = HscAsm })
1051 #if !(x86_64_TARGET_ARCH && linux_TARGET_OS)
1052         | (not opt_Static || opt_PIC) && hscTarget dflags1 == HscLlvm
1053         = ([L noSrcSpan $ "Warning: -fllvm is incompatible with -fPIC and -"
1054                 ++ "dynamic on this platform;\n              ignoring -fllvm"],
1055                 dflags1{ hscTarget = HscAsm })
1056 #endif
1057         | otherwise = ([], dflags1)
1058
1059   return (dflags2, leftover, pic_warns ++ warns)
1060
1061
1062 {- **********************************************************************
1063 %*                                                                      *
1064                 DynFlags specifications
1065 %*                                                                      *
1066 %********************************************************************* -}
1067
1068 allFlags :: [String]
1069 allFlags = map ('-':) $
1070            [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
1071            map ("fno-"++) flags ++
1072            map ("f"++) flags ++
1073            map ("f"++) flags' ++
1074            map ("X"++) supportedExtensions
1075     where ok (PrefixPred _ _) = False
1076           ok _ = True
1077           flags = [ name | (name, _, _) <- fFlags ]
1078           flags' = [ name | (name, _, _) <- fLangFlags ]
1079
1080 --------------- The main flags themselves ------------------
1081 dynamic_flags :: [Flag (CmdLineP DynFlags)]
1082 dynamic_flags = [
1083     Flag "n"        (NoArg (setDynFlag Opt_DryRun))
1084   , Flag "cpp"      (NoArg (setExtensionFlag Opt_Cpp))
1085   , Flag "F"        (NoArg (setDynFlag Opt_Pp))
1086   , Flag "#include"
1087          (HasArg (\s -> do { addCmdlineHCInclude s
1088                            ; addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect" }))
1089   , Flag "v"        (OptIntSuffix setVerbosity)
1090
1091         ------- Specific phases  --------------------------------------------
1092     -- need to appear before -pgmL to be parsed as LLVM flags.
1093   , Flag "pgmlo"          (hasArg (\f d -> d{ pgm_lo  = (f,[])}))
1094   , Flag "pgmlc"          (hasArg (\f d -> d{ pgm_lc  = (f,[])}))
1095   , Flag "pgmL"           (hasArg (\f d -> d{ pgm_L   = f}))
1096   , Flag "pgmP"           (hasArg setPgmP)
1097   , Flag "pgmF"           (hasArg (\f d -> d{ pgm_F   = f}))
1098   , Flag "pgmc"           (hasArg (\f d -> d{ pgm_c   = (f,[])}))
1099   , Flag "pgmm"           (hasArg (\f d -> d{ pgm_m   = (f,[])}))
1100   , Flag "pgms"           (hasArg (\f d -> d{ pgm_s   = (f,[])}))
1101   , Flag "pgma"           (hasArg (\f d -> d{ pgm_a   = (f,[])}))
1102   , Flag "pgml"           (hasArg (\f d -> d{ pgm_l   = (f,[])}))
1103   , Flag "pgmdll"         (hasArg (\f d -> d{ pgm_dll = (f,[])}))
1104   , Flag "pgmwindres"     (hasArg (\f d -> d{ pgm_windres = f}))
1105
1106     -- need to appear before -optl/-opta to be parsed as LLVM flags.
1107   , Flag "optlo"          (hasArg (\f d -> d{ opt_lo  = f : opt_lo d}))
1108   , Flag "optlc"          (hasArg (\f d -> d{ opt_lc  = f : opt_lc d}))
1109   , Flag "optL"           (hasArg (\f d -> d{ opt_L   = f : opt_L d}))
1110   , Flag "optP"           (hasArg addOptP)
1111   , Flag "optF"           (hasArg (\f d -> d{ opt_F   = f : opt_F d}))
1112   , Flag "optc"           (hasArg (\f d -> d{ opt_c   = f : opt_c d}))
1113   , Flag "optm"           (hasArg (\f d -> d{ opt_m   = f : opt_m d}))
1114   , Flag "opta"           (hasArg (\f d -> d{ opt_a   = f : opt_a d}))
1115   , Flag "optl"           (hasArg addOptl)
1116   , Flag "optwindres"     (hasArg (\f d -> d{ opt_windres = f : opt_windres d}))
1117
1118   , Flag "split-objs"
1119          (NoArg (if can_split
1120                  then setDynFlag Opt_SplitObjs
1121                  else addWarn "ignoring -fsplit-objs"))
1122
1123         -------- ghc -M -----------------------------------------------------
1124   , Flag "dep-suffix"     (hasArg addDepSuffix)
1125   , Flag "optdep-s"       (hasArgDF addDepSuffix "Use -dep-suffix instead")
1126   , Flag "dep-makefile"   (hasArg setDepMakefile)
1127   , Flag "optdep-f"       (hasArgDF setDepMakefile "Use -dep-makefile instead")
1128   , Flag "optdep-w"       (NoArg  (deprecate "doesn't do anything"))
1129   , Flag "include-pkg-deps"         (noArg (setDepIncludePkgDeps True))
1130   , Flag "optdep--include-prelude"  (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
1131   , Flag "optdep--include-pkg-deps" (noArgDF (setDepIncludePkgDeps True) "Use -include-pkg-deps instead")
1132   , Flag "exclude-module"           (hasArg addDepExcludeMod)
1133   , Flag "optdep--exclude-module"   (hasArgDF addDepExcludeMod "Use -exclude-module instead")
1134   , Flag "optdep-x"                 (hasArgDF addDepExcludeMod "Use -exclude-module instead")
1135
1136         -------- Linking ----------------------------------------------------
1137   , Flag "no-link"            (noArg (\d -> d{ ghcLink=NoLink }))
1138   , Flag "shared"             (noArg (\d -> d{ ghcLink=LinkDynLib }))
1139   , Flag "dynload"            (hasArg parseDynLibLoaderMode)
1140   , Flag "dylib-install-name" (hasArg setDylibInstallName)
1141
1142         ------- Libraries ---------------------------------------------------
1143   , Flag "L"   (Prefix    addLibraryPath)
1144   , Flag "l"   (AnySuffix (upd . addOptl))
1145
1146         ------- Frameworks --------------------------------------------------
1147         -- -framework-path should really be -F ...
1148   , Flag "framework-path" (HasArg addFrameworkPath)
1149   , Flag "framework"      (hasArg addCmdlineFramework)
1150
1151         ------- Output Redirection ------------------------------------------
1152   , Flag "odir"              (hasArg setObjectDir)
1153   , Flag "o"                 (SepArg (upd . setOutputFile . Just))
1154   , Flag "ohi"               (hasArg (setOutputHi . Just ))
1155   , Flag "osuf"              (hasArg setObjectSuf)
1156   , Flag "hcsuf"             (hasArg setHcSuf)
1157   , Flag "hisuf"             (hasArg setHiSuf)
1158   , Flag "hidir"             (hasArg setHiDir)
1159   , Flag "tmpdir"            (hasArg setTmpDir)
1160   , Flag "stubdir"           (hasArg setStubDir)
1161   , Flag "outputdir"         (hasArg setOutputDir)
1162   , Flag "ddump-file-prefix" (hasArg (setDumpPrefixForce . Just))
1163
1164         ------- Keeping temporary files -------------------------------------
1165      -- These can be singular (think ghc -c) or plural (think ghc --make)
1166   , Flag "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles))
1167   , Flag "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles))
1168   , Flag "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles))
1169   , Flag "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles))
1170   , Flag "keep-raw-s-file"  (NoArg (setDynFlag Opt_KeepRawSFiles))
1171   , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles))
1172   , Flag "keep-llvm-file"   (NoArg (setDynFlag Opt_KeepLlvmFiles))
1173   , Flag "keep-llvm-files"  (NoArg (setDynFlag Opt_KeepLlvmFiles))
1174      -- This only makes sense as plural
1175   , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles))
1176
1177         ------- Miscellaneous ----------------------------------------------
1178   , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages))
1179   , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain))
1180   , Flag "with-rtsopts"   (HasArg setRtsOpts)
1181   , Flag "rtsopts"        (NoArg (setRtsOptsEnabled RtsOptsAll))
1182   , Flag "rtsopts=all"    (NoArg (setRtsOptsEnabled RtsOptsAll))
1183   , Flag "rtsopts=some"   (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
1184   , Flag "rtsopts=none"   (NoArg (setRtsOptsEnabled RtsOptsNone))
1185   , Flag "no-rtsopts"     (NoArg (setRtsOptsEnabled RtsOptsNone))
1186   , Flag "main-is"        (SepArg setMainIs)
1187   , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock))
1188   , Flag "haddock-opts"   (hasArg addHaddockOpts)
1189   , Flag "hpcdir"         (SepArg setOptHpcDir)
1190
1191         ------- recompilation checker --------------------------------------
1192   , Flag "recomp"         (NoArg (do { unSetDynFlag Opt_ForceRecomp
1193                                      ; deprecate "Use -fno-force-recomp instead" }))
1194   , Flag "no-recomp"      (NoArg (do { setDynFlag Opt_ForceRecomp
1195                                      ; deprecate "Use -fforce-recomp instead" }))
1196
1197         ------ HsCpp opts ---------------------------------------------------
1198   , Flag "D"              (AnySuffix (upd . addOptP))
1199   , Flag "U"              (AnySuffix (upd . addOptP))
1200
1201         ------- Include/Import Paths ----------------------------------------
1202   , Flag "I"              (Prefix    addIncludePath)
1203   , Flag "i"              (OptPrefix addImportPath)
1204
1205         ------ Debugging ----------------------------------------------------
1206   , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats))
1207
1208   , Flag "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
1209   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
1210   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
1211   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
1212   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
1213   , Flag "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
1214   , Flag "ddump-asm-native"        (setDumpFlag Opt_D_dump_asm_native)
1215   , Flag "ddump-asm-liveness"      (setDumpFlag Opt_D_dump_asm_liveness)
1216   , Flag "ddump-asm-coalesce"      (setDumpFlag Opt_D_dump_asm_coalesce)
1217   , Flag "ddump-asm-regalloc"      (setDumpFlag Opt_D_dump_asm_regalloc)
1218   , Flag "ddump-asm-conflicts"     (setDumpFlag Opt_D_dump_asm_conflicts)
1219   , Flag "ddump-asm-regalloc-stages" (setDumpFlag Opt_D_dump_asm_regalloc_stages)
1220   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
1221   , Flag "ddump-asm-expanded"      (setDumpFlag Opt_D_dump_asm_expanded)
1222   , Flag "ddump-llvm"              (NoArg (do { setObjTarget HscLlvm
1223                                               ; setDumpFlag' Opt_D_dump_llvm}))
1224   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
1225   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
1226   , Flag "ddump-ds"                (setDumpFlag Opt_D_dump_ds)
1227   , Flag "ddump-flatC"             (setDumpFlag Opt_D_dump_flatC)
1228   , Flag "ddump-foreign"           (setDumpFlag Opt_D_dump_foreign)
1229   , Flag "ddump-inlinings"         (setDumpFlag Opt_D_dump_inlinings)
1230   , Flag "ddump-rule-firings"      (setDumpFlag Opt_D_dump_rule_firings)
1231   , Flag "ddump-occur-anal"        (setDumpFlag Opt_D_dump_occur_anal)
1232   , Flag "ddump-parsed"            (setDumpFlag Opt_D_dump_parsed)
1233   , Flag "ddump-rn"                (setDumpFlag Opt_D_dump_rn)
1234   , Flag "ddump-simpl"             (setDumpFlag Opt_D_dump_simpl)
1235   , Flag "ddump-simpl-iterations"  (setDumpFlag Opt_D_dump_simpl_iterations)
1236   , Flag "ddump-simpl-phases"      (OptPrefix setDumpSimplPhases)
1237   , Flag "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
1238   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
1239   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
1240   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
1241   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
1242   , Flag "ddump-types"             (setDumpFlag Opt_D_dump_types)
1243   , Flag "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
1244   , Flag "ddump-cse"               (setDumpFlag Opt_D_dump_cse)
1245   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
1246   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
1247   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
1248   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
1249   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
1250   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
1251   , Flag "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
1252   , Flag "ddump-simpl-stats"       (setDumpFlag Opt_D_dump_simpl_stats)
1253   , Flag "ddump-bcos"              (setDumpFlag Opt_D_dump_BCOs)
1254   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
1255   , Flag "dverbose-core2core"      (NoArg (do { setVerbosity (Just 2)
1256                                               ; setVerboseCore2Core }))
1257   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
1258   , Flag "ddump-hi"                (setDumpFlag Opt_D_dump_hi)
1259   , Flag "ddump-minimal-imports"   (setDumpFlag Opt_D_dump_minimal_imports)
1260   , Flag "ddump-vect"              (setDumpFlag Opt_D_dump_vect)
1261   , Flag "ddump-hpc"               (setDumpFlag Opt_D_dump_hpc)
1262   , Flag "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
1263   , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
1264   , Flag "ddump-to-file"           (setDumpFlag Opt_DumpToFile)
1265   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
1266   , Flag "ddump-rtti"              (setDumpFlag Opt_D_dump_rtti)
1267   , Flag "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
1268   , Flag "dstg-lint"               (NoArg (setDynFlag Opt_DoStgLinting))
1269   , Flag "dcmm-lint"               (NoArg (setDynFlag Opt_DoCmmLinting))
1270   , Flag "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
1271   , Flag "dshow-passes"            (NoArg (do forceRecompile
1272                                               setVerbosity (Just 2)))
1273   , Flag "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
1274
1275         ------ Machine dependant (-m<blah>) stuff ---------------------------
1276
1277   , Flag "monly-2-regs" (noArg (\s -> s{stolen_x86_regs = 2}))
1278   , Flag "monly-3-regs" (noArg (\s -> s{stolen_x86_regs = 3}))
1279   , Flag "monly-4-regs" (noArg (\s -> s{stolen_x86_regs = 4}))
1280   , Flag "msse2"        (NoArg (setDynFlag Opt_SSE2))
1281
1282      ------ Warning opts -------------------------------------------------
1283   , Flag "W"      (NoArg (mapM_ setDynFlag   minusWOpts))
1284   , Flag "Werror" (NoArg (setDynFlag         Opt_WarnIsError))
1285   , Flag "Wwarn"  (NoArg (unSetDynFlag       Opt_WarnIsError))
1286   , Flag "Wall"   (NoArg (mapM_ setDynFlag   minusWallOpts))
1287   , Flag "Wnot"   (NoArg (do { mapM_ unSetDynFlag minusWallOpts
1288                              ; deprecate "Use -w instead" }))
1289   , Flag "w"      (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
1290
1291         ------ Optimisation flags ------------------------------------------
1292   , Flag "O"      (noArg (setOptLevel 1))
1293   , Flag "Onot"   (noArgDF (setOptLevel 0) "Use -O0 instead")
1294   , Flag "Odph"   (noArg setDPHOpt)
1295   , Flag "O"      (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
1296                 -- If the number is missing, use 1
1297
1298   , Flag "fsimplifier-phases"          (intSuffix (\n d -> d{ simplPhases = n }))
1299   , Flag "fmax-simplifier-iterations"  (intSuffix (\n d -> d{ maxSimplIterations = n }))
1300   , Flag "fspec-constr-threshold"      (intSuffix (\n d -> d{ specConstrThreshold = Just n }))
1301   , Flag "fno-spec-constr-threshold"   (noArg (\d -> d{ specConstrThreshold = Nothing }))
1302   , Flag "fspec-constr-count"          (intSuffix (\n d -> d{ specConstrCount = Just n }))
1303   , Flag "fno-spec-constr-count"       (noArg (\d -> d{ specConstrCount = Nothing }))
1304   , Flag "fliberate-case-threshold"    (intSuffix (\n d -> d{ liberateCaseThreshold = Just n }))
1305   , Flag "fno-liberate-case-threshold" (noArg (\d -> d{ liberateCaseThreshold = Nothing }))
1306   , Flag "frule-check"                 (SepArg (\s -> upd (\d -> d{ ruleCheck = Just s })))
1307   , Flag "fcontext-stack"              (intSuffix (\n d -> d{ ctxtStkDepth = n }))
1308   , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
1309   , Flag "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
1310   , Flag "ffloat-all-lams"             (intSuffix (\n d -> d{ floatLamArgs = Nothing }))
1311
1312         ------ Profiling ----------------------------------------------------
1313
1314   -- XXX Should the -f* flags be deprecated?
1315   -- They don't seem to be documented
1316   , Flag "fauto-sccs-on-all-toplevs"       (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
1317   , Flag "auto-all"                        (NoArg (setDynFlag Opt_AutoSccsOnAllToplevs))
1318   , Flag "no-auto-all"                     (NoArg (unSetDynFlag Opt_AutoSccsOnAllToplevs))
1319   , Flag "fauto-sccs-on-exported-toplevs"  (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
1320   , Flag "auto"                            (NoArg (setDynFlag Opt_AutoSccsOnExportedToplevs))
1321   , Flag "no-auto"                         (NoArg (unSetDynFlag Opt_AutoSccsOnExportedToplevs))
1322   , Flag "fauto-sccs-on-individual-cafs"   (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
1323   , Flag "caf-all"                         (NoArg (setDynFlag Opt_AutoSccsOnIndividualCafs))
1324   , Flag "no-caf-all"                      (NoArg (unSetDynFlag Opt_AutoSccsOnIndividualCafs))
1325
1326         ------ DPH flags ----------------------------------------------------
1327
1328   , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
1329   , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
1330   , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))
1331
1332         ------ Compiler flags -----------------------------------------------
1333
1334   , Flag "fasm"             (NoArg (setObjTarget HscAsm))
1335   , Flag "fvia-c"           (NoArg (setObjTarget HscC >>
1336          (addWarn "The -fvia-c flag will be removed in a future GHC release")))
1337   , Flag "fvia-C"           (NoArg (setObjTarget HscC >>
1338          (addWarn "The -fvia-C flag will be removed in a future GHC release")))
1339   , Flag "fllvm"            (NoArg (setObjTarget HscLlvm))
1340
1341   , Flag "fno-code"         (NoArg (do upd $ \d -> d{ ghcLink=NoLink }
1342                                        setTarget HscNothing))
1343   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted))
1344   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget))
1345   , Flag "fglasgow-exts"    (NoArg (enableGlasgowExts >> deprecate "Use individual extensions instead"))
1346   , Flag "fno-glasgow-exts" (NoArg (disableGlasgowExts >> deprecate "Use individual extensions instead"))
1347  ]
1348  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
1349  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
1350  ++ map (mkFlag True  "f"    setExtensionFlag  ) fLangFlags
1351  ++ map (mkFlag False "fno-" unSetExtensionFlag) fLangFlags
1352  ++ map (mkFlag True  "X"    setExtensionFlag  ) xFlags
1353  ++ map (mkFlag False "XNo"  unSetExtensionFlag) xFlags
1354  ++ map (mkFlag True  "X"    setLanguage) languageFlags
1355
1356 package_flags :: [Flag (CmdLineP DynFlags)]
1357 package_flags = [
1358         ------- Packages ----------------------------------------------------
1359     Flag "package-conf"         (HasArg extraPkgConf_)
1360   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
1361   , Flag "package-name"         (hasArg setPackageName)
1362   , Flag "package-id"           (HasArg exposePackageId)
1363   , Flag "package"              (HasArg exposePackage)
1364   , Flag "hide-package"         (HasArg hidePackage)
1365   , Flag "hide-all-packages"    (NoArg (setDynFlag Opt_HideAllPackages))
1366   , Flag "ignore-package"       (HasArg ignorePackage)
1367   , Flag "syslib"               (HasArg (\s -> do { exposePackage s
1368                                                   ; deprecate "Use -package instead" }))
1369   ]
1370
1371 type FlagSpec flag
1372    = ( String   -- Flag in string form
1373      , flag     -- Flag in internal form
1374      , Bool -> DynP ())  -- Extra action to run when the flag is found
1375                          -- Typically, emit a warning or error
1376                          -- True  <=> we are turning the flag on
1377                          -- False <=> we are turning the flag off
1378
1379
1380 mkFlag :: Bool                  -- ^ True <=> it should be turned on
1381        -> String                -- ^ The flag prefix
1382        -> (flag -> DynP ())     -- ^ What to do when the flag is found
1383        -> FlagSpec flag         -- ^ Specification of this particular flag
1384        -> Flag (CmdLineP DynFlags)
1385 mkFlag turnOn flagPrefix f (name, flag, extra_action)
1386     = Flag (flagPrefix ++ name) (NoArg (f flag >> extra_action turnOn))
1387
1388 deprecatedForExtension :: String -> Bool -> DynP ()
1389 deprecatedForExtension lang turn_on
1390     = deprecate ("use -X"  ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead")
1391     where
1392       flag | turn_on    = lang
1393            | otherwise = "No"++lang
1394
1395 useInstead :: String -> Bool -> DynP ()
1396 useInstead flag turn_on
1397   = deprecate ("Use -f" ++ no ++ flag ++ " instead")
1398   where
1399     no = if turn_on then "" else "no-"
1400
1401 nop :: Bool -> DynP ()
1402 nop _ = return ()
1403
1404 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
1405 fFlags :: [FlagSpec DynFlag]
1406 fFlags = [
1407   ( "warn-dodgy-foreign-imports",       Opt_WarnDodgyForeignImports, nop ),
1408   ( "warn-dodgy-exports",               Opt_WarnDodgyExports, nop ),
1409   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, nop ),
1410   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, nop ),
1411   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
1412   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
1413   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),
1414   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
1415   ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
1416   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
1417   ( "warn-missing-methods",             Opt_WarnMissingMethods, nop ),
1418   ( "warn-missing-signatures",          Opt_WarnMissingSigs, nop ),
1419   ( "warn-missing-local-sigs",          Opt_WarnMissingLocalSigs, nop ),
1420   ( "warn-name-shadowing",              Opt_WarnNameShadowing, nop ),
1421   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, nop ),
1422   ( "warn-type-defaults",               Opt_WarnTypeDefaults, nop ),
1423   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, nop ),
1424   ( "warn-unused-binds",                Opt_WarnUnusedBinds, nop ),
1425   ( "warn-unused-imports",              Opt_WarnUnusedImports, nop ),
1426   ( "warn-unused-matches",              Opt_WarnUnusedMatches, nop ),
1427   ( "warn-warnings-deprecations",       Opt_WarnWarningsDeprecations, nop ),
1428   ( "warn-deprecations",                Opt_WarnWarningsDeprecations, nop ),
1429   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, nop ),
1430   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
1431   ( "warn-identities",                  Opt_WarnIdentities, nop ),
1432   ( "warn-auto-orphans",                Opt_WarnAutoOrphans, nop ),
1433   ( "warn-tabs",                        Opt_WarnTabs, nop ),
1434   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
1435   ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings, nop),
1436   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
1437   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
1438   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
1439   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, nop ),
1440   ( "strictness",                       Opt_Strictness, nop ),
1441   ( "specialise",                       Opt_Specialise, nop ),
1442   ( "float-in",                         Opt_FloatIn, nop ),
1443   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, nop ),
1444   ( "full-laziness",                    Opt_FullLaziness, nop ),
1445   ( "liberate-case",                    Opt_LiberateCase, nop ),
1446   ( "spec-constr",                      Opt_SpecConstr, nop ),
1447   ( "cse",                              Opt_CSE, nop ),
1448   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, nop ),
1449   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, nop ),
1450   ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, nop ),
1451   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, nop ),
1452   ( "ignore-asserts",                   Opt_IgnoreAsserts, nop ),
1453   ( "do-eta-reduction",                 Opt_DoEtaReduction, nop ),
1454   ( "case-merge",                       Opt_CaseMerge, nop ),
1455   ( "unbox-strict-fields",              Opt_UnboxStrictFields, nop ),
1456   ( "method-sharing",                   Opt_MethodSharing,
1457      \_ -> deprecate "doesn't do anything any more"),
1458      -- Remove altogether in GHC 7.2
1459   ( "dicts-cheap",                      Opt_DictsCheap, nop ),
1460   ( "excess-precision",                 Opt_ExcessPrecision, nop ),
1461   ( "eager-blackholing",                Opt_EagerBlackHoling, nop ),
1462   ( "asm-mangling",                     Opt_DoAsmMangling, nop ),
1463   ( "print-bind-result",                Opt_PrintBindResult, nop ),
1464   ( "force-recomp",                     Opt_ForceRecomp, nop ),
1465   ( "hpc-no-auto",                      Opt_Hpc_No_Auto, nop ),
1466   ( "rewrite-rules",                    Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
1467   ( "enable-rewrite-rules",             Opt_EnableRewriteRules, nop ),
1468   ( "break-on-exception",               Opt_BreakOnException, nop ),
1469   ( "break-on-error",                   Opt_BreakOnError, nop ),
1470   ( "print-evld-with-show",             Opt_PrintEvldWithShow, nop ),
1471   ( "print-bind-contents",              Opt_PrintBindContents, nop ),
1472   ( "run-cps",                          Opt_RunCPS, nop ),
1473   ( "run-cpsz",                         Opt_RunCPSZ, nop ),
1474   ( "new-codegen",                      Opt_TryNewCodeGen, nop ),
1475   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, nop ),
1476   ( "vectorise",                        Opt_Vectorise, nop ),
1477   ( "regs-graph",                       Opt_RegsGraph, nop ),
1478   ( "regs-iterative",                   Opt_RegsIterative, nop ),
1479   ( "gen-manifest",                     Opt_GenManifest, nop ),
1480   ( "embed-manifest",                   Opt_EmbedManifest, nop ),
1481   ( "ext-core",                         Opt_EmitExternalCore, nop ),
1482   ( "shared-implib",                    Opt_SharedImplib, nop ),
1483   ( "ghci-sandbox",                     Opt_GhciSandbox, nop ),
1484   ( "building-cabal-package",           Opt_BuildingCabalPackage, nop ),
1485   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, nop )
1486   ]
1487
1488 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
1489 fLangFlags :: [FlagSpec ExtensionFlag]
1490 fLangFlags = [
1491   ( "th",                               Opt_TemplateHaskell,
1492     deprecatedForExtension "TemplateHaskell" >> checkTemplateHaskellOk ),
1493   ( "fi",                               Opt_ForeignFunctionInterface,
1494     deprecatedForExtension "ForeignFunctionInterface" ),
1495   ( "ffi",                              Opt_ForeignFunctionInterface,
1496     deprecatedForExtension "ForeignFunctionInterface" ),
1497   ( "arrows",                           Opt_Arrows,
1498     deprecatedForExtension "Arrows" ),
1499   ( "generics",                         Opt_Generics,
1500     deprecatedForExtension "Generics" ),
1501   ( "implicit-prelude",                 Opt_ImplicitPrelude,
1502     deprecatedForExtension "ImplicitPrelude" ),
1503   ( "bang-patterns",                    Opt_BangPatterns,
1504     deprecatedForExtension "BangPatterns" ),
1505   ( "monomorphism-restriction",         Opt_MonomorphismRestriction,
1506     deprecatedForExtension "MonomorphismRestriction" ),
1507   ( "mono-pat-binds",                   Opt_MonoPatBinds,
1508     deprecatedForExtension "MonoPatBinds" ),
1509   ( "extended-default-rules",           Opt_ExtendedDefaultRules,
1510     deprecatedForExtension "ExtendedDefaultRules" ),
1511   ( "implicit-params",                  Opt_ImplicitParams,
1512     deprecatedForExtension "ImplicitParams" ),
1513   ( "scoped-type-variables",            Opt_ScopedTypeVariables,
1514     deprecatedForExtension "ScopedTypeVariables" ),
1515   ( "parr",                             Opt_PArr,
1516     deprecatedForExtension "PArr" ),
1517   ( "allow-overlapping-instances",      Opt_OverlappingInstances,
1518     deprecatedForExtension "OverlappingInstances" ),
1519   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
1520     deprecatedForExtension "UndecidableInstances" ),
1521   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
1522     deprecatedForExtension "IncoherentInstances" )
1523   ]
1524
1525 supportedLanguages :: [String]
1526 supportedLanguages = [ name | (name, _, _) <- languageFlags ]
1527
1528 supportedExtensions :: [String]
1529 supportedExtensions = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ]
1530
1531 supportedLanguagesAndExtensions :: [String]
1532 supportedLanguagesAndExtensions = supportedLanguages ++ supportedExtensions
1533
1534 -- | These -X<blah> flags cannot be reversed with -XNo<blah>
1535 languageFlags :: [FlagSpec Language]
1536 languageFlags = [
1537   ( "Haskell98",                        Haskell98, nop ),
1538   ( "Haskell2010",                      Haskell2010, nop )
1539   ]
1540
1541 -- | These -X<blah> flags can all be reversed with -XNo<blah>
1542 xFlags :: [FlagSpec ExtensionFlag]
1543 xFlags = [
1544   ( "CPP",                              Opt_Cpp, nop ),
1545   ( "PostfixOperators",                 Opt_PostfixOperators, nop ),
1546   ( "TupleSections",                    Opt_TupleSections, nop ),
1547   ( "PatternGuards",                    Opt_PatternGuards, nop ),
1548   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, nop ),
1549   ( "MagicHash",                        Opt_MagicHash, nop ),
1550   ( "PolymorphicComponents",            Opt_PolymorphicComponents, nop ),
1551   ( "ExistentialQuantification",        Opt_ExistentialQuantification, nop ),
1552   ( "KindSignatures",                   Opt_KindSignatures, nop ),
1553   ( "EmptyDataDecls",                   Opt_EmptyDataDecls, nop ),
1554   ( "ParallelListComp",                 Opt_ParallelListComp, nop ),
1555   ( "TransformListComp",                Opt_TransformListComp, nop ),
1556   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, nop ),
1557   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, nop ),
1558   ( "GHCForeignImportPrim",             Opt_GHCForeignImportPrim, nop ),
1559   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, nop ),
1560   ( "Rank2Types",                       Opt_Rank2Types, nop ),
1561   ( "RankNTypes",                       Opt_RankNTypes, nop ),
1562   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, nop),
1563   ( "TypeOperators",                    Opt_TypeOperators, nop ),
1564   ( "RecursiveDo",                      Opt_RecursiveDo,
1565     deprecatedForExtension "DoRec"),
1566   ( "DoRec",                            Opt_DoRec, nop ),
1567   ( "Arrows",                           Opt_Arrows, nop ),
1568   ( "PArr",                             Opt_PArr, nop ),
1569   ( "TemplateHaskell",                  Opt_TemplateHaskell, checkTemplateHaskellOk ),
1570   ( "QuasiQuotes",                      Opt_QuasiQuotes, nop ),
1571   ( "Generics",                         Opt_Generics, nop ),
1572   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, nop ),
1573   ( "RecordWildCards",                  Opt_RecordWildCards, nop ),
1574   ( "NamedFieldPuns",                   Opt_RecordPuns, nop ),
1575   ( "RecordPuns",                       Opt_RecordPuns,
1576     deprecatedForExtension "NamedFieldPuns" ),
1577   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, nop ),
1578   ( "OverloadedStrings",                Opt_OverloadedStrings, nop ),
1579   ( "GADTs",                            Opt_GADTs, nop ),
1580   ( "ViewPatterns",                     Opt_ViewPatterns, nop ),
1581   ( "TypeFamilies",                     Opt_TypeFamilies, nop ),
1582   ( "BangPatterns",                     Opt_BangPatterns, nop ),
1583   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, nop ),
1584   ( "NPlusKPatterns",                   Opt_NPlusKPatterns, nop ),
1585   ( "DoAndIfThenElse",                  Opt_DoAndIfThenElse, nop ),
1586   ( "RebindableSyntax",                 Opt_RebindableSyntax, nop ),
1587   ( "MonoPatBinds",                     Opt_MonoPatBinds, nop ),
1588   ( "ExplicitForAll",                   Opt_ExplicitForAll, nop ),
1589   ( "AlternativeLayoutRule",            Opt_AlternativeLayoutRule, nop ),
1590   ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ),
1591   ( "DatatypeContexts",                 Opt_DatatypeContexts, nop ),
1592   ( "MonoLocalBinds",                   Opt_MonoLocalBinds, nop ),
1593   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec,
1594     \ turn_on -> if not turn_on
1595                  then deprecate "You can't turn off RelaxedPolyRec any more"
1596                  else return () ),
1597   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, nop ),
1598   ( "ImplicitParams",                   Opt_ImplicitParams, nop ),
1599   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, nop ),
1600
1601   ( "PatternSignatures",                Opt_ScopedTypeVariables,
1602     deprecatedForExtension "ScopedTypeVariables" ),
1603
1604   ( "UnboxedTuples",                    Opt_UnboxedTuples, nop ),
1605   ( "StandaloneDeriving",               Opt_StandaloneDeriving, nop ),
1606   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, nop ),
1607   ( "DeriveFunctor",                    Opt_DeriveFunctor, nop ),
1608   ( "DeriveTraversable",                Opt_DeriveTraversable, nop ),
1609   ( "DeriveFoldable",                   Opt_DeriveFoldable, nop ),
1610   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, nop ),
1611   ( "FlexibleContexts",                 Opt_FlexibleContexts, nop ),
1612   ( "FlexibleInstances",                Opt_FlexibleInstances, nop ),
1613   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, nop ),
1614   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, nop ),
1615   ( "FunctionalDependencies",           Opt_FunctionalDependencies, nop ),
1616   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, nop ),
1617   ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
1618   ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
1619   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
1620   ( "PackageImports",                   Opt_PackageImports, nop ),
1621   ( "NewQualifiedOperators",            Opt_NewQualifiedOperators,
1622     \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
1623   ]
1624
1625 defaultFlags :: [DynFlag]
1626 defaultFlags
1627   = [ Opt_AutoLinkPackages,
1628       Opt_ReadUserPackageConf,
1629
1630       Opt_DoAsmMangling,
1631
1632       Opt_SharedImplib,
1633
1634       Opt_GenManifest,
1635       Opt_EmbedManifest,
1636       Opt_PrintBindContents,
1637       Opt_GhciSandbox
1638     ]
1639
1640     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
1641              -- The default -O0 options
1642
1643     ++ standardWarnings
1644
1645 impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
1646 impliedFlags
1647   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
1648     , (Opt_Rank2Types,                Opt_ExplicitForAll)
1649     , (Opt_ScopedTypeVariables,       Opt_ExplicitForAll)
1650     , (Opt_LiberalTypeSynonyms,       Opt_ExplicitForAll)
1651     , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
1652     , (Opt_PolymorphicComponents,     Opt_ExplicitForAll)
1653
1654     , (Opt_RebindableSyntax,          Opt_ImplicitPrelude)
1655
1656     , (Opt_GADTs,                  Opt_MonoLocalBinds)
1657     , (Opt_TypeFamilies,           Opt_MonoLocalBinds)
1658
1659     , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
1660                                                      -- all over the place
1661
1662     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
1663
1664         -- Record wild-cards implies field disambiguation
1665         -- Otherwise if you write (C {..}) you may well get
1666         -- stuff like " 'a' not in scope ", which is a bit silly
1667         -- if the compiler has just filled in field 'a' of constructor 'C'
1668     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
1669   ]
1670
1671 optLevelFlags :: [([Int], DynFlag)]
1672 optLevelFlags
1673   = [ ([0],     Opt_IgnoreInterfacePragmas)
1674     , ([0],     Opt_OmitInterfacePragmas)
1675
1676     , ([1,2],   Opt_IgnoreAsserts)
1677     , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
1678                                          --              in PrelRules
1679     , ([1,2],   Opt_DoEtaReduction)
1680     , ([1,2],   Opt_CaseMerge)
1681     , ([1,2],   Opt_Strictness)
1682     , ([1,2],   Opt_CSE)
1683     , ([1,2],   Opt_FullLaziness)
1684     , ([1,2],   Opt_Specialise)
1685     , ([1,2],   Opt_FloatIn)
1686
1687     , ([2],     Opt_LiberateCase)
1688     , ([2],     Opt_SpecConstr)
1689     , ([2],     Opt_RegsGraph)
1690
1691 --     , ([2],     Opt_StaticArgumentTransformation)
1692 -- Max writes: I think it's probably best not to enable SAT with -O2 for the
1693 -- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
1694 -- several improvements to the heuristics, and I'm concerned that without
1695 -- those changes SAT will interfere with some attempts to write "high
1696 -- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
1697 -- this year. In particular, the version in HEAD lacks the tail call
1698 -- criterion, so many things that look like reasonable loops will be
1699 -- turned into functions with extra (unneccesary) thunk creation.
1700
1701     , ([0,1,2], Opt_DoLambdaEtaExpansion)
1702                 -- This one is important for a tiresome reason:
1703                 -- we want to make sure that the bindings for data
1704                 -- constructors are eta-expanded.  This is probably
1705                 -- a good thing anyway, but it seems fragile.
1706     ]
1707
1708 -- -----------------------------------------------------------------------------
1709 -- Standard sets of warning options
1710
1711 standardWarnings :: [DynFlag]
1712 standardWarnings
1713     = [ Opt_WarnWarningsDeprecations,
1714         Opt_WarnDeprecatedFlags,
1715         Opt_WarnUnrecognisedPragmas,
1716         Opt_WarnOverlappingPatterns,
1717         Opt_WarnMissingFields,
1718         Opt_WarnMissingMethods,
1719         Opt_WarnDuplicateExports,
1720         Opt_WarnLazyUnliftedBindings,
1721         Opt_WarnDodgyForeignImports,
1722         Opt_WarnWrongDoBind,
1723         Opt_WarnAlternativeLayoutRuleTransitional
1724       ]
1725
1726 minusWOpts :: [DynFlag]
1727 minusWOpts
1728     = standardWarnings ++
1729       [ Opt_WarnUnusedBinds,
1730         Opt_WarnUnusedMatches,
1731         Opt_WarnUnusedImports,
1732         Opt_WarnIncompletePatterns,
1733         Opt_WarnDodgyExports,
1734         Opt_WarnDodgyImports
1735       ]
1736
1737 minusWallOpts :: [DynFlag]
1738 minusWallOpts
1739     = minusWOpts ++
1740       [ Opt_WarnTypeDefaults,
1741         Opt_WarnNameShadowing,
1742         Opt_WarnMissingSigs,
1743         Opt_WarnHiShadows,
1744         Opt_WarnOrphans,
1745         Opt_WarnUnusedDoBind,
1746         Opt_WarnIdentities
1747       ]
1748
1749 -- minuswRemovesOpts should be every warning option
1750 minuswRemovesOpts :: [DynFlag]
1751 minuswRemovesOpts
1752     = minusWallOpts ++
1753       [Opt_WarnImplicitPrelude,
1754        Opt_WarnIncompletePatternsRecUpd,
1755        Opt_WarnMonomorphism,
1756        Opt_WarnUnrecognisedPragmas,
1757        Opt_WarnAutoOrphans,
1758        Opt_WarnTabs
1759       ]
1760
1761 enableGlasgowExts :: DynP ()
1762 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
1763                        mapM_ setExtensionFlag glasgowExtsFlags
1764
1765 disableGlasgowExts :: DynP ()
1766 disableGlasgowExts = do unSetDynFlag Opt_PrintExplicitForalls
1767                         mapM_ unSetExtensionFlag glasgowExtsFlags
1768
1769 glasgowExtsFlags :: [ExtensionFlag]
1770 glasgowExtsFlags = [
1771              Opt_ForeignFunctionInterface
1772            , Opt_UnliftedFFITypes
1773            , Opt_ImplicitParams
1774            , Opt_ScopedTypeVariables
1775            , Opt_UnboxedTuples
1776            , Opt_TypeSynonymInstances
1777            , Opt_StandaloneDeriving
1778            , Opt_DeriveDataTypeable
1779            , Opt_DeriveFunctor
1780            , Opt_DeriveFoldable
1781            , Opt_DeriveTraversable
1782            , Opt_FlexibleContexts
1783            , Opt_FlexibleInstances
1784            , Opt_ConstrainedClassMethods
1785            , Opt_MultiParamTypeClasses
1786            , Opt_FunctionalDependencies
1787            , Opt_MagicHash
1788            , Opt_PolymorphicComponents
1789            , Opt_ExistentialQuantification
1790            , Opt_UnicodeSyntax
1791            , Opt_PostfixOperators
1792            , Opt_PatternGuards
1793            , Opt_LiberalTypeSynonyms
1794            , Opt_RankNTypes
1795            , Opt_TypeOperators
1796            , Opt_DoRec
1797            , Opt_ParallelListComp
1798            , Opt_EmptyDataDecls
1799            , Opt_KindSignatures
1800            , Opt_GeneralizedNewtypeDeriving ]
1801
1802 #ifdef GHCI
1803 -- Consult the RTS to find whether GHC itself has been built profiled
1804 -- If so, you can't use Template Haskell
1805 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
1806
1807 rtsIsProfiled :: Bool
1808 rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0
1809
1810 checkTemplateHaskellOk :: Bool -> DynP ()
1811 checkTemplateHaskellOk turn_on
1812   | turn_on && rtsIsProfiled
1813   = addErr "You can't use Template Haskell with a profiled compiler"
1814   | otherwise
1815   = return ()
1816 #else
1817 -- In stage 1 we don't know that the RTS has rts_isProfiled,
1818 -- so we simply say "ok".  It doesn't matter because TH isn't
1819 -- available in stage 1 anyway.
1820 checkTemplateHaskellOk turn_on = return ()
1821 #endif
1822
1823 {- **********************************************************************
1824 %*                                                                      *
1825                 DynFlags constructors
1826 %*                                                                      *
1827 %********************************************************************* -}
1828
1829 type DynP = EwM (CmdLineP DynFlags)
1830
1831 upd :: (DynFlags -> DynFlags) -> DynP ()
1832 upd f = liftEwM (do { dfs <- getCmdLineState
1833                     ; putCmdLineState $! (f dfs) })
1834
1835 --------------- Constructor functions for OptKind -----------------
1836 noArg :: (DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
1837 noArg fn = NoArg (upd fn)
1838
1839 noArgDF :: (DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
1840 noArgDF fn deprec = NoArg (upd fn >> deprecate deprec)
1841
1842 hasArg :: (String -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
1843 hasArg fn = HasArg (upd . fn)
1844
1845 hasArgDF :: (String -> DynFlags -> DynFlags) -> String -> OptKind (CmdLineP DynFlags)
1846 hasArgDF fn deprec = HasArg (\s -> do { upd (fn s)
1847                                       ; deprecate deprec })
1848
1849 intSuffix :: (Int -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags)
1850 intSuffix fn = IntSuffix (\n -> upd (fn n))
1851
1852 setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
1853 setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
1854
1855 --------------------------
1856 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
1857 setDynFlag   f = upd (\dfs -> dopt_set dfs f)
1858 unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
1859
1860 --------------------------
1861 setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP ()
1862 setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f)
1863                         ; mapM_ setExtensionFlag deps }
1864   where
1865     deps = [ d | (f', d) <- impliedFlags, f' == f ]
1866         -- When you set f, set the ones it implies
1867         -- NB: use setExtensionFlag recursively, in case the implied flags
1868         --     implies further flags
1869         -- When you un-set f, however, we don't un-set the things it implies
1870         --      (except for -fno-glasgow-exts, which is treated specially)
1871
1872 unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f)
1873
1874 --------------------------
1875 setDumpFlag' :: DynFlag -> DynP ()
1876 setDumpFlag' dump_flag
1877   = do { setDynFlag dump_flag
1878        ; when want_recomp forceRecompile }
1879   where
1880         -- Certain dumpy-things are really interested in what's going
1881         -- on during recompilation checking, so in those cases we
1882         -- don't want to turn it off.
1883     want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
1884                                        Opt_D_dump_hi_diffs]
1885
1886 forceRecompile :: DynP ()
1887 -- Whenver we -ddump, force recompilation (by switching off the
1888 -- recompilation checker), else you don't see the dump! However,
1889 -- don't switch it off in --make mode, else *everything* gets
1890 -- recompiled which probably isn't what you want
1891 forceRecompile = do { dfs <- liftEwM getCmdLineState
1892                     ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
1893         where
1894           force_recomp dfs = isOneShot (ghcMode dfs)
1895
1896 setVerboseCore2Core :: DynP ()
1897 setVerboseCore2Core = do forceRecompile
1898                          setDynFlag Opt_D_verbose_core2core
1899                          upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing })
1900
1901
1902 setDumpSimplPhases :: String -> DynP ()
1903 setDumpSimplPhases s = do forceRecompile
1904                           upd (\dfs -> dfs { shouldDumpSimplPhase = Just spec })
1905   where
1906     spec = case s of { ('=' : s') -> s';  _ -> s }
1907
1908 setVerbosity :: Maybe Int -> DynP ()
1909 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
1910
1911 addCmdlineHCInclude :: String -> DynP ()
1912 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
1913
1914 extraPkgConf_ :: FilePath -> DynP ()
1915 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
1916
1917 exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP ()
1918 exposePackage p =
1919   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
1920 exposePackageId p =
1921   upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s })
1922 hidePackage p =
1923   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
1924 ignorePackage p =
1925   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
1926
1927 setPackageName :: String -> DynFlags -> DynFlags
1928 setPackageName p s =  s{ thisPackage = stringToPackageId p }
1929
1930 -- If we're linking a binary, then only targets that produce object
1931 -- code are allowed (requests for other target types are ignored).
1932 setTarget :: HscTarget -> DynP ()
1933 setTarget l = upd set
1934   where
1935    set dfs
1936      | ghcLink dfs /= LinkBinary || isObjectTarget l  = dfs{ hscTarget = l }
1937      | otherwise = dfs
1938
1939 -- Changes the target only if we're compiling object code.  This is
1940 -- used by -fasm and -fvia-C, which switch from one to the other, but
1941 -- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
1942 -- can be safely used in an OPTIONS_GHC pragma.
1943 setObjTarget :: HscTarget -> DynP ()
1944 setObjTarget l = upd set
1945   where
1946    set dfs
1947      | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
1948      | otherwise = dfs
1949
1950 setOptLevel :: Int -> DynFlags -> DynFlags
1951 setOptLevel n dflags
1952    | hscTarget dflags == HscInterpreted && n > 0
1953         = dflags
1954             -- not in IO any more, oh well:
1955             -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
1956    | otherwise
1957         = updOptLevel n dflags
1958
1959
1960 -- -Odph is equivalent to
1961 --
1962 --    -O2                               optimise as much as possible
1963 --    -fno-method-sharing               sharing specialisation defeats fusion
1964 --                                      sometimes
1965 --    -fdicts-cheap                     always inline dictionaries
1966 --    -fmax-simplifier-iterations20     this is necessary sometimes
1967 --    -fsimplifier-phases=3             we use an additional simplifier phase
1968 --                                      for fusion
1969 --    -fno-spec-constr-threshold        run SpecConstr even for big loops
1970 --    -fno-spec-constr-count            SpecConstr as much as possible
1971 --    -finline-enough-args              hack to prevent excessive inlining
1972 --
1973 setDPHOpt :: DynFlags -> DynFlags
1974 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
1975                                          , simplPhases         = 3
1976                                          , specConstrThreshold = Nothing
1977                                          , specConstrCount     = Nothing
1978                                          })
1979                    `dopt_set`   Opt_DictsCheap
1980
1981 data DPHBackend = DPHPar
1982                 | DPHSeq
1983                 | DPHThis
1984         deriving(Eq, Ord, Enum, Show)
1985
1986 setDPHBackend :: DPHBackend -> DynP ()
1987 setDPHBackend backend
1988   = do
1989       upd $ \dflags -> dflags { dphBackend = backend }
1990       mapM_ exposePackage (dph_packages backend)
1991   where
1992     dph_packages DPHThis = []
1993     dph_packages DPHPar  = ["dph-prim-par", "dph-par"]
1994     dph_packages DPHSeq  = ["dph-prim-seq", "dph-seq"]
1995
1996 dphPackage :: DynFlags -> PackageId
1997 dphPackage dflags = case dphBackend dflags of
1998                       DPHPar  -> dphParPackageId
1999                       DPHSeq  -> dphSeqPackageId
2000                       DPHThis -> thisPackage dflags
2001
2002 setMainIs :: String -> DynP ()
2003 setMainIs arg
2004   | not (null main_fn) && isLower (head main_fn)
2005      -- The arg looked like "Foo.Bar.baz"
2006   = upd $ \d -> d{ mainFunIs = Just main_fn,
2007                    mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
2008
2009   | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
2010   = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
2011
2012   | otherwise                   -- The arg looked like "baz"
2013   = upd $ \d -> d{ mainFunIs = Just arg }
2014   where
2015     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
2016
2017 -----------------------------------------------------------------------------
2018 -- Paths & Libraries
2019
2020 addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
2021
2022 -- -i on its own deletes the import paths
2023 addImportPath "" = upd (\s -> s{importPaths = []})
2024 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
2025
2026
2027 addLibraryPath p =
2028   upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
2029
2030 addIncludePath p =
2031   upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
2032
2033 addFrameworkPath p =
2034   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
2035
2036 #ifndef mingw32_TARGET_OS
2037 split_marker :: Char
2038 split_marker = ':'   -- not configurable (ToDo)
2039 #endif
2040
2041 splitPathList :: String -> [String]
2042 splitPathList s = filter notNull (splitUp s)
2043                 -- empty paths are ignored: there might be a trailing
2044                 -- ':' in the initial list, for example.  Empty paths can
2045                 -- cause confusion when they are translated into -I options
2046                 -- for passing to gcc.
2047   where
2048 #ifndef mingw32_TARGET_OS
2049     splitUp xs = split split_marker xs
2050 #else
2051      -- Windows: 'hybrid' support for DOS-style paths in directory lists.
2052      --
2053      -- That is, if "foo:bar:baz" is used, this interpreted as
2054      -- consisting of three entries, 'foo', 'bar', 'baz'.
2055      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
2056      -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
2057      --
2058      -- Notice that no attempt is made to fully replace the 'standard'
2059      -- split marker ':' with the Windows / DOS one, ';'. The reason being
2060      -- that this will cause too much breakage for users & ':' will
2061      -- work fine even with DOS paths, if you're not insisting on being silly.
2062      -- So, use either.
2063     splitUp []             = []
2064     splitUp (x:':':div:xs) | div `elem` dir_markers
2065                            = ((x:':':div:p): splitUp rs)
2066                            where
2067                               (p,rs) = findNextPath xs
2068           -- we used to check for existence of the path here, but that
2069           -- required the IO monad to be threaded through the command-line
2070           -- parser which is quite inconvenient.  The
2071     splitUp xs = cons p (splitUp rs)
2072                where
2073                  (p,rs) = findNextPath xs
2074
2075                  cons "" xs = xs
2076                  cons x  xs = x:xs
2077
2078     -- will be called either when we've consumed nought or the
2079     -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
2080     -- finding the next split marker.
2081     findNextPath xs =
2082         case break (`elem` split_markers) xs of
2083            (p, _:ds) -> (p, ds)
2084            (p, xs)   -> (p, xs)
2085
2086     split_markers :: [Char]
2087     split_markers = [':', ';']
2088
2089     dir_markers :: [Char]
2090     dir_markers = ['/', '\\']
2091 #endif
2092
2093 -- -----------------------------------------------------------------------------
2094 -- tmpDir, where we store temporary files.
2095
2096 setTmpDir :: FilePath -> DynFlags -> DynFlags
2097 setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
2098   -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
2099   -- seem necessary now --SDM 7/2/2008
2100
2101 -----------------------------------------------------------------------------
2102 -- RTS opts
2103
2104 setRtsOpts :: String -> DynP ()
2105 setRtsOpts arg  = upd $ \ d -> d {rtsOpts = Just arg}
2106
2107 setRtsOptsEnabled :: RtsOptsEnabled -> DynP ()
2108 setRtsOptsEnabled arg  = upd $ \ d -> d {rtsOptsEnabled = arg}
2109
2110 -----------------------------------------------------------------------------
2111 -- Hpc stuff
2112
2113 setOptHpcDir :: String -> DynP ()
2114 setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
2115
2116 -----------------------------------------------------------------------------
2117 -- Via-C compilation stuff
2118
2119 -- There are some options that we need to pass to gcc when compiling
2120 -- Haskell code via C, but are only supported by recent versions of
2121 -- gcc.  The configure script decides which of these options we need,
2122 -- and puts them in the file "extra-gcc-opts" in $topdir, which is
2123 -- read before each via-C compilation.  The advantage of having these
2124 -- in a separate file is that the file can be created at install-time
2125 -- depending on the available gcc version, and even re-generated  later
2126 -- if gcc is upgraded.
2127 --
2128 -- The options below are not dependent on the version of gcc, only the
2129 -- platform.
2130
2131 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
2132                               [String]) -- for registerised HC compilations
2133 machdepCCOpts dflags = let (flagsAll, flagsRegHc) = machdepCCOpts' dflags
2134                        in (cCcOpts ++ flagsAll, flagsRegHc)
2135
2136 machdepCCOpts' :: DynFlags -> ([String], -- flags for all C compilations
2137                                [String]) -- for registerised HC compilations
2138 machdepCCOpts' _dflags
2139 #if alpha_TARGET_ARCH
2140         =       ( ["-w", "-mieee"
2141 #ifdef HAVE_THREADED_RTS_SUPPORT
2142                     , "-D_REENTRANT"
2143 #endif
2144                    ], [] )
2145         -- For now, to suppress the gcc warning "call-clobbered
2146         -- register used for global register variable", we simply
2147         -- disable all warnings altogether using the -w flag. Oh well.
2148
2149 #elif hppa_TARGET_ARCH
2150         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
2151         -- (very nice, but too bad the HP /usr/include files don't agree.)
2152         = ( ["-D_HPUX_SOURCE"], [] )
2153
2154 #elif m68k_TARGET_ARCH
2155       -- -fno-defer-pop : for the .hc files, we want all the pushing/
2156       --    popping of args to routines to be explicit; if we let things
2157       --    be deferred 'til after an STGJUMP, imminent death is certain!
2158       --
2159       -- -fomit-frame-pointer : *don't*
2160       --     It's better to have a6 completely tied up being a frame pointer
2161       --     rather than let GCC pick random things to do with it.
2162       --     (If we want to steal a6, then we would try to do things
2163       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
2164         = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
2165
2166 #elif i386_TARGET_ARCH
2167       -- -fno-defer-pop : basically the same game as for m68k
2168       --
2169       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
2170       --   the fp (%ebp) for our register maps.
2171         =  let n_regs = stolen_x86_regs _dflags
2172            in
2173                     (
2174                       [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
2175                       ],
2176                       [ "-fno-defer-pop",
2177                         "-fomit-frame-pointer",
2178                         -- we want -fno-builtin, because when gcc inlines
2179                         -- built-in functions like memcpy() it tends to
2180                         -- run out of registers, requiring -monly-n-regs
2181                         "-fno-builtin",
2182                         "-DSTOLEN_X86_REGS="++show n_regs ]
2183                     )
2184
2185 #elif ia64_TARGET_ARCH
2186         = ( [], ["-fomit-frame-pointer", "-G0"] )
2187
2188 #elif x86_64_TARGET_ARCH
2189         = (
2190                 [],
2191                 ["-fomit-frame-pointer",
2192                  "-fno-asynchronous-unwind-tables",
2193                         -- the unwind tables are unnecessary for HC code,
2194                         -- and get in the way of -split-objs.  Another option
2195                         -- would be to throw them away in the mangler, but this
2196                         -- is easier.
2197                  "-fno-builtin"
2198                         -- calling builtins like strlen() using the FFI can
2199                         -- cause gcc to run out of regs, so use the external
2200                         -- version.
2201                 ] )
2202
2203 #elif sparc_TARGET_ARCH
2204         = ( [], ["-w"] )
2205         -- For now, to suppress the gcc warning "call-clobbered
2206         -- register used for global register variable", we simply
2207         -- disable all warnings altogether using the -w flag. Oh well.
2208
2209 #elif powerpc_apple_darwin_TARGET
2210       -- -no-cpp-precomp:
2211       --     Disable Apple's precompiling preprocessor. It's a great thing
2212       --     for "normal" programs, but it doesn't support register variable
2213       --     declarations.
2214         = ( [], ["-no-cpp-precomp"] )
2215 #else
2216         = ( [], [] )
2217 #endif
2218
2219 picCCOpts :: DynFlags -> [String]
2220 picCCOpts _dflags
2221 #if darwin_TARGET_OS
2222       -- Apple prefers to do things the other way round.
2223       -- PIC is on by default.
2224       -- -mdynamic-no-pic:
2225       --     Turn off PIC code generation.
2226       -- -fno-common:
2227       --     Don't generate "common" symbols - these are unwanted
2228       --     in dynamic libraries.
2229
2230     | opt_PIC
2231         = ["-fno-common", "-U __PIC__","-D__PIC__"]
2232     | otherwise
2233         = ["-mdynamic-no-pic"]
2234 #elif mingw32_TARGET_OS
2235       -- no -fPIC for Windows
2236     | opt_PIC
2237         = ["-U __PIC__","-D__PIC__"]
2238     | otherwise
2239         = []
2240 #else
2241       -- we need -fPIC for C files when we are compiling with -dynamic,
2242       -- otherwise things like stub.c files don't get compiled
2243       -- correctly.  They need to reference data in the Haskell
2244       -- objects, but can't without -fPIC.  See
2245       -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
2246     | opt_PIC || not opt_Static
2247         = ["-fPIC", "-U __PIC__", "-D__PIC__"]
2248     | otherwise
2249         = []
2250 #endif
2251
2252 -- -----------------------------------------------------------------------------
2253 -- Splitting
2254
2255 can_split :: Bool
2256 can_split = cSplitObjs == "YES"
2257
2258 -- -----------------------------------------------------------------------------
2259 -- Compiler Info
2260
2261 data Printable = String String
2262                | FromDynFlags (DynFlags -> String)
2263
2264 compilerInfo :: [(String, Printable)]
2265 compilerInfo = [("Project name",                String cProjectName),
2266                 ("Project version",             String cProjectVersion),
2267                 ("Booter version",              String cBooterVersion),
2268                 ("Stage",                       String cStage),
2269                 ("Build platform",              String cBuildPlatform),
2270                 ("Host platform",               String cHostPlatform),
2271                 ("Target platform",             String cTargetPlatform),
2272                 ("Have interpreter",            String cGhcWithInterpreter),
2273                 ("Object splitting",            String cSplitObjs),
2274                 ("Have native code generator",  String cGhcWithNativeCodeGen),
2275                 ("Have llvm code generator",    String cGhcWithLlvmCodeGen),
2276                 ("Use archives for ghci",       String (show cUseArchivesForGhci)),
2277                 ("Support SMP",                 String cGhcWithSMP),
2278                 ("Unregisterised",              String cGhcUnregisterised),
2279                 ("Tables next to code",         String cGhcEnableTablesNextToCode),
2280                 ("RTS ways",                    String cGhcRTSWays),
2281                 ("Leading underscore",          String cLeadingUnderscore),
2282                 ("Debug on",                    String (show debugIsOn)),
2283                 ("LibDir",                      FromDynFlags topDir),
2284                 ("Global Package DB",           FromDynFlags systemPackageConfig)
2285                ]
2286