compiler/main/DynFlags.hs

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