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