compiler/main/DynFlags.hs

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