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