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