compiler/main/DynFlags.hs

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