compiler/main/DynFlags.hs

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