compiler/main/DynFlags.hs

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