compiler/main/DynFlags.hs

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