compiler/main/DynFlags.hs

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