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