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