compiler/main/DynFlags.hs

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