compiler/main/DynFlags.hs

   1
   2 -----------------------------------------------------------------------------
   3 --
   4 -- Dynamic flags
   5 --
   6 -- Most flags are dynamic flags, which means they can change from
   7 -- compilation to compilation using OPTIONS_GHC pragmas, and in a
   8 -- multi-session GHC each session can be using different dynamic
   9 -- flags.  Dynamic flags can also be set at the prompt in GHCi.
  10 --
  11 -- (c) The University of Glasgow 2005
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module DynFlags (
  16         -- Dynamic flags
  17         DynFlag(..),
  18         DynFlags(..),
  19         HscTarget(..), isObjectTarget, defaultObjectTarget,
  20         GhcMode(..), isOneShot,
  21         GhcLink(..), isNoLink,
  22         PackageFlag(..),
  23         Option(..),
  24         DynLibLoader(..),
  25         fFlags, xFlags,
  26         DPHBackend(..),
  27
  28         -- Configuration of the core-to-core and stg-to-stg phases
  29         CoreToDo(..),
  30         StgToDo(..),
  31         SimplifierSwitch(..),
  32         SimplifierMode(..), FloatOutSwitches(..),
  33         getCoreToDo, getStgToDo,
  34
  35         -- Manipulating DynFlags
  36         defaultDynFlags,                -- DynFlags
  37         initDynFlags,                   -- DynFlags -> IO DynFlags
  38
  39         dopt,                           -- DynFlag -> DynFlags -> Bool
  40         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
  41         getOpts,                        -- (DynFlags -> [a]) -> IO [a]
  42         getVerbFlag,
  43         updOptLevel,
  44         setTmpDir,
  45         setPackageName,
  46
  47         -- parsing DynFlags
  48         parseDynamicFlags,
  49         allFlags,
  50
  51         -- misc stuff
  52         machdepCCOpts, picCCOpts,
  53     supportedLanguages, languageOptions,
  54     compilerInfo,
  55   ) where
  56
  57 #include "HsVersions.h"
  58
  59 import Module
  60 import PackageConfig
  61 import PrelNames        ( mAIN )
  62 #ifdef i386_TARGET_ARCH
  63 import StaticFlags      ( opt_Static )
  64 #endif
  65 import StaticFlags      ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
  66                           v_RTS_Build_tag )
  67 import {-# SOURCE #-} Packages (PackageState)
  68 import DriverPhases     ( Phase(..), phaseInputExt )
  69 import Config
  70 import CmdLineParser
  71 import Constants        ( mAX_CONTEXT_REDUCTION_DEPTH )
  72 import Panic            ( panic, GhcException(..) )
  73 import UniqFM           ( UniqFM )
  74 import Util
  75 import Maybes           ( orElse )
  76 import SrcLoc           ( SrcSpan )
  77 import Outputable
  78 import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
  79
  80 import Data.IORef       ( readIORef )
  81 import Control.Exception ( throwDyn )
  82 import Control.Monad    ( when )
  83
  84 import Data.Char
  85 import System.FilePath
  86 import System.IO        ( hPutStrLn, stderr )
  87
  88 -- -----------------------------------------------------------------------------
  89 -- DynFlags
  90
  91 data DynFlag
  92
  93    -- debugging flags
  94    = Opt_D_dump_cmm
  95    | Opt_D_dump_cmmz
  96    | Opt_D_dump_cmmz_pretty
  97    | Opt_D_dump_cps_cmm
  98    | Opt_D_dump_cvt_cmm
  99    | Opt_D_dump_asm
 100    | Opt_D_dump_asm_native
 101    | Opt_D_dump_asm_liveness
 102    | Opt_D_dump_asm_coalesce
 103    | Opt_D_dump_asm_regalloc
 104    | Opt_D_dump_asm_regalloc_stages
 105    | Opt_D_dump_asm_conflicts
 106    | Opt_D_dump_asm_stats
 107    | Opt_D_dump_cpranal
 108    | Opt_D_dump_deriv
 109    | Opt_D_dump_ds
 110    | Opt_D_dump_flatC
 111    | Opt_D_dump_foreign
 112    | Opt_D_dump_inlinings
 113    | Opt_D_dump_rule_firings
 114    | Opt_D_dump_occur_anal
 115    | Opt_D_dump_parsed
 116    | Opt_D_dump_rn
 117    | Opt_D_dump_simpl
 118    | Opt_D_dump_simpl_iterations
 119    | Opt_D_dump_simpl_phases
 120    | Opt_D_dump_spec
 121    | Opt_D_dump_prep
 122    | Opt_D_dump_stg
 123    | Opt_D_dump_stranal
 124    | Opt_D_dump_tc
 125    | Opt_D_dump_types
 126    | Opt_D_dump_rules
 127    | Opt_D_dump_cse
 128    | Opt_D_dump_worker_wrapper
 129    | Opt_D_dump_rn_trace
 130    | Opt_D_dump_rn_stats
 131    | Opt_D_dump_opt_cmm
 132    | Opt_D_dump_simpl_stats
 133    | Opt_D_dump_tc_trace
 134    | Opt_D_dump_if_trace
 135    | Opt_D_dump_splices
 136    | Opt_D_dump_BCOs
 137    | Opt_D_dump_vect
 138    | Opt_D_dump_hpc
 139    | Opt_D_source_stats
 140    | Opt_D_verbose_core2core
 141    | Opt_D_verbose_stg2stg
 142    | Opt_D_dump_hi
 143    | Opt_D_dump_hi_diffs
 144    | Opt_D_dump_minimal_imports
 145    | Opt_D_dump_mod_cycles
 146    | Opt_D_dump_view_pattern_commoning
 147    | Opt_D_faststring_stats
 148    | Opt_DumpToFile                     -- ^ Append dump output to files instead of stdout.
 149    | Opt_D_no_debug_output
 150    | Opt_DoCoreLinting
 151    | Opt_DoStgLinting
 152    | Opt_DoCmmLinting
 153    | Opt_DoAsmLinting
 154
 155    | Opt_WarnIsError                    -- -Werror; makes warnings fatal
 156    | Opt_WarnDuplicateExports
 157    | Opt_WarnHiShadows
 158    | Opt_WarnImplicitPrelude
 159    | Opt_WarnIncompletePatterns
 160    | Opt_WarnIncompletePatternsRecUpd
 161    | Opt_WarnMissingFields
 162    | Opt_WarnMissingMethods
 163    | Opt_WarnMissingSigs
 164    | Opt_WarnNameShadowing
 165    | Opt_WarnOverlappingPatterns
 166    | Opt_WarnSimplePatterns
 167    | Opt_WarnTypeDefaults
 168    | Opt_WarnMonomorphism
 169    | Opt_WarnUnusedBinds
 170    | Opt_WarnUnusedImports
 171    | Opt_WarnUnusedMatches
 172    | Opt_WarnDeprecations
 173    | Opt_WarnDeprecatedFlags
 174    | Opt_WarnDodgyImports
 175    | Opt_WarnOrphans
 176    | Opt_WarnTabs
 177
 178    -- language opts
 179    | Opt_OverlappingInstances
 180    | Opt_UndecidableInstances
 181    | Opt_IncoherentInstances
 182    | Opt_MonomorphismRestriction
 183    | Opt_MonoPatBinds
 184    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
 185    | Opt_ForeignFunctionInterface
 186    | Opt_UnliftedFFITypes
 187    | Opt_PArr                           -- Syntactic support for parallel arrays
 188    | Opt_Arrows                         -- Arrow-notation syntax
 189    | Opt_TemplateHaskell
 190    | Opt_QuasiQuotes
 191    | Opt_ImplicitParams
 192    | Opt_Generics
 193    | Opt_ImplicitPrelude
 194    | Opt_ScopedTypeVariables
 195    | Opt_UnboxedTuples
 196    | Opt_BangPatterns
 197    | Opt_TypeFamilies
 198    | Opt_OverloadedStrings
 199    | Opt_DisambiguateRecordFields
 200    | Opt_RecordWildCards
 201    | Opt_RecordPuns
 202    | Opt_ViewPatterns
 203    | Opt_GADTs
 204    | Opt_RelaxedPolyRec
 205    | Opt_StandaloneDeriving
 206    | Opt_DeriveDataTypeable
 207    | Opt_TypeSynonymInstances
 208    | Opt_FlexibleContexts
 209    | Opt_FlexibleInstances
 210    | Opt_ConstrainedClassMethods
 211    | Opt_MultiParamTypeClasses
 212    | Opt_FunctionalDependencies
 213    | Opt_UnicodeSyntax
 214    | Opt_PolymorphicComponents
 215    | Opt_ExistentialQuantification
 216    | Opt_MagicHash
 217    | Opt_EmptyDataDecls
 218    | Opt_KindSignatures
 219    | Opt_PatternSignatures
 220    | Opt_ParallelListComp
 221    | Opt_TransformListComp
 222    | Opt_GeneralizedNewtypeDeriving
 223    | Opt_RecursiveDo
 224    | Opt_PatternGuards
 225    | Opt_LiberalTypeSynonyms
 226    | Opt_Rank2Types
 227    | Opt_RankNTypes
 228    | Opt_ImpredicativeTypes
 229    | Opt_TypeOperators
 230
 231    | Opt_PrintExplicitForalls
 232
 233    -- optimisation opts
 234    | Opt_Strictness
 235    | Opt_FullLaziness
 236    | Opt_StaticArgumentTransformation
 237    | Opt_CSE
 238    | Opt_LiberateCase
 239    | Opt_SpecConstr
 240    | Opt_IgnoreInterfacePragmas
 241    | Opt_OmitInterfacePragmas
 242    | Opt_DoLambdaEtaExpansion
 243    | Opt_IgnoreAsserts
 244    | Opt_DoEtaReduction
 245    | Opt_CaseMerge
 246    | Opt_UnboxStrictFields
 247    | Opt_MethodSharing
 248    | Opt_DictsCheap
 249    | Opt_RewriteRules
 250    | Opt_Vectorise
 251    | Opt_RegsGraph                      -- do graph coloring register allocation
 252    | Opt_RegsIterative                  -- do iterative coalescing graph coloring register allocation
 253
 254    -- misc opts
 255    | Opt_Cpp
 256    | Opt_Pp
 257    | Opt_ForceRecomp
 258    | Opt_DryRun
 259    | Opt_DoAsmMangling
 260    | Opt_ExcessPrecision
 261    | Opt_ReadUserPackageConf
 262    | Opt_NoHsMain
 263    | Opt_SplitObjs
 264    | Opt_StgStats
 265    | Opt_HideAllPackages
 266    | Opt_PrintBindResult
 267    | Opt_Haddock
 268    | Opt_HaddockOptions
 269    | Opt_Hpc_No_Auto
 270    | Opt_BreakOnException
 271    | Opt_BreakOnError
 272    | Opt_PrintEvldWithShow
 273    | Opt_PrintBindContents
 274    | Opt_GenManifest
 275    | Opt_EmbedManifest
 276    | Opt_RunCPSZ
 277    | Opt_ConvertToZipCfgAndBack
 278
 279    -- keeping stuff
 280    | Opt_KeepHiDiffs
 281    | Opt_KeepHcFiles
 282    | Opt_KeepSFiles
 283    | Opt_KeepRawSFiles
 284    | Opt_KeepTmpFiles
 285
 286    deriving (Eq, Show)
 287
 288 data DynFlags = DynFlags {
 289   ghcMode               :: GhcMode,
 290   ghcLink               :: GhcLink,
 291   coreToDo              :: Maybe [CoreToDo], -- reserved for -Ofile
 292   stgToDo               :: Maybe [StgToDo],  -- similarly
 293   hscTarget             :: HscTarget,
 294   hscOutName            :: String,      -- name of the output file
 295   extCoreName           :: String,      -- name of the .core output file
 296   verbosity             :: Int,         -- verbosity level
 297   optLevel              :: Int,         -- optimisation level
 298   simplPhases           :: Int,         -- number of simplifier phases
 299   maxSimplIterations    :: Int,         -- max simplifier iterations
 300   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
 301   ruleCheck             :: Maybe String,
 302
 303   specConstrThreshold   :: Maybe Int,   -- Threshold for SpecConstr
 304   specConstrCount       :: Maybe Int,   -- Max number of specialisations for any one function
 305   liberateCaseThreshold :: Maybe Int,   -- Threshold for LiberateCase
 306
 307   stolen_x86_regs       :: Int,
 308   cmdlineHcIncludes     :: [String],    -- -#includes
 309   importPaths           :: [FilePath],
 310   mainModIs             :: Module,
 311   mainFunIs             :: Maybe String,
 312   ctxtStkDepth          :: Int,         -- Typechecker context stack depth
 313
 314   dphBackend            :: DPHBackend,
 315
 316   thisPackage           :: PackageId,
 317
 318   -- ways
 319   wayNames              :: [WayName],   -- way flags from the cmd line
 320   buildTag              :: String,      -- the global "way" (eg. "p" for prof)
 321   rtsBuildTag           :: String,      -- the RTS "way"
 322
 323   -- paths etc.
 324   objectDir             :: Maybe String,
 325   hiDir                 :: Maybe String,
 326   stubDir               :: Maybe String,
 327
 328   objectSuf             :: String,
 329   hcSuf                 :: String,
 330   hiSuf                 :: String,
 331
 332   outputFile            :: Maybe String,
 333   outputHi              :: Maybe String,
 334   dynLibLoader          :: DynLibLoader,
 335
 336   -- | This is set by DriverPipeline.runPipeline based on where
 337   --    its output is going.
 338   dumpPrefix            :: Maybe FilePath,
 339
 340   -- | Override the dumpPrefix set by runPipeline.
 341   --    Set by -ddump-file-prefix
 342   dumpPrefixForce       :: Maybe FilePath,
 343
 344   includePaths          :: [String],
 345   libraryPaths          :: [String],
 346   frameworkPaths        :: [String],    -- used on darwin only
 347   cmdlineFrameworks     :: [String],    -- ditto
 348   tmpDir                :: String,      -- no trailing '/'
 349
 350   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
 351   ghciUsagePath         :: FilePath,    -- ditto
 352
 353   hpcDir                :: String,      -- ^ path to store the .mix files
 354
 355   -- options for particular phases
 356   opt_L                 :: [String],
 357   opt_P                 :: [String],
 358   opt_F                 :: [String],
 359   opt_c                 :: [String],
 360   opt_m                 :: [String],
 361   opt_a                 :: [String],
 362   opt_l                 :: [String],
 363   opt_dep               :: [String],
 364   opt_windres           :: [String],
 365
 366   -- commands for particular phases
 367   pgm_L                 :: String,
 368   pgm_P                 :: (String,[Option]),
 369   pgm_F                 :: String,
 370   pgm_c                 :: (String,[Option]),
 371   pgm_m                 :: (String,[Option]),
 372   pgm_s                 :: (String,[Option]),
 373   pgm_a                 :: (String,[Option]),
 374   pgm_l                 :: (String,[Option]),
 375   pgm_dll               :: (String,[Option]),
 376   pgm_T                 :: String,
 377   pgm_sysman            :: String,
 378   pgm_windres           :: String,
 379
 380   --  Package flags
 381   extraPkgConfs         :: [FilePath],
 382   topDir                :: FilePath,    -- filled in by SysTools
 383   systemPackageConfig   :: FilePath,    -- ditto
 384         -- The -package-conf flags given on the command line, in the order
 385         -- they appeared.
 386
 387   packageFlags          :: [PackageFlag],
 388         -- The -package and -hide-package flags from the command-line
 389
 390   -- Package state
 391   -- NB. do not modify this field, it is calculated by
 392   -- Packages.initPackages and Packages.updatePackages.
 393   pkgDatabase           :: Maybe (UniqFM PackageConfig),
 394   pkgState              :: PackageState,
 395
 396   -- hsc dynamic flags
 397   flags                 :: [DynFlag],
 398
 399   -- message output
 400   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 401
 402   haddockOptions :: Maybe String
 403  }
 404
 405 data HscTarget
 406   = HscC
 407   | HscAsm
 408   | HscJava
 409   | HscInterpreted
 410   | HscNothing
 411   deriving (Eq, Show)
 412
 413 -- | will this target result in an object file on the disk?
 414 isObjectTarget :: HscTarget -> Bool
 415 isObjectTarget HscC     = True
 416 isObjectTarget HscAsm   = True
 417 isObjectTarget _        = False
 418
 419 -- | The 'GhcMode' tells us whether we're doing multi-module
 420 -- compilation (controlled via the "GHC" API) or one-shot
 421 -- (single-module) compilation.  This makes a difference primarily to
 422 -- the "Finder": in one-shot mode we look for interface files for
 423 -- imported modules, but in multi-module mode we look for source files
 424 -- in order to check whether they need to be recompiled.
 425 data GhcMode
 426   = CompManager         -- ^ --make, GHCi, etc.
 427   | OneShot             -- ^ ghc -c Foo.hs
 428   | MkDepend            -- ^ ghc -M, see Finder for why we need this
 429   deriving Eq
 430
 431 isOneShot :: GhcMode -> Bool
 432 isOneShot OneShot = True
 433 isOneShot _other  = False
 434
 435 -- | What kind of linking to do.
 436 data GhcLink    -- What to do in the link step, if there is one
 437   = NoLink              -- Don't link at all
 438   | LinkBinary          -- Link object code into a binary
 439   | LinkInMemory        -- Use the in-memory dynamic linker
 440   | LinkDynLib          -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
 441   deriving (Eq, Show)
 442
 443 isNoLink :: GhcLink -> Bool
 444 isNoLink NoLink = True
 445 isNoLink _      = False
 446
 447 data PackageFlag
 448   = ExposePackage  String
 449   | HidePackage    String
 450   | IgnorePackage  String
 451   deriving Eq
 452
 453 defaultHscTarget :: HscTarget
 454 defaultHscTarget = defaultObjectTarget
 455
 456 -- | the 'HscTarget' value corresponding to the default way to create
 457 -- object files on the current platform.
 458 defaultObjectTarget :: HscTarget
 459 defaultObjectTarget
 460   | cGhcWithNativeCodeGen == "YES"      =  HscAsm
 461   | otherwise                           =  HscC
 462
 463 data DynLibLoader
 464   = Deployable
 465   | Wrapped (Maybe String)
 466   | SystemDependent
 467   deriving Eq
 468
 469 initDynFlags :: DynFlags -> IO DynFlags
 470 initDynFlags dflags = do
 471  -- someday these will be dynamic flags
 472  ways <- readIORef v_Ways
 473  build_tag <- readIORef v_Build_tag
 474  rts_build_tag <- readIORef v_RTS_Build_tag
 475  return dflags{
 476         wayNames        = ways,
 477         buildTag        = build_tag,
 478         rtsBuildTag     = rts_build_tag
 479         }
 480
 481 defaultDynFlags :: DynFlags
 482 defaultDynFlags =
 483      DynFlags {
 484         ghcMode                 = CompManager,
 485         ghcLink                 = LinkBinary,
 486         coreToDo                = Nothing,
 487         stgToDo                 = Nothing,
 488         hscTarget               = defaultHscTarget,
 489         hscOutName              = "",
 490         extCoreName             = "",
 491         verbosity               = 0,
 492         optLevel                = 0,
 493         simplPhases             = 2,
 494         maxSimplIterations      = 4,
 495         shouldDumpSimplPhase    = const False,
 496         ruleCheck               = Nothing,
 497         specConstrThreshold     = Just 200,
 498         specConstrCount         = Just 3,
 499         liberateCaseThreshold   = Just 200,
 500         stolen_x86_regs         = 4,
 501         cmdlineHcIncludes       = [],
 502         importPaths             = ["."],
 503         mainModIs               = mAIN,
 504         mainFunIs               = Nothing,
 505         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 506
 507         dphBackend              = DPHPar,
 508
 509         thisPackage             = mainPackageId,
 510
 511         objectDir               = Nothing,
 512         hiDir                   = Nothing,
 513         stubDir                 = Nothing,
 514
 515         objectSuf               = phaseInputExt StopLn,
 516         hcSuf                   = phaseInputExt HCc,
 517         hiSuf                   = "hi",
 518
 519         outputFile              = Nothing,
 520         outputHi                = Nothing,
 521         dynLibLoader            = Deployable,
 522         dumpPrefix              = Nothing,
 523         dumpPrefixForce         = Nothing,
 524         includePaths            = [],
 525         libraryPaths            = [],
 526         frameworkPaths          = [],
 527         cmdlineFrameworks       = [],
 528         tmpDir                  = cDEFAULT_TMPDIR,
 529
 530         hpcDir                  = ".hpc",
 531
 532         opt_L                   = [],
 533         opt_P                   = (if opt_PIC
 534                                    then ["-D__PIC__"]
 535                                    else []),
 536         opt_F                   = [],
 537         opt_c                   = [],
 538         opt_a                   = [],
 539         opt_m                   = [],
 540         opt_l                   = [],
 541         opt_dep                 = [],
 542         opt_windres             = [],
 543
 544         extraPkgConfs           = [],
 545         packageFlags            = [],
 546         pkgDatabase             = Nothing,
 547         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
 548         wayNames                = panic "defaultDynFlags: No wayNames",
 549         buildTag                = panic "defaultDynFlags: No buildTag",
 550         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
 551         -- initSysTools fills all these in
 552         ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
 553         ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
 554         topDir                  = panic "defaultDynFlags: No topDir",
 555         systemPackageConfig     = panic "defaultDynFlags: No systemPackageConfig",
 556         pgm_L                   = panic "defaultDynFlags: No pgm_L",
 557         pgm_P                   = panic "defaultDynFlags: No pgm_P",
 558         pgm_F                   = panic "defaultDynFlags: No pgm_F",
 559         pgm_c                   = panic "defaultDynFlags: No pgm_c",
 560         pgm_m                   = panic "defaultDynFlags: No pgm_m",
 561         pgm_s                   = panic "defaultDynFlags: No pgm_s",
 562         pgm_a                   = panic "defaultDynFlags: No pgm_a",
 563         pgm_l                   = panic "defaultDynFlags: No pgm_l",
 564         pgm_dll                 = panic "defaultDynFlags: No pgm_dll",
 565         pgm_T                   = panic "defaultDynFlags: No pgm_T",
 566         pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
 567         pgm_windres             = panic "defaultDynFlags: No pgm_windres",
 568         -- end of initSysTools values
 569         haddockOptions = Nothing,
 570         flags = [
 571             Opt_ReadUserPackageConf,
 572
 573             Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
 574                                 -- behaviour the default, to see if anyone notices
 575                                 -- SLPJ July 06
 576
 577             Opt_ImplicitPrelude,
 578             Opt_MonomorphismRestriction,
 579
 580             Opt_MethodSharing,
 581
 582             Opt_DoAsmMangling,
 583
 584             Opt_GenManifest,
 585             Opt_EmbedManifest,
 586             Opt_PrintBindContents
 587             ]
 588             ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
 589                     -- The default -O0 options
 590             ++ standardWarnings,
 591
 592         log_action = \severity srcSpan style msg ->
 593                         case severity of
 594                           SevInfo  -> hPutStrLn stderr (show (msg style))
 595                           SevFatal -> hPutStrLn stderr (show (msg style))
 596                           _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
 597       }
 598
 599 {-
 600     Verbosity levels:
 601
 602     0   |   print errors & warnings only
 603     1   |   minimal verbosity: print "compiling M ... done." for each module.
 604     2   |   equivalent to -dshow-passes
 605     3   |   equivalent to existing "ghc -v"
 606     4   |   "ghc -v -ddump-most"
 607     5   |   "ghc -v -ddump-all"
 608 -}
 609
 610 dopt :: DynFlag -> DynFlags -> Bool
 611 dopt f dflags  = f `elem` (flags dflags)
 612
 613 dopt_set :: DynFlags -> DynFlag -> DynFlags
 614 dopt_set dfs f = dfs{ flags = f : flags dfs }
 615
 616 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 617 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 618
 619 getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
 620 getOpts dflags opts = reverse (opts dflags)
 621         -- We add to the options from the front, so we need to reverse the list
 622
 623 getVerbFlag :: DynFlags -> String
 624 getVerbFlag dflags
 625   | verbosity dflags >= 3  = "-v"
 626   | otherwise =  ""
 627
 628 setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
 629          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
 630          addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
 631          addCmdlineFramework, addHaddockOpts
 632    :: String -> DynFlags -> DynFlags
 633 setOutputFile, setOutputHi, setDumpPrefixForce
 634    :: Maybe String -> DynFlags -> DynFlags
 635
 636 setObjectDir  f d = d{ objectDir  = Just f}
 637 setHiDir      f d = d{ hiDir      = Just f}
 638 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
 639   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
 640   -- #included from the .hc file when compiling with -fvia-C.
 641
 642 setObjectSuf  f d = d{ objectSuf  = f}
 643 setHiSuf      f d = d{ hiSuf      = f}
 644 setHcSuf      f d = d{ hcSuf      = f}
 645
 646 setOutputFile f d = d{ outputFile = f}
 647 setOutputHi   f d = d{ outputHi   = f}
 648
 649 parseDynLibLoaderMode f d =
 650  case splitAt 8 f of
 651    ("deploy", "")       -> d{ dynLibLoader = Deployable }
 652    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
 653    ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
 654    ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
 655    ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
 656    (_,_)                -> error "Unknown dynlib loader"
 657
 658 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 659
 660 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 661 -- Config.hs should really use Option.
 662 setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
 663
 664 setPgmL   f d = d{ pgm_L   = f}
 665 setPgmF   f d = d{ pgm_F   = f}
 666 setPgmc   f d = d{ pgm_c   = (f,[])}
 667 setPgmm   f d = d{ pgm_m   = (f,[])}
 668 setPgms   f d = d{ pgm_s   = (f,[])}
 669 setPgma   f d = d{ pgm_a   = (f,[])}
 670 setPgml   f d = d{ pgm_l   = (f,[])}
 671 setPgmdll f d = d{ pgm_dll = (f,[])}
 672 setPgmwindres f d = d{ pgm_windres = f}
 673
 674 addOptL   f d = d{ opt_L   = f : opt_L d}
 675 addOptP   f d = d{ opt_P   = f : opt_P d}
 676 addOptF   f d = d{ opt_F   = f : opt_F d}
 677 addOptc   f d = d{ opt_c   = f : opt_c d}
 678 addOptm   f d = d{ opt_m   = f : opt_m d}
 679 addOpta   f d = d{ opt_a   = f : opt_a d}
 680 addOptl   f d = d{ opt_l   = f : opt_l d}
 681 addOptdep f d = d{ opt_dep = f : opt_dep d}
 682 addOptwindres f d = d{ opt_windres = f : opt_windres d}
 683
 684 addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
 685
 686 addHaddockOpts f d = d{ haddockOptions = Just f}
 687
 688 -- -----------------------------------------------------------------------------
 689 -- Command-line options
 690
 691 -- When invoking external tools as part of the compilation pipeline, we
 692 -- pass these a sequence of options on the command-line. Rather than
 693 -- just using a list of Strings, we use a type that allows us to distinguish
 694 -- between filepaths and 'other stuff'. [The reason being, of course, that
 695 -- this type gives us a handle on transforming filenames, and filenames only,
 696 -- to whatever format they're expected to be on a particular platform.]
 697
 698 data Option
 699  = FileOption -- an entry that _contains_ filename(s) / filepaths.
 700               String  -- a non-filepath prefix that shouldn't be
 701                       -- transformed (e.g., "/out=")
 702               String  -- the filepath/filename portion
 703  | Option     String
 704
 705 -----------------------------------------------------------------------------
 706 -- Setting the optimisation level
 707
 708 updOptLevel :: Int -> DynFlags -> DynFlags
 709 -- Set dynflags appropriate to the optimisation level
 710 updOptLevel n dfs
 711   = dfs2{ optLevel = final_n }
 712   where
 713    final_n = max 0 (min 2 n)    -- Clamp to 0 <= n <= 2
 714    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
 715    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
 716
 717    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
 718    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 719
 720 optLevelFlags :: [([Int], DynFlag)]
 721 optLevelFlags
 722   = [ ([0],     Opt_IgnoreInterfacePragmas)
 723     , ([0],     Opt_OmitInterfacePragmas)
 724
 725     , ([1,2],   Opt_IgnoreAsserts)
 726     , ([1,2],   Opt_RewriteRules)       -- Off for -O0; see Note [Scoping for Builtin rules]
 727                                         --              in PrelRules
 728     , ([1,2],   Opt_DoEtaReduction)
 729     , ([1,2],   Opt_CaseMerge)
 730     , ([1,2],   Opt_Strictness)
 731     , ([1,2],   Opt_CSE)
 732     , ([1,2],   Opt_FullLaziness)
 733
 734     , ([2],     Opt_LiberateCase)
 735     , ([2],     Opt_SpecConstr)
 736     , ([2],     Opt_StaticArgumentTransformation)
 737
 738     , ([0,1,2], Opt_DoLambdaEtaExpansion)
 739                 -- This one is important for a tiresome reason:
 740                 -- we want to make sure that the bindings for data
 741                 -- constructors are eta-expanded.  This is probably
 742                 -- a good thing anyway, but it seems fragile.
 743     ]
 744
 745 -- -----------------------------------------------------------------------------
 746 -- Standard sets of warning options
 747
 748 standardWarnings :: [DynFlag]
 749 standardWarnings
 750     = [ Opt_WarnDeprecations,
 751         Opt_WarnDeprecatedFlags,
 752         Opt_WarnOverlappingPatterns,
 753         Opt_WarnMissingFields,
 754         Opt_WarnMissingMethods,
 755         Opt_WarnDuplicateExports
 756       ]
 757
 758 minusWOpts :: [DynFlag]
 759 minusWOpts
 760     = standardWarnings ++
 761       [ Opt_WarnUnusedBinds,
 762         Opt_WarnUnusedMatches,
 763         Opt_WarnUnusedImports,
 764         Opt_WarnIncompletePatterns,
 765         Opt_WarnDodgyImports
 766       ]
 767
 768 minusWallOpts :: [DynFlag]
 769 minusWallOpts
 770     = minusWOpts ++
 771       [ Opt_WarnTypeDefaults,
 772         Opt_WarnNameShadowing,
 773         Opt_WarnMissingSigs,
 774         Opt_WarnHiShadows,
 775         Opt_WarnOrphans
 776       ]
 777
 778 -- minuswRemovesOpts should be every warning option
 779 minuswRemovesOpts :: [DynFlag]
 780 minuswRemovesOpts
 781     = minusWallOpts ++
 782       [Opt_WarnImplicitPrelude,
 783        Opt_WarnIncompletePatternsRecUpd,
 784        Opt_WarnSimplePatterns,
 785        Opt_WarnMonomorphism,
 786        Opt_WarnTabs
 787       ]
 788
 789 -- -----------------------------------------------------------------------------
 790 -- CoreToDo:  abstraction of core-to-core passes to run.
 791
 792 data CoreToDo           -- These are diff core-to-core passes,
 793                         -- which may be invoked in any order,
 794                         -- as many times as you like.
 795
 796   = CoreDoSimplify      -- The core-to-core simplifier.
 797         SimplifierMode
 798         [SimplifierSwitch]
 799                         -- Each run of the simplifier can take a different
 800                         -- set of simplifier-specific flags.
 801   | CoreDoFloatInwards
 802   | CoreDoFloatOutwards FloatOutSwitches
 803   | CoreLiberateCase
 804   | CoreDoPrintCore
 805   | CoreDoStaticArgs
 806   | CoreDoStrictness
 807   | CoreDoWorkerWrapper
 808   | CoreDoSpecialising
 809   | CoreDoSpecConstr
 810   | CoreDoOldStrictness
 811   | CoreDoGlomBinds
 812   | CoreCSE
 813   | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
 814                                                 -- matching this string
 815   | CoreDoVectorisation DPHBackend
 816   | CoreDoNothing                -- Useful when building up
 817   | CoreDoPasses [CoreToDo]      -- lists of these things
 818
 819 data SimplifierMode             -- See comments in SimplMonad
 820   = SimplGently
 821   | SimplPhase Int [String]
 822
 823 data SimplifierSwitch
 824   = MaxSimplifierIterations Int
 825   | NoCaseOfCase
 826
 827 data FloatOutSwitches
 828   = FloatOutSw  Bool    -- True <=> float lambdas to top level
 829                 Bool    -- True <=> float constants to top level,
 830                         --          even if they do not escape a lambda
 831
 832
 833 -- The core-to-core pass ordering is derived from the DynFlags:
 834 runWhen :: Bool -> CoreToDo -> CoreToDo
 835 runWhen True  do_this = do_this
 836 runWhen False _       = CoreDoNothing
 837
 838 runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
 839 runMaybe (Just x) f = f x
 840 runMaybe Nothing  _ = CoreDoNothing
 841
 842 getCoreToDo :: DynFlags -> [CoreToDo]
 843 getCoreToDo dflags
 844   | Just todo <- coreToDo dflags = todo -- set explicitly by user
 845   | otherwise = core_todo
 846   where
 847     opt_level     = optLevel dflags
 848     phases        = simplPhases dflags
 849     max_iter      = maxSimplIterations dflags
 850     strictness    = dopt Opt_Strictness dflags
 851     full_laziness = dopt Opt_FullLaziness dflags
 852     cse           = dopt Opt_CSE dflags
 853     spec_constr   = dopt Opt_SpecConstr dflags
 854     liberate_case = dopt Opt_LiberateCase dflags
 855     rule_check    = ruleCheck dflags
 856     static_args   = dopt Opt_StaticArgumentTransformation dflags
 857
 858     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 859
 860     simpl_phase phase names iter
 861       = CoreDoPasses
 862           [ CoreDoSimplify (SimplPhase phase names) [
 863               MaxSimplifierIterations iter
 864             ],
 865             maybe_rule_check phase
 866           ]
 867
 868     vectorisation
 869       = runWhen (dopt Opt_Vectorise dflags)
 870         $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
 871
 872
 873                 -- By default, we have 2 phases before phase 0.
 874
 875                 -- Want to run with inline phase 2 after the specialiser to give
 876                 -- maximum chance for fusion to work before we inline build/augment
 877                 -- in phase 1.  This made a difference in 'ansi' where an
 878                 -- overloaded function wasn't inlined till too late.
 879
 880                 -- Need phase 1 so that build/augment get
 881                 -- inlined.  I found that spectral/hartel/genfft lost some useful
 882                 -- strictness in the function sumcode' if augment is not inlined
 883                 -- before strictness analysis runs
 884     simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter
 885                                   | phase <- [phases, phases-1 .. 1] ]
 886
 887
 888         -- initial simplify: mk specialiser happy: minimum effort please
 889     simpl_gently = CoreDoSimplify SimplGently [
 890                         --      Simplify "gently"
 891                         -- Don't inline anything till full laziness has bitten
 892                         -- In particular, inlining wrappers inhibits floating
 893                         -- e.g. ...(case f x of ...)...
 894                         --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
 895                         --  ==> ...(case x of I# x# -> case fw x# of ...)...
 896                         -- and now the redex (f x) isn't floatable any more
 897                         -- Similarly, don't apply any rules until after full
 898                         -- laziness.  Notably, list fusion can prevent floating.
 899
 900             NoCaseOfCase,       -- Don't do case-of-case transformations.
 901                                 -- This makes full laziness work better
 902             MaxSimplifierIterations max_iter
 903         ]
 904
 905     core_todo =
 906      if opt_level == 0 then
 907        [vectorisation,
 908         simpl_phase 0 ["final"] max_iter]
 909      else {- opt_level >= 1 -} [
 910
 911     -- We want to do the static argument transform before full laziness as it
 912     -- may expose extra opportunities to float things outwards. However, to fix
 913     -- up the output of the transformation we need at do at least one simplify
 914     -- after this before anything else
 915         runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
 916
 917         -- We run vectorisation here for now, but we might also try to run
 918         -- it later
 919         vectorisation,
 920
 921         -- initial simplify: mk specialiser happy: minimum effort please
 922         simpl_gently,
 923
 924         -- Specialisation is best done before full laziness
 925         -- so that overloaded functions have all their dictionary lambdas manifest
 926         CoreDoSpecialising,
 927
 928         runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)),
 929
 930         CoreDoFloatInwards,
 931
 932         simpl_phases,
 933
 934                 -- Phase 0: allow all Ids to be inlined now
 935                 -- This gets foldr inlined before strictness analysis
 936
 937                 -- At least 3 iterations because otherwise we land up with
 938                 -- huge dead expressions because of an infelicity in the
 939                 -- simpifier.
 940                 --      let k = BIG in foldr k z xs
 941                 -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 942                 -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 943                 -- Don't stop now!
 944         simpl_phase 0 ["main"] (max max_iter 3),
 945
 946
 947 #ifdef OLD_STRICTNESS
 948         CoreDoOldStrictness,
 949 #endif
 950         runWhen strictness (CoreDoPasses [
 951                 CoreDoStrictness,
 952                 CoreDoWorkerWrapper,
 953                 CoreDoGlomBinds,
 954                 simpl_phase 0 ["post-worker-wrapper"] max_iter
 955                 ]),
 956
 957         runWhen full_laziness
 958           (CoreDoFloatOutwards (FloatOutSw False    -- Not lambdas
 959                                            True)),  -- Float constants
 960                 -- nofib/spectral/hartel/wang doubles in speed if you
 961                 -- do full laziness late in the day.  It only happens
 962                 -- after fusion and other stuff, so the early pass doesn't
 963                 -- catch it.  For the record, the redex is
 964                 --        f_el22 (f_el21 r_midblock)
 965
 966
 967         runWhen cse CoreCSE,
 968                 -- We want CSE to follow the final full-laziness pass, because it may
 969                 -- succeed in commoning up things floated out by full laziness.
 970                 -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 971
 972         CoreDoFloatInwards,
 973
 974         maybe_rule_check 0,
 975
 976                 -- Case-liberation for -O2.  This should be after
 977                 -- strictness analysis and the simplification which follows it.
 978         runWhen liberate_case (CoreDoPasses [
 979             CoreLiberateCase,
 980             simpl_phase 0 ["post-liberate-case"] max_iter
 981             ]),         -- Run the simplifier after LiberateCase to vastly
 982                         -- reduce the possiblility of shadowing
 983                         -- Reason: see Note [Shadowing] in SpecConstr.lhs
 984
 985         runWhen spec_constr CoreDoSpecConstr,
 986
 987         maybe_rule_check 0,
 988
 989         -- Final clean-up simplification:
 990         simpl_phase 0 ["final"] max_iter
 991      ]
 992
 993 -- -----------------------------------------------------------------------------
 994 -- StgToDo:  abstraction of stg-to-stg passes to run.
 995
 996 data StgToDo
 997   = StgDoMassageForProfiling  -- should be (next to) last
 998   -- There's also setStgVarInfo, but its absolute "lastness"
 999   -- is so critical that it is hardwired in (no flag).
1000   | D_stg_stats
1001
1002 getStgToDo :: DynFlags -> [StgToDo]
1003 getStgToDo dflags
1004   | Just todo <- stgToDo dflags = todo -- set explicitly by user
1005   | otherwise = todo2
1006   where
1007         stg_stats = dopt Opt_StgStats dflags
1008
1009         todo1 = if stg_stats then [D_stg_stats] else []
1010
1011         todo2 | WayProf `elem` wayNames dflags
1012               = StgDoMassageForProfiling : todo1
1013               | otherwise
1014               = todo1
1015
1016 -- -----------------------------------------------------------------------------
1017 -- DynFlags parser
1018
1019 allFlags :: [String]
1020 allFlags = map ('-':) $
1021            [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++
1022            map ("fno-"++) flags ++
1023            map ("f"++) flags ++
1024            map ("X"++) supportedLanguages ++
1025            map ("XNo"++) supportedLanguages
1026     where ok (PrefixPred _ _) = False
1027           ok _ = True
1028           flags = [ name | (name, _, _) <- fFlags ]
1029
1030 dynamic_flags :: [Flag DynP]
1031 dynamic_flags = [
1032     Flag "n"              (NoArg  (setDynFlag Opt_DryRun)) Supported
1033   , Flag "cpp"            (NoArg  (setDynFlag Opt_Cpp)) Supported
1034   , Flag "F"              (NoArg  (setDynFlag Opt_Pp)) Supported
1035   , Flag "#include"       (HasArg (addCmdlineHCInclude)) Supported
1036   , Flag "v"              (OptIntSuffix setVerbosity) Supported
1037
1038         ------- Specific phases  --------------------------------------------
1039   , Flag "pgmL"           (HasArg (upd . setPgmL)) Supported
1040   , Flag "pgmP"           (HasArg (upd . setPgmP)) Supported
1041   , Flag "pgmF"           (HasArg (upd . setPgmF)) Supported
1042   , Flag "pgmc"           (HasArg (upd . setPgmc)) Supported
1043   , Flag "pgmm"           (HasArg (upd . setPgmm)) Supported
1044   , Flag "pgms"           (HasArg (upd . setPgms)) Supported
1045   , Flag "pgma"           (HasArg (upd . setPgma)) Supported
1046   , Flag "pgml"           (HasArg (upd . setPgml)) Supported
1047   , Flag "pgmdll"         (HasArg (upd . setPgmdll)) Supported
1048   , Flag "pgmwindres"     (HasArg (upd . setPgmwindres)) Supported
1049
1050   , Flag "optL"           (HasArg (upd . addOptL)) Supported
1051   , Flag "optP"           (HasArg (upd . addOptP)) Supported
1052   , Flag "optF"           (HasArg (upd . addOptF)) Supported
1053   , Flag "optc"           (HasArg (upd . addOptc)) Supported
1054   , Flag "optm"           (HasArg (upd . addOptm)) Supported
1055   , Flag "opta"           (HasArg (upd . addOpta)) Supported
1056   , Flag "optl"           (HasArg (upd . addOptl)) Supported
1057   , Flag "optdep"         (HasArg (upd . addOptdep)) Supported
1058   , Flag "optwindres"     (HasArg (upd . addOptwindres)) Supported
1059
1060   , Flag "split-objs"
1061          (NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
1062          Supported
1063
1064         -------- Linking ----------------------------------------------------
1065   , Flag "c"              (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
1066          Supported
1067   , Flag "no-link"        (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
1068          (Deprecated "Use -c instead")
1069   , Flag "shared"         (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } ))
1070          Supported
1071   , Flag "dynload"        (HasArg (upd . parseDynLibLoaderMode))
1072          Supported
1073
1074         ------- Libraries ---------------------------------------------------
1075   , Flag "L"              (Prefix addLibraryPath ) Supported
1076   , Flag "l"              (AnySuffix (\s -> do upd (addOptl s))) Supported
1077
1078         ------- Frameworks --------------------------------------------------
1079         -- -framework-path should really be -F ...
1080   , Flag "framework-path" (HasArg addFrameworkPath ) Supported
1081   , Flag "framework"      (HasArg (upd . addCmdlineFramework)) Supported
1082
1083         ------- Output Redirection ------------------------------------------
1084   , Flag "odir"           (HasArg (upd . setObjectDir)) Supported
1085   , Flag "o"              (SepArg (upd . setOutputFile . Just)) Supported
1086   , Flag "ohi"            (HasArg (upd . setOutputHi   . Just )) Supported
1087   , Flag "osuf"           (HasArg (upd . setObjectSuf)) Supported
1088   , Flag "hcsuf"          (HasArg (upd . setHcSuf)) Supported
1089   , Flag "hisuf"          (HasArg (upd . setHiSuf)) Supported
1090   , Flag "hidir"          (HasArg (upd . setHiDir)) Supported
1091   , Flag "tmpdir"         (HasArg (upd . setTmpDir)) Supported
1092   , Flag "stubdir"        (HasArg (upd . setStubDir)) Supported
1093   , Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just))
1094          Supported
1095
1096         ------- Keeping temporary files -------------------------------------
1097      -- These can be singular (think ghc -c) or plural (think ghc --make)
1098   , Flag "keep-hc-file"     (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
1099   , Flag "keep-hc-files"    (NoArg (setDynFlag Opt_KeepHcFiles)) Supported
1100   , Flag "keep-s-file"      (NoArg (setDynFlag Opt_KeepSFiles)) Supported
1101   , Flag "keep-s-files"     (NoArg (setDynFlag Opt_KeepSFiles)) Supported
1102   , Flag "keep-raw-s-file"  (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
1103   , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported
1104      -- This only makes sense as plural
1105   , Flag "keep-tmp-files"   (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported
1106
1107         ------- Miscellaneous ----------------------------------------------
1108   , Flag "no-hs-main"     (NoArg (setDynFlag Opt_NoHsMain)) Supported
1109   , Flag "main-is"        (SepArg setMainIs ) Supported
1110   , Flag "haddock"        (NoArg (setDynFlag Opt_Haddock)) Supported
1111   , Flag "haddock-opts"   (HasArg (upd . addHaddockOpts)) Supported
1112   , Flag "hpcdir"         (SepArg setOptHpcDir) Supported
1113
1114         ------- recompilation checker --------------------------------------
1115   , Flag "recomp"         (NoArg (unSetDynFlag Opt_ForceRecomp))
1116          (Deprecated "Use -fno-force-recomp instead")
1117   , Flag "no-recomp"      (NoArg (setDynFlag   Opt_ForceRecomp))
1118          (Deprecated "Use -fforce-recomp instead")
1119
1120         ------- Packages ----------------------------------------------------
1121   , Flag "package-conf"   (HasArg extraPkgConf_) Supported
1122   , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf))
1123          Supported
1124   , Flag "package-name"   (HasArg (upd . setPackageName)) Supported
1125   , Flag "package"        (HasArg exposePackage) Supported
1126   , Flag "hide-package"   (HasArg hidePackage) Supported
1127   , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages))
1128          Supported
1129   , Flag "ignore-package" (HasArg ignorePackage)
1130          Supported
1131   , Flag "syslib"         (HasArg exposePackage)
1132          (Deprecated "Use -package instead")
1133
1134         ------ HsCpp opts ---------------------------------------------------
1135   , Flag "D"              (AnySuffix (upd . addOptP)) Supported
1136   , Flag "U"              (AnySuffix (upd . addOptP)) Supported
1137
1138         ------- Include/Import Paths ----------------------------------------
1139   , Flag "I"              (Prefix    addIncludePath) Supported
1140   , Flag "i"              (OptPrefix addImportPath ) Supported
1141
1142         ------ Debugging ----------------------------------------------------
1143   , Flag "dstg-stats"     (NoArg (setDynFlag Opt_StgStats)) Supported
1144
1145   , Flag "ddump-cmm"               (setDumpFlag Opt_D_dump_cmm)
1146          Supported
1147   , Flag "ddump-cmmz"              (setDumpFlag Opt_D_dump_cmmz)
1148          Supported
1149   , Flag "ddump-cmmz-pretty"       (setDumpFlag Opt_D_dump_cmmz_pretty)
1150          Supported
1151   , Flag "ddump-cps-cmm"           (setDumpFlag Opt_D_dump_cps_cmm)
1152          Supported
1153   , Flag "ddump-cvt-cmm"           (setDumpFlag Opt_D_dump_cvt_cmm)
1154          Supported
1155   , Flag "ddump-asm"               (setDumpFlag Opt_D_dump_asm)
1156          Supported
1157   , Flag "ddump-asm-native"        (setDumpFlag Opt_D_dump_asm_native)
1158          Supported
1159   , Flag "ddump-asm-liveness"      (setDumpFlag Opt_D_dump_asm_liveness)
1160          Supported
1161   , Flag "ddump-asm-coalesce"      (setDumpFlag Opt_D_dump_asm_coalesce)
1162          Supported
1163   , Flag "ddump-asm-regalloc"      (setDumpFlag Opt_D_dump_asm_regalloc)
1164          Supported
1165   , Flag "ddump-asm-conflicts"     (setDumpFlag Opt_D_dump_asm_conflicts)
1166          Supported
1167   , Flag "ddump-asm-regalloc-stages"
1168                                  (setDumpFlag Opt_D_dump_asm_regalloc_stages)
1169          Supported
1170   , Flag "ddump-asm-stats"         (setDumpFlag Opt_D_dump_asm_stats)
1171          Supported
1172   , Flag "ddump-cpranal"           (setDumpFlag Opt_D_dump_cpranal)
1173          Supported
1174   , Flag "ddump-deriv"             (setDumpFlag Opt_D_dump_deriv)
1175          Supported
1176   , Flag "ddump-ds"                (setDumpFlag Opt_D_dump_ds)
1177          Supported
1178   , Flag "ddump-flatC"             (setDumpFlag Opt_D_dump_flatC)
1179          Supported
1180   , Flag "ddump-foreign"           (setDumpFlag Opt_D_dump_foreign)
1181          Supported
1182   , Flag "ddump-inlinings"         (setDumpFlag Opt_D_dump_inlinings)
1183          Supported
1184   , Flag "ddump-rule-firings"      (setDumpFlag Opt_D_dump_rule_firings)
1185          Supported
1186   , Flag "ddump-occur-anal"        (setDumpFlag Opt_D_dump_occur_anal)
1187          Supported
1188   , Flag "ddump-parsed"            (setDumpFlag Opt_D_dump_parsed)
1189          Supported
1190   , Flag "ddump-rn"                (setDumpFlag Opt_D_dump_rn)
1191          Supported
1192   , Flag "ddump-simpl"             (setDumpFlag Opt_D_dump_simpl)
1193          Supported
1194   , Flag "ddump-simpl-iterations"  (setDumpFlag Opt_D_dump_simpl_iterations)
1195          Supported
1196   , Flag "ddump-simpl-phases"      (OptPrefix setDumpSimplPhases)
1197          Supported
1198   , Flag "ddump-spec"              (setDumpFlag Opt_D_dump_spec)
1199          Supported
1200   , Flag "ddump-prep"              (setDumpFlag Opt_D_dump_prep)
1201          Supported
1202   , Flag "ddump-stg"               (setDumpFlag Opt_D_dump_stg)
1203          Supported
1204   , Flag "ddump-stranal"           (setDumpFlag Opt_D_dump_stranal)
1205          Supported
1206   , Flag "ddump-tc"                (setDumpFlag Opt_D_dump_tc)
1207          Supported
1208   , Flag "ddump-types"             (setDumpFlag Opt_D_dump_types)
1209          Supported
1210   , Flag "ddump-rules"             (setDumpFlag Opt_D_dump_rules)
1211          Supported
1212   , Flag "ddump-cse"               (setDumpFlag Opt_D_dump_cse)
1213          Supported
1214   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
1215          Supported
1216   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
1217          Supported
1218   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
1219          Supported
1220   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
1221          Supported
1222   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
1223          Supported
1224   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
1225          Supported
1226   , Flag "ddump-opt-cmm"           (setDumpFlag Opt_D_dump_opt_cmm)
1227          Supported
1228   , Flag "ddump-simpl-stats"       (setDumpFlag Opt_D_dump_simpl_stats)
1229          Supported
1230   , Flag "ddump-bcos"              (setDumpFlag Opt_D_dump_BCOs)
1231          Supported
1232   , Flag "dsource-stats"           (setDumpFlag Opt_D_source_stats)
1233          Supported
1234   , Flag "dverbose-core2core"      (NoArg setVerboseCore2Core)
1235          Supported
1236   , Flag "dverbose-stg2stg"        (setDumpFlag Opt_D_verbose_stg2stg)
1237          Supported
1238   , Flag "ddump-hi"                (setDumpFlag Opt_D_dump_hi)
1239          Supported
1240   , Flag "ddump-minimal-imports"   (setDumpFlag Opt_D_dump_minimal_imports)
1241          Supported
1242   , Flag "ddump-vect"              (setDumpFlag Opt_D_dump_vect)
1243          Supported
1244   , Flag "ddump-hpc"               (setDumpFlag Opt_D_dump_hpc)
1245          Supported
1246   , Flag "ddump-mod-cycles"        (setDumpFlag Opt_D_dump_mod_cycles)
1247          Supported
1248   , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning)
1249          Supported
1250   , Flag "ddump-to-file"           (setDumpFlag Opt_DumpToFile)
1251          Supported
1252   , Flag "ddump-hi-diffs"          (setDumpFlag Opt_D_dump_hi_diffs)
1253          Supported
1254
1255   , Flag "dcore-lint"              (NoArg (setDynFlag Opt_DoCoreLinting))
1256          Supported
1257   , Flag "dstg-lint"               (NoArg (setDynFlag Opt_DoStgLinting))
1258          Supported
1259   , Flag "dcmm-lint"               (NoArg (setDynFlag Opt_DoCmmLinting))
1260          Supported
1261   , Flag "dasm-lint"               (NoArg (setDynFlag Opt_DoAsmLinting))
1262          Supported
1263   , Flag "dshow-passes"
1264          (NoArg (do setDynFlag Opt_ForceRecomp
1265                     setVerbosity (Just 2)))
1266          Supported
1267   , Flag "dfaststring-stats"       (NoArg (setDynFlag Opt_D_faststring_stats))
1268          Supported
1269
1270         ------ Machine dependant (-m<blah>) stuff ---------------------------
1271
1272   , Flag "monly-2-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
1273          Supported
1274   , Flag "monly-3-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
1275          Supported
1276   , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
1277          Supported
1278
1279      ------ Warning opts -------------------------------------------------
1280   , Flag "W"      (NoArg (mapM_ setDynFlag   minusWOpts))
1281          Supported
1282   , Flag "Werror" (NoArg (setDynFlag         Opt_WarnIsError))
1283          Supported
1284   , Flag "Wwarn"  (NoArg (unSetDynFlag       Opt_WarnIsError))
1285          Supported
1286   , Flag "Wall"   (NoArg (mapM_ setDynFlag   minusWallOpts))
1287          Supported
1288   , Flag "Wnot"   (NoArg (mapM_ unSetDynFlag minusWallOpts))
1289          (Deprecated "Use -w instead")
1290   , Flag "w"      (NoArg (mapM_ unSetDynFlag minuswRemovesOpts))
1291          Supported
1292
1293         ------ Optimisation flags ------------------------------------------
1294   , Flag "O"      (NoArg (upd (setOptLevel 1))) Supported
1295   , Flag "Onot"   (NoArg (upd (setOptLevel 0)))
1296          (Deprecated "Use -O0 instead")
1297   , Flag "Odph"   (NoArg (upd setDPHOpt)) Supported
1298   , Flag "O"      (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
1299          Supported
1300                 -- If the number is missing, use 1
1301
1302   , Flag "fsimplifier-phases"
1303          (IntSuffix (\n -> upd (\dfs -> dfs{ simplPhases = n })))
1304          Supported
1305   , Flag "fmax-simplifier-iterations"
1306          (IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n })))
1307          Supported
1308
1309   , Flag "fspec-constr-threshold"
1310          (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrThreshold = Just n })))
1311          Supported
1312   , Flag "fno-spec-constr-threshold"
1313          (NoArg (upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
1314          Supported
1315   , Flag "fspec-constr-count"
1316          (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrCount = Just n })))
1317          Supported
1318   , Flag "fno-spec-constr-count"
1319          (NoArg (upd (\dfs -> dfs{ specConstrCount = Nothing })))
1320          Supported
1321   , Flag "fliberate-case-threshold"
1322          (IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
1323          Supported
1324   , Flag "fno-liberate-case-threshold"
1325          (NoArg (upd (\dfs -> dfs{ liberateCaseThreshold = Nothing })))
1326          Supported
1327
1328   , Flag "frule-check"
1329          (SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
1330          Supported
1331   , Flag "fcontext-stack"
1332          (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
1333          Supported
1334
1335         ------ DPH flags ----------------------------------------------------
1336
1337   , Flag "fdph-seq"
1338          (NoArg (upd (setDPHBackend DPHSeq)))
1339          Supported
1340   , Flag "fdph-par"
1341          (NoArg (upd (setDPHBackend DPHPar)))
1342          Supported
1343
1344         ------ Compiler flags -----------------------------------------------
1345
1346   , Flag "fasm"             (NoArg (setObjTarget HscAsm)) Supported
1347   , Flag "fvia-c"           (NoArg (setObjTarget HscC)) Supported
1348   , Flag "fvia-C"           (NoArg (setObjTarget HscC)) Supported
1349
1350   , Flag "fno-code"         (NoArg (setTarget HscNothing)) Supported
1351   , Flag "fbyte-code"       (NoArg (setTarget HscInterpreted)) Supported
1352   , Flag "fobject-code"     (NoArg (setTarget defaultHscTarget)) Supported
1353
1354   , Flag "fglasgow-exts"    (NoArg (mapM_ setDynFlag   glasgowExtsFlags))
1355          Supported
1356   , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags))
1357          Supported
1358  ]
1359  ++ map (mkFlag True  "f"    setDynFlag  ) fFlags
1360  ++ map (mkFlag False "fno-" unSetDynFlag) fFlags
1361  ++ map (mkFlag True  "X"    setDynFlag  ) xFlags
1362  ++ map (mkFlag False "XNo"  unSetDynFlag) xFlags
1363
1364 mkFlag :: Bool -- True => turn it on, False => turn it off
1365        -> String
1366        -> (DynFlag -> DynP ())
1367        -> (String, DynFlag, Bool -> Deprecated)
1368        -> Flag DynP
1369 mkFlag turnOn flagPrefix f (name, dynflag, deprecated)
1370     = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn)
1371
1372 deprecatedForLanguage :: String -> Bool -> Deprecated
1373 deprecatedForLanguage lang turnOn =
1374     Deprecated ("Use the " ++ prefix ++ lang ++ " language instead")
1375     where prefix = if turnOn then "" else "No"
1376
1377 -- these -f<blah> flags can all be reversed with -fno-<blah>
1378
1379 fFlags :: [(String, DynFlag, Bool -> Deprecated)]
1380 fFlags = [
1381   ( "warn-dodgy-imports",               Opt_WarnDodgyImports, const Supported ),
1382   ( "warn-duplicate-exports",           Opt_WarnDuplicateExports, const Supported ),
1383   ( "warn-hi-shadowing",                Opt_WarnHiShadows, const Supported ),
1384   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, const Supported ),
1385   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, const Supported ),
1386   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, const Supported ),
1387   ( "warn-missing-fields",              Opt_WarnMissingFields, const Supported ),
1388   ( "warn-missing-methods",             Opt_WarnMissingMethods, const Supported ),
1389   ( "warn-missing-signatures",          Opt_WarnMissingSigs, const Supported ),
1390   ( "warn-name-shadowing",              Opt_WarnNameShadowing, const Supported ),
1391   ( "warn-overlapping-patterns",        Opt_WarnOverlappingPatterns, const Supported ),
1392   ( "warn-simple-patterns",             Opt_WarnSimplePatterns, const Supported ),
1393   ( "warn-type-defaults",               Opt_WarnTypeDefaults, const Supported ),
1394   ( "warn-monomorphism-restriction",    Opt_WarnMonomorphism, const Supported ),
1395   ( "warn-unused-binds",                Opt_WarnUnusedBinds, const Supported ),
1396   ( "warn-unused-imports",              Opt_WarnUnusedImports, const Supported ),
1397   ( "warn-unused-matches",              Opt_WarnUnusedMatches, const Supported ),
1398   ( "warn-deprecations",                Opt_WarnDeprecations, const Supported ),
1399   ( "warn-deprecated-flags",            Opt_WarnDeprecatedFlags, const Supported ),
1400   ( "warn-orphans",                     Opt_WarnOrphans, const Supported ),
1401   ( "warn-tabs",                        Opt_WarnTabs, const Supported ),
1402   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
1403   ( "strictness",                       Opt_Strictness, const Supported ),
1404   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
1405   ( "full-laziness",                    Opt_FullLaziness, const Supported ),
1406   ( "liberate-case",                    Opt_LiberateCase, const Supported ),
1407   ( "spec-constr",                      Opt_SpecConstr, const Supported ),
1408   ( "cse",                              Opt_CSE, const Supported ),
1409   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, const Supported ),
1410   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, const Supported ),
1411   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, const Supported ),
1412   ( "ignore-asserts",                   Opt_IgnoreAsserts, const Supported ),
1413   ( "do-eta-reduction",                 Opt_DoEtaReduction, const Supported ),
1414   ( "case-merge",                       Opt_CaseMerge, const Supported ),
1415   ( "unbox-strict-fields",              Opt_UnboxStrictFields, const Supported ),
1416   ( "method-sharing",                   Opt_MethodSharing, const Supported ),
1417   ( "dicts-cheap",                      Opt_DictsCheap, const Supported ),
1418   ( "excess-precision",                 Opt_ExcessPrecision, const Supported ),
1419   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
1420   ( "print-bind-result",                Opt_PrintBindResult, const Supported ),
1421   ( "force-recomp",                     Opt_ForceRecomp, const Supported ),
1422   ( "hpc-no-auto",                      Opt_Hpc_No_Auto, const Supported ),
1423   ( "rewrite-rules",                    Opt_RewriteRules, const Supported ),
1424   ( "break-on-exception",               Opt_BreakOnException, const Supported ),
1425   ( "break-on-error",                   Opt_BreakOnError, const Supported ),
1426   ( "print-evld-with-show",             Opt_PrintEvldWithShow, const Supported ),
1427   ( "print-bind-contents",              Opt_PrintBindContents, const Supported ),
1428   ( "run-cps",                          Opt_RunCPSZ, const Supported ),
1429   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, const Supported ),
1430   ( "vectorise",                        Opt_Vectorise, const Supported ),
1431   ( "regs-graph",                       Opt_RegsGraph, const Supported ),
1432   ( "regs-iterative",                   Opt_RegsIterative, const Supported ),
1433   ( "th",                               Opt_TemplateHaskell,
1434     deprecatedForLanguage "TemplateHaskell" ),
1435   ( "fi",                               Opt_ForeignFunctionInterface,
1436     deprecatedForLanguage "ForeignFunctionInterface" ),
1437   ( "ffi",                              Opt_ForeignFunctionInterface,
1438     deprecatedForLanguage "ForeignFunctionInterface" ),
1439   ( "arrows",                           Opt_Arrows,
1440     deprecatedForLanguage "Arrows" ),
1441   ( "generics",                         Opt_Generics,
1442     deprecatedForLanguage "Generics" ),
1443   ( "implicit-prelude",                 Opt_ImplicitPrelude,
1444     deprecatedForLanguage "ImplicitPrelude" ),
1445   ( "bang-patterns",                    Opt_BangPatterns,
1446     deprecatedForLanguage "BangPatterns" ),
1447   ( "monomorphism-restriction",         Opt_MonomorphismRestriction,
1448     deprecatedForLanguage "MonomorphismRestriction" ),
1449   ( "mono-pat-binds",                   Opt_MonoPatBinds,
1450     deprecatedForLanguage "MonoPatBinds" ),
1451   ( "extended-default-rules",           Opt_ExtendedDefaultRules,
1452     deprecatedForLanguage "ExtendedDefaultRules" ),
1453   ( "implicit-params",                  Opt_ImplicitParams,
1454     deprecatedForLanguage "ImplicitParams" ),
1455   ( "scoped-type-variables",            Opt_ScopedTypeVariables,
1456     deprecatedForLanguage "ScopedTypeVariables" ),
1457   ( "parr",                             Opt_PArr,
1458     deprecatedForLanguage "PArr" ),
1459   ( "allow-overlapping-instances",      Opt_OverlappingInstances,
1460     deprecatedForLanguage "OverlappingInstances" ),
1461   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
1462     deprecatedForLanguage "UndecidableInstances" ),
1463   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
1464     deprecatedForLanguage "IncoherentInstances" ),
1465   ( "gen-manifest",                     Opt_GenManifest, const Supported ),
1466   ( "embed-manifest",                   Opt_EmbedManifest, const Supported )
1467   ]
1468
1469 supportedLanguages :: [String]
1470 supportedLanguages = [ name | (name, _, _) <- xFlags ]
1471
1472 -- This may contain duplicates
1473 languageOptions :: [DynFlag]
1474 languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
1475
1476 -- These -X<blah> flags can all be reversed with -XNo<blah>
1477 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
1478 xFlags = [
1479   ( "CPP",                              Opt_Cpp, const Supported ),
1480   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
1481   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
1482   ( "MagicHash",                        Opt_MagicHash, const Supported ),
1483   ( "PolymorphicComponents",            Opt_PolymorphicComponents, const Supported ),
1484   ( "ExistentialQuantification",        Opt_ExistentialQuantification, const Supported ),
1485   ( "KindSignatures",                   Opt_KindSignatures, const Supported ),
1486   ( "PatternSignatures",                Opt_PatternSignatures, const Supported ),
1487   ( "EmptyDataDecls",                   Opt_EmptyDataDecls, const Supported ),
1488   ( "ParallelListComp",                 Opt_ParallelListComp, const Supported ),
1489   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
1490   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
1491   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
1492   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
1493   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
1494   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
1495   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, const Supported ),
1496   ( "TypeOperators",                    Opt_TypeOperators, const Supported ),
1497   ( "RecursiveDo",                      Opt_RecursiveDo, const Supported ),
1498   ( "Arrows",                           Opt_Arrows, const Supported ),
1499   ( "PArr",                             Opt_PArr, const Supported ),
1500   ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
1501   ( "QuasiQuotes",                      Opt_QuasiQuotes, const Supported ),
1502   ( "Generics",                         Opt_Generics, const Supported ),
1503   -- On by default:
1504   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, const Supported ),
1505   ( "RecordWildCards",                  Opt_RecordWildCards, const Supported ),
1506   ( "NamedFieldPuns",                   Opt_RecordPuns, const Supported ),
1507   ( "RecordPuns",                       Opt_RecordPuns,
1508     deprecatedForLanguage "NamedFieldPuns" ),
1509   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, const Supported ),
1510   ( "OverloadedStrings",                Opt_OverloadedStrings, const Supported ),
1511   ( "GADTs",                            Opt_GADTs, const Supported ),
1512   ( "ViewPatterns",                     Opt_ViewPatterns, const Supported ),
1513   ( "TypeFamilies",                     Opt_TypeFamilies, const Supported ),
1514   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
1515   -- On by default:
1516   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
1517   -- On by default (which is not strictly H98):
1518   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
1519   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
1520   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
1521   ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
1522   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, const Supported ),
1523   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
1524   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
1525   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
1526   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
1527   ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
1528   ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
1529   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, const Supported ),
1530   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, const Supported ),
1531   ( "FunctionalDependencies",           Opt_FunctionalDependencies, const Supported ),
1532   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, const Supported ),
1533   ( "OverlappingInstances",             Opt_OverlappingInstances, const Supported ),
1534   ( "UndecidableInstances",             Opt_UndecidableInstances, const Supported ),
1535   ( "IncoherentInstances",              Opt_IncoherentInstances, const Supported )
1536   ]
1537
1538 impliedFlags :: [(DynFlag, [DynFlag])]
1539 impliedFlags = [
1540    ( Opt_GADTs,               [Opt_RelaxedPolyRec] )    -- We want type-sig variables to
1541                                                         --      be completely rigid for GADTs
1542  , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] )    -- Ditto for scoped type variables; see
1543                                                         --      Note [Scoped tyvars] in TcBinds
1544   ]
1545
1546 glasgowExtsFlags :: [DynFlag]
1547 glasgowExtsFlags = [
1548              Opt_PrintExplicitForalls
1549            , Opt_ForeignFunctionInterface
1550            , Opt_UnliftedFFITypes
1551            , Opt_GADTs
1552            , Opt_ImplicitParams
1553            , Opt_ScopedTypeVariables
1554            , Opt_UnboxedTuples
1555            , Opt_TypeSynonymInstances
1556            , Opt_StandaloneDeriving
1557            , Opt_DeriveDataTypeable
1558            , Opt_FlexibleContexts
1559            , Opt_FlexibleInstances
1560            , Opt_ConstrainedClassMethods
1561            , Opt_MultiParamTypeClasses
1562            , Opt_FunctionalDependencies
1563            , Opt_MagicHash
1564            , Opt_PolymorphicComponents
1565            , Opt_ExistentialQuantification
1566            , Opt_UnicodeSyntax
1567            , Opt_PatternGuards
1568            , Opt_LiberalTypeSynonyms
1569            , Opt_RankNTypes
1570            , Opt_ImpredicativeTypes
1571            , Opt_TypeOperators
1572            , Opt_RecursiveDo
1573            , Opt_ParallelListComp
1574            , Opt_EmptyDataDecls
1575            , Opt_KindSignatures
1576            , Opt_PatternSignatures
1577            , Opt_GeneralizedNewtypeDeriving
1578            , Opt_TypeFamilies ]
1579
1580 -- -----------------------------------------------------------------------------
1581 -- Parsing the dynamic flags.
1582
1583 parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
1584 parseDynamicFlags dflags args = do
1585   let ((leftover, errs, warns), dflags')
1586           = runCmdLine (processArgs dynamic_flags args) dflags
1587   when (not (null errs)) $ do
1588     throwDyn (UsageError (unlines errs))
1589   return (dflags', leftover, warns)
1590
1591 type DynP = CmdLineP DynFlags
1592
1593 upd :: (DynFlags -> DynFlags) -> DynP ()
1594 upd f = do
1595    dfs <- getCmdLineState
1596    putCmdLineState $! (f dfs)
1597
1598 --------------------------
1599 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
1600 setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps)
1601   where
1602     deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ]
1603         -- When you set f, set the ones it implies
1604         -- When you un-set f, however, we don't un-set the things it implies
1605         --      (except for -fno-glasgow-exts, which is treated specially)
1606
1607 unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
1608
1609 --------------------------
1610 setDumpFlag :: DynFlag -> OptKind DynP
1611 setDumpFlag dump_flag
1612   | force_recomp   = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
1613   | otherwise      = NoArg (setDynFlag dump_flag)
1614   where
1615         -- Whenver we -ddump, switch off the recompilation checker,
1616         -- else you don't see the dump!
1617         -- However, certain dumpy-things are really interested in what's going
1618         -- on during recompilation checking, so in those cases we
1619         -- don't want to turn it off.
1620    force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
1621                                        Opt_D_dump_hi_diffs]
1622
1623 setVerboseCore2Core :: DynP ()
1624 setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
1625                          setDynFlag Opt_D_verbose_core2core
1626                          upd (\s -> s { shouldDumpSimplPhase = const True })
1627
1628 setDumpSimplPhases :: String -> DynP ()
1629 setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp
1630                           upd (\s -> s { shouldDumpSimplPhase = spec })
1631   where
1632     spec :: SimplifierMode -> Bool
1633     spec = join (||)
1634          . map (join (&&) . map match . split ':')
1635          . split ','
1636          $ case s of
1637              '=' : s' -> s'
1638              _        -> s
1639
1640     join :: (Bool -> Bool -> Bool)
1641          -> [SimplifierMode -> Bool]
1642          -> SimplifierMode -> Bool
1643     join _  [] = const True
1644     join op ss = foldr1 (\f g x -> f x `op` g x) ss
1645
1646     match :: String -> SimplifierMode -> Bool
1647     match "" = const True
1648     match s  = case reads s of
1649                 [(n,"")] -> phase_num  n
1650                 _        -> phase_name s
1651
1652     phase_num :: Int -> SimplifierMode -> Bool
1653     phase_num n (SimplPhase k _) = n == k
1654     phase_num _ _                = False
1655
1656     phase_name :: String -> SimplifierMode -> Bool
1657     phase_name s SimplGently       = s == "gentle"
1658     phase_name s (SimplPhase _ ss) = s `elem` ss
1659
1660 setVerbosity :: Maybe Int -> DynP ()
1661 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
1662
1663 addCmdlineHCInclude :: String -> DynP ()
1664 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
1665
1666 extraPkgConf_ :: FilePath -> DynP ()
1667 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
1668
1669 exposePackage, hidePackage, ignorePackage :: String -> DynP ()
1670 exposePackage p =
1671   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
1672 hidePackage p =
1673   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
1674 ignorePackage p =
1675   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
1676
1677 setPackageName :: String -> DynFlags -> DynFlags
1678 setPackageName p
1679   | Nothing <- unpackPackageId pid
1680   = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
1681   | otherwise
1682   = \s -> s{ thisPackage = pid }
1683   where
1684         pid = stringToPackageId p
1685
1686 -- If we're linking a binary, then only targets that produce object
1687 -- code are allowed (requests for other target types are ignored).
1688 setTarget :: HscTarget -> DynP ()
1689 setTarget l = upd set
1690   where
1691    set dfs
1692      | ghcLink dfs /= LinkBinary || isObjectTarget l  = dfs{ hscTarget = l }
1693      | otherwise = dfs
1694
1695 -- Changes the target only if we're compiling object code.  This is
1696 -- used by -fasm and -fvia-C, which switch from one to the other, but
1697 -- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
1698 -- can be safely used in an OPTIONS_GHC pragma.
1699 setObjTarget :: HscTarget -> DynP ()
1700 setObjTarget l = upd set
1701   where
1702    set dfs
1703      | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
1704      | otherwise = dfs
1705
1706 setOptLevel :: Int -> DynFlags -> DynFlags
1707 setOptLevel n dflags
1708    | hscTarget dflags == HscInterpreted && n > 0
1709         = dflags
1710             -- not in IO any more, oh well:
1711             -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
1712    | otherwise
1713         = updOptLevel n dflags
1714
1715
1716 -- -Odph is equivalent to
1717 --
1718 --    -O2                               optimise as much as possible
1719 --    -fno-method-sharing               sharing specialisation defeats fusion
1720 --                                      sometimes
1721 --    -fdicts-cheap                     always inline dictionaries
1722 --    -fmax-simplifier-iterations20     this is necessary sometimes
1723 --    -fno-spec-constr-threshold        run SpecConstr even for big loops
1724 --
1725 setDPHOpt :: DynFlags -> DynFlags
1726 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
1727                                          , specConstrThreshold = Nothing
1728                                          })
1729                    `dopt_set`   Opt_DictsCheap
1730                    `dopt_unset` Opt_MethodSharing
1731
1732 data DPHBackend = DPHPar
1733                 | DPHSeq
1734
1735 setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
1736 setDPHBackend backend dflags = dflags { dphBackend = backend }
1737
1738
1739 setMainIs :: String -> DynP ()
1740 setMainIs arg
1741   | not (null main_fn) && isLower (head main_fn)
1742      -- The arg looked like "Foo.Bar.baz"
1743   = upd $ \d -> d{ mainFunIs = Just main_fn,
1744                    mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
1745
1746   | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
1747   = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
1748
1749   | otherwise                   -- The arg looked like "baz"
1750   = upd $ \d -> d{ mainFunIs = Just arg }
1751   where
1752     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
1753
1754 -----------------------------------------------------------------------------
1755 -- Paths & Libraries
1756
1757 addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
1758
1759 -- -i on its own deletes the import paths
1760 addImportPath "" = upd (\s -> s{importPaths = []})
1761 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
1762
1763
1764 addLibraryPath p =
1765   upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
1766
1767 addIncludePath p =
1768   upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
1769
1770 addFrameworkPath p =
1771   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
1772
1773 #ifndef mingw32_TARGET_OS
1774 split_marker :: Char
1775 split_marker = ':'   -- not configurable (ToDo)
1776 #endif
1777
1778 splitPathList :: String -> [String]
1779 splitPathList s = filter notNull (splitUp s)
1780                 -- empty paths are ignored: there might be a trailing
1781                 -- ':' in the initial list, for example.  Empty paths can
1782                 -- cause confusion when they are translated into -I options
1783                 -- for passing to gcc.
1784   where
1785 #ifndef mingw32_TARGET_OS
1786     splitUp xs = split split_marker xs
1787 #else
1788      -- Windows: 'hybrid' support for DOS-style paths in directory lists.
1789      --
1790      -- That is, if "foo:bar:baz" is used, this interpreted as
1791      -- consisting of three entries, 'foo', 'bar', 'baz'.
1792      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
1793      -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
1794      --
1795      -- Notice that no attempt is made to fully replace the 'standard'
1796      -- split marker ':' with the Windows / DOS one, ';'. The reason being
1797      -- that this will cause too much breakage for users & ':' will
1798      -- work fine even with DOS paths, if you're not insisting on being silly.
1799      -- So, use either.
1800     splitUp []             = []
1801     splitUp (x:':':div:xs) | div `elem` dir_markers
1802                            = ((x:':':div:p): splitUp rs)
1803                            where
1804                               (p,rs) = findNextPath xs
1805           -- we used to check for existence of the path here, but that
1806           -- required the IO monad to be threaded through the command-line
1807           -- parser which is quite inconvenient.  The
1808     splitUp xs = cons p (splitUp rs)
1809                where
1810                  (p,rs) = findNextPath xs
1811
1812                  cons "" xs = xs
1813                  cons x  xs = x:xs
1814
1815     -- will be called either when we've consumed nought or the
1816     -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
1817     -- finding the next split marker.
1818     findNextPath xs =
1819         case break (`elem` split_markers) xs of
1820            (p, _:ds) -> (p, ds)
1821            (p, xs)   -> (p, xs)
1822
1823     split_markers :: [Char]
1824     split_markers = [':', ';']
1825
1826     dir_markers :: [Char]
1827     dir_markers = ['/', '\\']
1828 #endif
1829
1830 -- -----------------------------------------------------------------------------
1831 -- tmpDir, where we store temporary files.
1832
1833 setTmpDir :: FilePath -> DynFlags -> DynFlags
1834 setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
1835   -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
1836   -- seem necessary now --SDM 7/2/2008
1837
1838 -----------------------------------------------------------------------------
1839 -- Hpc stuff
1840
1841 setOptHpcDir :: String -> DynP ()
1842 setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
1843
1844 -----------------------------------------------------------------------------
1845 -- Via-C compilation stuff
1846
1847 -- There are some options that we need to pass to gcc when compiling
1848 -- Haskell code via C, but are only supported by recent versions of
1849 -- gcc.  The configure script decides which of these options we need,
1850 -- and puts them in the file "extra-gcc-opts" in $topdir, which is
1851 -- read before each via-C compilation.  The advantage of having these
1852 -- in a separate file is that the file can be created at install-time
1853 -- depending on the available gcc version, and even re-generated  later
1854 -- if gcc is upgraded.
1855 --
1856 -- The options below are not dependent on the version of gcc, only the
1857 -- platform.
1858
1859 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
1860                               [String]) -- for registerised HC compilations
1861 machdepCCOpts _dflags
1862 #if alpha_TARGET_ARCH
1863         =       ( ["-w", "-mieee"
1864 #ifdef HAVE_THREADED_RTS_SUPPORT
1865                     , "-D_REENTRANT"
1866 #endif
1867                    ], [] )
1868         -- For now, to suppress the gcc warning "call-clobbered
1869         -- register used for global register variable", we simply
1870         -- disable all warnings altogether using the -w flag. Oh well.
1871
1872 #elif hppa_TARGET_ARCH
1873         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
1874         -- (very nice, but too bad the HP /usr/include files don't agree.)
1875         = ( ["-D_HPUX_SOURCE"], [] )
1876
1877 #elif m68k_TARGET_ARCH
1878       -- -fno-defer-pop : for the .hc files, we want all the pushing/
1879       --    popping of args to routines to be explicit; if we let things
1880       --    be deferred 'til after an STGJUMP, imminent death is certain!
1881       --
1882       -- -fomit-frame-pointer : *don't*
1883       --     It's better to have a6 completely tied up being a frame pointer
1884       --     rather than let GCC pick random things to do with it.
1885       --     (If we want to steal a6, then we would try to do things
1886       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
1887         = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
1888
1889 #elif i386_TARGET_ARCH
1890       -- -fno-defer-pop : basically the same game as for m68k
1891       --
1892       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
1893       --   the fp (%ebp) for our register maps.
1894         =  let n_regs = stolen_x86_regs _dflags
1895                sta = opt_Static
1896            in
1897                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
1898 --                    , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else ""
1899                       ],
1900                       [ "-fno-defer-pop",
1901                         "-fomit-frame-pointer",
1902                         -- we want -fno-builtin, because when gcc inlines
1903                         -- built-in functions like memcpy() it tends to
1904                         -- run out of registers, requiring -monly-n-regs
1905                         "-fno-builtin",
1906                         "-DSTOLEN_X86_REGS="++show n_regs ]
1907                     )
1908
1909 #elif ia64_TARGET_ARCH
1910         = ( [], ["-fomit-frame-pointer", "-G0"] )
1911
1912 #elif x86_64_TARGET_ARCH
1913         = ( [], ["-fomit-frame-pointer",
1914                  "-fno-asynchronous-unwind-tables",
1915                         -- the unwind tables are unnecessary for HC code,
1916                         -- and get in the way of -split-objs.  Another option
1917                         -- would be to throw them away in the mangler, but this
1918                         -- is easier.
1919                  "-fno-builtin"
1920                         -- calling builtins like strlen() using the FFI can
1921                         -- cause gcc to run out of regs, so use the external
1922                         -- version.
1923                 ] )
1924
1925 #elif sparc_TARGET_ARCH
1926         = ( [], ["-w"] )
1927         -- For now, to suppress the gcc warning "call-clobbered
1928         -- register used for global register variable", we simply
1929         -- disable all warnings altogether using the -w flag. Oh well.
1930
1931 #elif powerpc_apple_darwin_TARGET
1932       -- -no-cpp-precomp:
1933       --     Disable Apple's precompiling preprocessor. It's a great thing
1934       --     for "normal" programs, but it doesn't support register variable
1935       --     declarations.
1936         = ( [], ["-no-cpp-precomp"] )
1937 #else
1938         = ( [], [] )
1939 #endif
1940
1941 picCCOpts :: DynFlags -> [String]
1942 picCCOpts _dflags
1943 #if darwin_TARGET_OS
1944       -- Apple prefers to do things the other way round.
1945       -- PIC is on by default.
1946       -- -mdynamic-no-pic:
1947       --     Turn off PIC code generation.
1948       -- -fno-common:
1949       --     Don't generate "common" symbols - these are unwanted
1950       --     in dynamic libraries.
1951
1952     | opt_PIC
1953         = ["-fno-common", "-D__PIC__"]
1954     | otherwise
1955         = ["-mdynamic-no-pic"]
1956 #elif mingw32_TARGET_OS
1957       -- no -fPIC for Windows
1958     | opt_PIC
1959         = ["-D__PIC__"]
1960     | otherwise
1961         = []
1962 #else
1963     | opt_PIC
1964         = ["-fPIC", "-D__PIC__"]
1965     | otherwise
1966         = []
1967 #endif
1968
1969 -- -----------------------------------------------------------------------------
1970 -- Splitting
1971
1972 can_split :: Bool
1973 can_split = cSplitObjs == "YES"
1974
1975 -- -----------------------------------------------------------------------------
1976 -- Compiler Info
1977
1978 compilerInfo :: [(String, String)]
1979 compilerInfo = [("Project name",                cProjectName),
1980                 ("Project version",             cProjectVersion),
1981                 ("Booter version",              cBooterVersion),
1982                 ("Stage",                       cStage),
1983                 ("Interface file version",      cHscIfaceFileVersion),
1984                 ("Have interpreter",            cGhcWithInterpreter),
1985                 ("Object splitting",            cSplitObjs),
1986                 ("Have native code generator",  cGhcWithNativeCodeGen),
1987                 ("Support SMP",                 cGhcWithSMP),
1988                 ("Unregisterised",              cGhcUnregisterised),
1989                 ("Tables next to code",         cGhcEnableTablesNextToCode),
1990                 ("Win32 DLLs",                  cEnableWin32DLLs),
1991                 ("RTS ways",                    cGhcRTSWays),
1992                 ("Leading underscore",          cLeadingUnderscore),
1993                 ("Debug on",                    show debugIsOn)
1994                ]
1995