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