compiler/main/DynFlags.hs

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