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