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