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