compiler/main/DynFlags.hs

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