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_ReadUserPackageConf
 279    | Opt_NoHsMain
 280    | Opt_SplitObjs
 281    | Opt_StgStats
 282    | Opt_HideAllPackages
 283    | Opt_PrintBindResult
 284    | Opt_Haddock
 285    | Opt_HaddockOptions
 286    | Opt_Hpc_No_Auto
 287    | Opt_BreakOnException
 288    | Opt_BreakOnError
 289    | Opt_PrintEvldWithShow
 290    | Opt_PrintBindContents
 291    | Opt_GenManifest
 292    | Opt_EmbedManifest
 293    | Opt_RunCPSZ
 294    | Opt_ConvertToZipCfgAndBack
 295    | Opt_AutoLinkPackages
 296    | Opt_ImplicitImportQualified
 297
 298    -- keeping stuff
 299    | Opt_KeepHiDiffs
 300    | Opt_KeepHcFiles
 301    | Opt_KeepSFiles
 302    | Opt_KeepRawSFiles
 303    | Opt_KeepTmpFiles
 304    | Opt_KeepRawTokenStream
 305
 306    deriving (Eq, Show)
 307
 308 -- | Contains not only a collection of 'DynFlag's but also a plethora of
 309 -- information relating to the compilation of a single file or GHC session
 310 data DynFlags = DynFlags {
 311   ghcMode               :: GhcMode,
 312   ghcLink               :: GhcLink,
 313   coreToDo              :: Maybe [CoreToDo], -- reserved for -Ofile
 314   stgToDo               :: Maybe [StgToDo],  -- similarly
 315   hscTarget             :: HscTarget,
 316   hscOutName            :: String,      -- ^ Name of the output file
 317   extCoreName           :: String,      -- ^ Name of the .hcr output file
 318   verbosity             :: Int,         -- ^ Verbosity level: see "DynFlags#verbosity_levels"
 319   optLevel              :: Int,         -- ^ Optimisation level
 320   simplPhases           :: Int,         -- ^ Number of simplifier phases
 321   maxSimplIterations    :: Int,         -- ^ Max simplifier iterations
 322   shouldDumpSimplPhase  :: SimplifierMode -> Bool,
 323   ruleCheck             :: Maybe String,
 324
 325   specConstrThreshold   :: Maybe Int,   -- ^ Threshold for SpecConstr
 326   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
 327   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
 328
 329   stolen_x86_regs       :: Int,
 330   cmdlineHcIncludes     :: [String],    -- ^ @\-\#includes@
 331   importPaths           :: [FilePath],
 332   mainModIs             :: Module,
 333   mainFunIs             :: Maybe String,
 334   ctxtStkDepth          :: Int,         -- ^ Typechecker context stack depth
 335
 336   dphBackend            :: DPHBackend,
 337
 338   thisPackage           :: PackageId,   -- ^ name of package currently being compiled
 339
 340   -- ways
 341   wayNames              :: [WayName],   -- ^ Way flags from the command line
 342   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
 343   rtsBuildTag           :: String,      -- ^ The RTS \"way\"
 344
 345   -- paths etc.
 346   objectDir             :: Maybe String,
 347   hiDir                 :: Maybe String,
 348   stubDir               :: Maybe String,
 349
 350   objectSuf             :: String,
 351   hcSuf                 :: String,
 352   hiSuf                 :: String,
 353
 354   outputFile            :: Maybe String,
 355   outputHi              :: Maybe String,
 356   dynLibLoader          :: DynLibLoader,
 357
 358   -- | This is set by 'DriverPipeline.runPipeline' based on where
 359   --    its output is going.
 360   dumpPrefix            :: Maybe FilePath,
 361
 362   -- | Override the 'dumpPrefix' set by 'DriverPipeline.runPipeline'.
 363   --    Set by @-ddump-file-prefix@
 364   dumpPrefixForce       :: Maybe FilePath,
 365
 366   includePaths          :: [String],
 367   libraryPaths          :: [String],
 368   frameworkPaths        :: [String],    -- used on darwin only
 369   cmdlineFrameworks     :: [String],    -- ditto
 370   tmpDir                :: String,      -- no trailing '/'
 371
 372   ghcUsagePath          :: FilePath,    -- Filled in by SysTools
 373   ghciUsagePath         :: FilePath,    -- ditto
 374
 375   hpcDir                :: String,      -- ^ Path to store the .mix files
 376
 377   -- options for particular phases
 378   opt_L                 :: [String],
 379   opt_P                 :: [String],
 380   opt_F                 :: [String],
 381   opt_c                 :: [String],
 382   opt_m                 :: [String],
 383   opt_a                 :: [String],
 384   opt_l                 :: [String],
 385   opt_windres           :: [String],
 386
 387   -- commands for particular phases
 388   pgm_L                 :: String,
 389   pgm_P                 :: (String,[Option]),
 390   pgm_F                 :: String,
 391   pgm_c                 :: (String,[Option]),
 392   pgm_m                 :: (String,[Option]),
 393   pgm_s                 :: (String,[Option]),
 394   pgm_a                 :: (String,[Option]),
 395   pgm_l                 :: (String,[Option]),
 396   pgm_dll               :: (String,[Option]),
 397   pgm_T                 :: String,
 398   pgm_sysman            :: String,
 399   pgm_windres           :: String,
 400
 401   --  For ghc -M
 402   depMakefile           :: FilePath,
 403   depIncludePkgDeps     :: Bool,
 404   depExcludeMods        :: [ModuleName],
 405   depSuffixes           :: [String],
 406   depWarnings           :: Bool,
 407
 408   --  Package flags
 409   extraPkgConfs         :: [FilePath],
 410   topDir                :: FilePath,    -- filled in by SysTools
 411   systemPackageConfig   :: FilePath,    -- ditto
 412         -- ^ The @-package-conf@ flags given on the command line, in the order
 413         -- they appeared.
 414
 415   packageFlags          :: [PackageFlag],
 416         -- ^ The @-package@ and @-hide-package@ flags from the command-line
 417
 418   -- Package state
 419   -- NB. do not modify this field, it is calculated by
 420   -- Packages.initPackages and Packages.updatePackages.
 421   pkgDatabase           :: Maybe (UniqFM PackageConfig),
 422   pkgState              :: PackageState,
 423
 424   -- hsc dynamic flags
 425   flags                 :: [DynFlag],
 426
 427   -- | Message output action: use "ErrUtils" instead of this if you can
 428   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO (),
 429
 430   haddockOptions :: Maybe String
 431  }
 432
 433 -- | The target code type of the compilation (if any).
 434 --
 435 -- 'HscNothing' can be used to avoid generating any output, however, note
 436 -- that:
 437 --
 438 --  * This will not run the desugaring step, thus no warnings generated in
 439 --    this step will be output.  In particular, this includes warnings
 440 --    related to pattern matching.
 441 --
 442 --  * At the moment switching from 'HscNothing' to 'HscInterpreted' without
 443 --    unloading first is not safe.  To unload use
 444 --    @GHC.setTargets [] >> GHC.load LoadAllTargets@.
 445 --
 446 data HscTarget
 447   = HscC
 448   | HscAsm
 449   | HscJava
 450   | HscInterpreted
 451   | HscNothing
 452   deriving (Eq, Show)
 453
 454 -- | Will this target result in an object file on the disk?
 455 isObjectTarget :: HscTarget -> Bool
 456 isObjectTarget HscC     = True
 457 isObjectTarget HscAsm   = True
 458 isObjectTarget _        = False
 459
 460 -- | The 'GhcMode' tells us whether we're doing multi-module
 461 -- compilation (controlled via the "GHC" API) or one-shot
 462 -- (single-module) compilation.  This makes a difference primarily to
 463 -- the "Finder": in one-shot mode we look for interface files for
 464 -- imported modules, but in multi-module mode we look for source files
 465 -- in order to check whether they need to be recompiled.
 466 data GhcMode
 467   = CompManager         -- ^ @\-\-make@, GHCi, etc.
 468   | OneShot             -- ^ @ghc -c Foo.hs@
 469   | MkDepend            -- ^ @ghc -M@, see "Finder" for why we need this
 470   deriving Eq
 471
 472 instance Outputable GhcMode where
 473   ppr CompManager = ptext (sLit "CompManager")
 474   ppr OneShot     = ptext (sLit "OneShot")
 475   ppr MkDepend    = ptext (sLit "MkDepend")
 476
 477 isOneShot :: GhcMode -> Bool
 478 isOneShot OneShot = True
 479 isOneShot _other  = False
 480
 481 -- | What to do in the link step, if there is one.
 482 data GhcLink
 483   = NoLink              -- ^ Don't link at all
 484   | LinkBinary          -- ^ Link object code into a binary
 485   | LinkInMemory        -- ^ Use the in-memory dynamic linker
 486   | LinkDynLib          -- ^ Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms)
 487   deriving (Eq, Show)
 488
 489 isNoLink :: GhcLink -> Bool
 490 isNoLink NoLink = True
 491 isNoLink _      = False
 492
 493 data PackageFlag
 494   = ExposePackage  String
 495   | HidePackage    String
 496   | IgnorePackage  String
 497   deriving Eq
 498
 499 defaultHscTarget :: HscTarget
 500 defaultHscTarget = defaultObjectTarget
 501
 502 -- | The 'HscTarget' value corresponding to the default way to create
 503 -- object files on the current platform.
 504 defaultObjectTarget :: HscTarget
 505 defaultObjectTarget
 506   | cGhcWithNativeCodeGen == "YES"      =  HscAsm
 507   | otherwise                           =  HscC
 508
 509 data DynLibLoader
 510   = Deployable
 511   | Wrapped (Maybe String)
 512   | SystemDependent
 513   deriving Eq
 514
 515 -- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
 516 initDynFlags :: DynFlags -> IO DynFlags
 517 initDynFlags dflags = do
 518  -- someday these will be dynamic flags
 519  ways <- readIORef v_Ways
 520  build_tag <- readIORef v_Build_tag
 521  rts_build_tag <- readIORef v_RTS_Build_tag
 522  return dflags{
 523         wayNames        = ways,
 524         buildTag        = build_tag,
 525         rtsBuildTag     = rts_build_tag
 526         }
 527
 528 -- | The normal 'DynFlags'. Note that they is not suitable for use in this form
 529 -- and must be fully initialized by 'GHC.newSession' first.
 530 defaultDynFlags :: DynFlags
 531 defaultDynFlags =
 532      DynFlags {
 533         ghcMode                 = CompManager,
 534         ghcLink                 = LinkBinary,
 535         coreToDo                = Nothing,
 536         stgToDo                 = Nothing,
 537         hscTarget               = defaultHscTarget,
 538         hscOutName              = "",
 539         extCoreName             = "",
 540         verbosity               = 0,
 541         optLevel                = 0,
 542         simplPhases             = 2,
 543         maxSimplIterations      = 4,
 544         shouldDumpSimplPhase    = const False,
 545         ruleCheck               = Nothing,
 546         specConstrThreshold     = Just 200,
 547         specConstrCount         = Just 3,
 548         liberateCaseThreshold   = Just 200,
 549         stolen_x86_regs         = 4,
 550         cmdlineHcIncludes       = [],
 551         importPaths             = ["."],
 552         mainModIs               = mAIN,
 553         mainFunIs               = Nothing,
 554         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 555
 556         dphBackend              = DPHPar,
 557
 558         thisPackage             = mainPackageId,
 559
 560         objectDir               = Nothing,
 561         hiDir                   = Nothing,
 562         stubDir                 = Nothing,
 563
 564         objectSuf               = phaseInputExt StopLn,
 565         hcSuf                   = phaseInputExt HCc,
 566         hiSuf                   = "hi",
 567
 568         outputFile              = Nothing,
 569         outputHi                = Nothing,
 570         dynLibLoader            = Deployable,
 571         dumpPrefix              = Nothing,
 572         dumpPrefixForce         = Nothing,
 573         includePaths            = [],
 574         libraryPaths            = [],
 575         frameworkPaths          = [],
 576         cmdlineFrameworks       = [],
 577         tmpDir                  = cDEFAULT_TMPDIR,
 578
 579         hpcDir                  = ".hpc",
 580
 581         opt_L                   = [],
 582         opt_P                   = (if opt_PIC
 583                                    then ["-D__PIC__", "-U __PIC__"] -- this list is reversed
 584                                    else []),
 585         opt_F                   = [],
 586         opt_c                   = [],
 587         opt_a                   = [],
 588         opt_m                   = [],
 589         opt_l                   = [],
 590         opt_windres             = [],
 591
 592         extraPkgConfs           = [],
 593         packageFlags            = [],
 594         pkgDatabase             = Nothing,
 595         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
 596         wayNames                = panic "defaultDynFlags: No wayNames",
 597         buildTag                = panic "defaultDynFlags: No buildTag",
 598         rtsBuildTag             = panic "defaultDynFlags: No rtsBuildTag",
 599         -- initSysTools fills all these in
 600         ghcUsagePath            = panic "defaultDynFlags: No ghciUsagePath",
 601         ghciUsagePath           = panic "defaultDynFlags: No ghciUsagePath",
 602         topDir                  = panic "defaultDynFlags: No topDir",
 603         systemPackageConfig     = panic  "no systemPackageConfig: call GHC.setSessionDynFlags",
 604         pgm_L                   = panic "defaultDynFlags: No pgm_L",
 605         pgm_P                   = panic "defaultDynFlags: No pgm_P",
 606         pgm_F                   = panic "defaultDynFlags: No pgm_F",
 607         pgm_c                   = panic "defaultDynFlags: No pgm_c",
 608         pgm_m                   = panic "defaultDynFlags: No pgm_m",
 609         pgm_s                   = panic "defaultDynFlags: No pgm_s",
 610         pgm_a                   = panic "defaultDynFlags: No pgm_a",
 611         pgm_l                   = panic "defaultDynFlags: No pgm_l",
 612         pgm_dll                 = panic "defaultDynFlags: No pgm_dll",
 613         pgm_T                   = panic "defaultDynFlags: No pgm_T",
 614         pgm_sysman              = panic "defaultDynFlags: No pgm_sysman",
 615         pgm_windres             = panic "defaultDynFlags: No pgm_windres",
 616         -- end of initSysTools values
 617         -- ghc -M values
 618         depMakefile       = "Makefile",
 619         depIncludePkgDeps = False,
 620         depExcludeMods    = [],
 621         depSuffixes       = [],
 622         depWarnings       = True,
 623         -- end of ghc -M values
 624         haddockOptions = Nothing,
 625         flags = [
 626             Opt_AutoLinkPackages,
 627             Opt_ReadUserPackageConf,
 628
 629             Opt_MonoPatBinds,   -- Experimentally, I'm making this non-standard
 630                                 -- behaviour the default, to see if anyone notices
 631                                 -- SLPJ July 06
 632
 633             Opt_ImplicitPrelude,
 634             Opt_MonomorphismRestriction,
 635
 636             Opt_MethodSharing,
 637
 638             Opt_DoAsmMangling,
 639
 640             Opt_GenManifest,
 641             Opt_EmbedManifest,
 642             Opt_PrintBindContents
 643             ]
 644             ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
 645                     -- The default -O0 options
 646             ++ standardWarnings,
 647
 648         log_action = \severity srcSpan style msg ->
 649                         case severity of
 650                           SevInfo  -> printErrs (msg style)
 651                           SevFatal -> printErrs (msg style)
 652                           _        -> do
 653                                 hPutChar stderr '\n'
 654                                 printErrs ((mkLocMessage srcSpan msg) style)
 655                      -- careful (#2302): printErrs prints in UTF-8, whereas
 656                      -- converting to string first and using hPutStr would
 657                      -- just emit the low 8 bits of each unicode char.
 658       }
 659
 660 {-
 661     #verbosity_levels#
 662     Verbosity levels:
 663
 664     0   |   print errors & warnings only
 665     1   |   minimal verbosity: print "compiling M ... done." for each module.
 666     2   |   equivalent to -dshow-passes
 667     3   |   equivalent to existing "ghc -v"
 668     4   |   "ghc -v -ddump-most"
 669     5   |   "ghc -v -ddump-all"
 670 -}
 671
 672 -- | Test whether a 'DynFlag' is set
 673 dopt :: DynFlag -> DynFlags -> Bool
 674 dopt f dflags  = f `elem` (flags dflags)
 675
 676 -- | Set a 'DynFlag'
 677 dopt_set :: DynFlags -> DynFlag -> DynFlags
 678 dopt_set dfs f = dfs{ flags = f : flags dfs }
 679
 680 -- | Unset a 'DynFlag'
 681 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 682 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 683
 684 -- | Retrieve the options corresponding to a particular @opt_*@ field in the correct order
 685 getOpts :: DynFlags             -- ^ 'DynFlags' to retrieve the options from
 686         -> (DynFlags -> [a])    -- ^ Relevant record accessor: one of the @opt_*@ accessors
 687         -> [a]                  -- ^ Correctly ordered extracted options
 688 getOpts dflags opts = reverse (opts dflags)
 689         -- We add to the options from the front, so we need to reverse the list
 690
 691 -- | Gets the verbosity flag for the current verbosity level. This is fed to
 692 -- other tools, so GHC-specific verbosity flags like @-ddump-most@ are not included
 693 getVerbFlag :: DynFlags -> String
 694 getVerbFlag dflags
 695   | verbosity dflags >= 3  = "-v"
 696   | otherwise =  ""
 697
 698 setObjectDir, setHiDir, setStubDir, setOutputDir,
 699          setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
 700          setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
 701          addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
 702          addCmdlineFramework, addHaddockOpts
 703    :: String -> DynFlags -> DynFlags
 704 setOutputFile, setOutputHi, setDumpPrefixForce
 705    :: Maybe String -> DynFlags -> DynFlags
 706
 707 setObjectDir  f d = d{ objectDir  = Just f}
 708 setHiDir      f d = d{ hiDir      = Just f}
 709 setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
 710   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
 711   -- \#included from the .hc file when compiling with -fvia-C.
 712 setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
 713
 714 setObjectSuf  f d = d{ objectSuf  = f}
 715 setHiSuf      f d = d{ hiSuf      = f}
 716 setHcSuf      f d = d{ hcSuf      = f}
 717
 718 setOutputFile f d = d{ outputFile = f}
 719 setOutputHi   f d = d{ outputHi   = f}
 720
 721 parseDynLibLoaderMode f d =
 722  case splitAt 8 f of
 723    ("deploy", "")       -> d{ dynLibLoader = Deployable }
 724    ("sysdep", "")       -> d{ dynLibLoader = SystemDependent }
 725    ("wrapped", "")      -> d{ dynLibLoader = Wrapped Nothing }
 726    ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing }
 727    ("wrapped:", flex)   -> d{ dynLibLoader = Wrapped (Just flex) }
 728    _                    -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f))
 729
 730 setDumpPrefixForce f d = d { dumpPrefixForce = f}
 731
 732 -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
 733 -- Config.hs should really use Option.
 734 setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
 735
 736 setPgmL   f d = d{ pgm_L   = f}
 737 setPgmF   f d = d{ pgm_F   = f}
 738 setPgmc   f d = d{ pgm_c   = (f,[])}
 739 setPgmm   f d = d{ pgm_m   = (f,[])}
 740 setPgms   f d = d{ pgm_s   = (f,[])}
 741 setPgma   f d = d{ pgm_a   = (f,[])}
 742 setPgml   f d = d{ pgm_l   = (f,[])}
 743 setPgmdll f d = d{ pgm_dll = (f,[])}
 744 setPgmwindres f d = d{ pgm_windres = f}
 745
 746 addOptL   f d = d{ opt_L   = f : opt_L d}
 747 addOptP   f d = d{ opt_P   = f : opt_P d}
 748 addOptF   f d = d{ opt_F   = f : opt_F d}
 749 addOptc   f d = d{ opt_c   = f : opt_c d}
 750 addOptm   f d = d{ opt_m   = f : opt_m d}
 751 addOpta   f d = d{ opt_a   = f : opt_a d}
 752 addOptl   f d = d{ opt_l   = f : opt_l d}
 753 addOptwindres f d = d{ opt_windres = f : opt_windres d}
 754
 755 setDepMakefile :: FilePath -> DynFlags -> DynFlags
 756 setDepMakefile f d = d { depMakefile = deOptDep f }
 757
 758 setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
 759 setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
 760
 761 addDepExcludeMod :: String -> DynFlags -> DynFlags
 762 addDepExcludeMod m d
 763     = d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
 764
 765 addDepSuffix :: FilePath -> DynFlags -> DynFlags
 766 addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
 767
 768 setDepWarnings :: Bool -> DynFlags -> DynFlags
 769 setDepWarnings b d = d { depWarnings = b }
 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  (upd (setDepWarnings False)))
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   ( "asm-mangling",                     Opt_DoAsmMangling, const Supported ),
1591   ( "print-bind-result",                Opt_PrintBindResult, const Supported ),
1592   ( "force-recomp",                     Opt_ForceRecomp, const Supported ),
1593   ( "hpc-no-auto",                      Opt_Hpc_No_Auto, const Supported ),
1594   ( "rewrite-rules",                    Opt_EnableRewriteRules, useInstead "enable-rewrite-rules" ),
1595   ( "enable-rewrite-rules",             Opt_EnableRewriteRules, const Supported ),
1596   ( "break-on-exception",               Opt_BreakOnException, const Supported ),
1597   ( "break-on-error",                   Opt_BreakOnError, const Supported ),
1598   ( "print-evld-with-show",             Opt_PrintEvldWithShow, const Supported ),
1599   ( "print-bind-contents",              Opt_PrintBindContents, const Supported ),
1600   ( "run-cps",                          Opt_RunCPSZ, const Supported ),
1601   ( "convert-to-zipper-and-back",       Opt_ConvertToZipCfgAndBack, const Supported ),
1602   ( "vectorise",                        Opt_Vectorise, const Supported ),
1603   ( "regs-graph",                       Opt_RegsGraph, const Supported ),
1604   ( "regs-iterative",                   Opt_RegsIterative, const Supported ),
1605   ( "th",                               Opt_TemplateHaskell,
1606     deprecatedForLanguage "TemplateHaskell" ),
1607   ( "fi",                               Opt_ForeignFunctionInterface,
1608     deprecatedForLanguage "ForeignFunctionInterface" ),
1609   ( "ffi",                              Opt_ForeignFunctionInterface,
1610     deprecatedForLanguage "ForeignFunctionInterface" ),
1611   ( "arrows",                           Opt_Arrows,
1612     deprecatedForLanguage "Arrows" ),
1613   ( "generics",                         Opt_Generics,
1614     deprecatedForLanguage "Generics" ),
1615   ( "implicit-prelude",                 Opt_ImplicitPrelude,
1616     deprecatedForLanguage "ImplicitPrelude" ),
1617   ( "bang-patterns",                    Opt_BangPatterns,
1618     deprecatedForLanguage "BangPatterns" ),
1619   ( "monomorphism-restriction",         Opt_MonomorphismRestriction,
1620     deprecatedForLanguage "MonomorphismRestriction" ),
1621   ( "mono-pat-binds",                   Opt_MonoPatBinds,
1622     deprecatedForLanguage "MonoPatBinds" ),
1623   ( "extended-default-rules",           Opt_ExtendedDefaultRules,
1624     deprecatedForLanguage "ExtendedDefaultRules" ),
1625   ( "implicit-params",                  Opt_ImplicitParams,
1626     deprecatedForLanguage "ImplicitParams" ),
1627   ( "scoped-type-variables",            Opt_ScopedTypeVariables,
1628     deprecatedForLanguage "ScopedTypeVariables" ),
1629   ( "parr",                             Opt_PArr,
1630     deprecatedForLanguage "PArr" ),
1631   ( "allow-overlapping-instances",      Opt_OverlappingInstances,
1632     deprecatedForLanguage "OverlappingInstances" ),
1633   ( "allow-undecidable-instances",      Opt_UndecidableInstances,
1634     deprecatedForLanguage "UndecidableInstances" ),
1635   ( "allow-incoherent-instances",       Opt_IncoherentInstances,
1636     deprecatedForLanguage "IncoherentInstances" ),
1637   ( "gen-manifest",                     Opt_GenManifest, const Supported ),
1638   ( "embed-manifest",                   Opt_EmbedManifest, const Supported ),
1639   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, const Supported )
1640   ]
1641
1642 supportedLanguages :: [String]
1643 supportedLanguages = [ name | (name, _, _) <- xFlags ]
1644
1645 -- This may contain duplicates
1646 languageOptions :: [DynFlag]
1647 languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ]
1648
1649 -- | These -X<blah> flags can all be reversed with -XNo<blah>
1650 xFlags :: [(String, DynFlag, Bool -> Deprecated)]
1651 xFlags = [
1652   ( "CPP",                              Opt_Cpp, const Supported ),
1653   ( "PostfixOperators",                 Opt_PostfixOperators, const Supported ),
1654   ( "PatternGuards",                    Opt_PatternGuards, const Supported ),
1655   ( "UnicodeSyntax",                    Opt_UnicodeSyntax, const Supported ),
1656   ( "MagicHash",                        Opt_MagicHash, const Supported ),
1657   ( "PolymorphicComponents",            Opt_PolymorphicComponents, const Supported ),
1658   ( "ExistentialQuantification",        Opt_ExistentialQuantification, const Supported ),
1659   ( "KindSignatures",                   Opt_KindSignatures, const Supported ),
1660   ( "EmptyDataDecls",                   Opt_EmptyDataDecls, const Supported ),
1661   ( "ParallelListComp",                 Opt_ParallelListComp, const Supported ),
1662   ( "TransformListComp",                Opt_TransformListComp, const Supported ),
1663   ( "ForeignFunctionInterface",         Opt_ForeignFunctionInterface, const Supported ),
1664   ( "UnliftedFFITypes",                 Opt_UnliftedFFITypes, const Supported ),
1665   ( "LiberalTypeSynonyms",              Opt_LiberalTypeSynonyms, const Supported ),
1666   ( "Rank2Types",                       Opt_Rank2Types, const Supported ),
1667   ( "RankNTypes",                       Opt_RankNTypes, const Supported ),
1668   ( "ImpredicativeTypes",               Opt_ImpredicativeTypes, const Supported ),
1669   ( "TypeOperators",                    Opt_TypeOperators, const Supported ),
1670   ( "RecursiveDo",                      Opt_RecursiveDo, const Supported ),
1671   ( "Arrows",                           Opt_Arrows, const Supported ),
1672   ( "PArr",                             Opt_PArr, const Supported ),
1673   ( "TemplateHaskell",                  Opt_TemplateHaskell, const Supported ),
1674   ( "QuasiQuotes",                      Opt_QuasiQuotes, const Supported ),
1675   ( "Generics",                         Opt_Generics, const Supported ),
1676   -- On by default:
1677   ( "ImplicitPrelude",                  Opt_ImplicitPrelude, const Supported ),
1678   ( "RecordWildCards",                  Opt_RecordWildCards, const Supported ),
1679   ( "NamedFieldPuns",                   Opt_RecordPuns, const Supported ),
1680   ( "RecordPuns",                       Opt_RecordPuns,
1681     deprecatedForLanguage "NamedFieldPuns" ),
1682   ( "DisambiguateRecordFields",         Opt_DisambiguateRecordFields, const Supported ),
1683   ( "OverloadedStrings",                Opt_OverloadedStrings, const Supported ),
1684   ( "GADTs",                            Opt_GADTs, const Supported ),
1685   ( "ViewPatterns",                     Opt_ViewPatterns, const Supported ),
1686   ( "TypeFamilies",                     Opt_TypeFamilies, const Supported ),
1687   ( "BangPatterns",                     Opt_BangPatterns, const Supported ),
1688   -- On by default:
1689   ( "MonomorphismRestriction",          Opt_MonomorphismRestriction, const Supported ),
1690   -- On by default (which is not strictly H98):
1691   ( "MonoPatBinds",                     Opt_MonoPatBinds, const Supported ),
1692   ( "RelaxedPolyRec",                   Opt_RelaxedPolyRec, const Supported ),
1693   ( "ExtendedDefaultRules",             Opt_ExtendedDefaultRules, const Supported ),
1694   ( "ImplicitParams",                   Opt_ImplicitParams, const Supported ),
1695   ( "ScopedTypeVariables",              Opt_ScopedTypeVariables, const Supported ),
1696
1697   ( "PatternSignatures",                Opt_ScopedTypeVariables,
1698     deprecatedForLanguage "ScopedTypeVariables" ),
1699
1700   ( "UnboxedTuples",                    Opt_UnboxedTuples, const Supported ),
1701   ( "StandaloneDeriving",               Opt_StandaloneDeriving, const Supported ),
1702   ( "DeriveDataTypeable",               Opt_DeriveDataTypeable, const Supported ),
1703   ( "TypeSynonymInstances",             Opt_TypeSynonymInstances, const Supported ),
1704   ( "FlexibleContexts",                 Opt_FlexibleContexts, const Supported ),
1705   ( "FlexibleInstances",                Opt_FlexibleInstances, const Supported ),
1706   ( "ConstrainedClassMethods",          Opt_ConstrainedClassMethods, const Supported ),
1707   ( "MultiParamTypeClasses",            Opt_MultiParamTypeClasses, const Supported ),
1708   ( "FunctionalDependencies",           Opt_FunctionalDependencies, const Supported ),
1709   ( "GeneralizedNewtypeDeriving",       Opt_GeneralizedNewtypeDeriving, const Supported ),
1710   ( "OverlappingInstances",             Opt_OverlappingInstances, const Supported ),
1711   ( "UndecidableInstances",             Opt_UndecidableInstances, const Supported ),
1712   ( "IncoherentInstances",              Opt_IncoherentInstances, const Supported ),
1713   ( "PackageImports",                   Opt_PackageImports, const Supported ),
1714   ( "NewQualifiedOperators",            Opt_NewQualifiedOperators, const Supported )
1715   ]
1716
1717 impliedFlags :: [(DynFlag, DynFlag)]
1718 impliedFlags
1719   = [ (Opt_GADTs,               Opt_RelaxedPolyRec)  -- We want type-sig variables to
1720                                                      --      be completely rigid for GADTs
1721
1722     , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec)  -- Ditto for scoped type variables; see
1723                                                      --      Note [Scoped tyvars] in TcBinds
1724   ]
1725
1726 glasgowExtsFlags :: [DynFlag]
1727 glasgowExtsFlags = [
1728              Opt_PrintExplicitForalls
1729            , Opt_ForeignFunctionInterface
1730            , Opt_UnliftedFFITypes
1731            , Opt_GADTs
1732            , Opt_ImplicitParams
1733            , Opt_ScopedTypeVariables
1734            , Opt_UnboxedTuples
1735            , Opt_TypeSynonymInstances
1736            , Opt_StandaloneDeriving
1737            , Opt_DeriveDataTypeable
1738            , Opt_FlexibleContexts
1739            , Opt_FlexibleInstances
1740            , Opt_ConstrainedClassMethods
1741            , Opt_MultiParamTypeClasses
1742            , Opt_FunctionalDependencies
1743            , Opt_MagicHash
1744            , Opt_PolymorphicComponents
1745            , Opt_ExistentialQuantification
1746            , Opt_UnicodeSyntax
1747            , Opt_PostfixOperators
1748            , Opt_PatternGuards
1749            , Opt_LiberalTypeSynonyms
1750            , Opt_RankNTypes
1751            , Opt_ImpredicativeTypes
1752            , Opt_TypeOperators
1753            , Opt_RecursiveDo
1754            , Opt_ParallelListComp
1755            , Opt_EmptyDataDecls
1756            , Opt_KindSignatures
1757            , Opt_GeneralizedNewtypeDeriving
1758            , Opt_TypeFamilies ]
1759
1760 -- -----------------------------------------------------------------------------
1761 -- Parsing the dynamic flags.
1762
1763 -- | Parse dynamic flags from a list of command line arguments.  Returns the
1764 -- the parsed 'DynFlags', the left-over arguments, and a list of warnings.
1765 -- Throws a 'UsageError' if errors occurred during parsing (such as unknown
1766 -- flags or missing arguments).
1767 parseDynamicFlags :: Monad m =>
1768                      DynFlags -> [Located String]
1769                   -> m (DynFlags, [Located String], [Located String])
1770                      -- ^ Updated 'DynFlags', left-over arguments, and
1771                      -- list of warnings.
1772 parseDynamicFlags dflags args = parseDynamicFlags_ dflags args True
1773
1774 -- | Like 'parseDynamicFlags' but does not allow the package flags (-package,
1775 -- -hide-package, -ignore-package, -hide-all-packages, -package-conf).
1776 parseDynamicNoPackageFlags :: Monad m =>
1777                      DynFlags -> [Located String]
1778                   -> m (DynFlags, [Located String], [Located String])
1779                      -- ^ Updated 'DynFlags', left-over arguments, and
1780                      -- list of warnings.
1781 parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False
1782
1783 parseDynamicFlags_ :: Monad m =>
1784                       DynFlags -> [Located String] -> Bool
1785                   -> m (DynFlags, [Located String], [Located String])
1786 parseDynamicFlags_ dflags args pkg_flags = do
1787   -- XXX Legacy support code
1788   -- We used to accept things like
1789   --     optdep-f  -optdepdepend
1790   --     optdep-f  -optdep depend
1791   --     optdep -f -optdepdepend
1792   --     optdep -f -optdep depend
1793   -- but the spaces trip up proper argument handling. So get rid of them.
1794   let f (L p "-optdep" : L _ x : xs) = (L p ("-optdep" ++ x)) : f xs
1795       f (x : xs) = x : f xs
1796       f xs = xs
1797       args' = f args
1798
1799       -- Note: -ignore-package (package_flags) must precede -i* (dynamic_flags)
1800       flag_spec | pkg_flags = package_flags ++ dynamic_flags
1801                 | otherwise = dynamic_flags
1802
1803   let ((leftover, errs, warns), dflags')
1804           = runCmdLine (processArgs flag_spec args') dflags
1805   when (not (null errs)) $ ghcError $ errorsToGhcException errs
1806   return (dflags', leftover, warns)
1807
1808 type DynP = CmdLineP DynFlags
1809
1810 upd :: (DynFlags -> DynFlags) -> DynP ()
1811 upd f = do
1812    dfs <- getCmdLineState
1813    putCmdLineState $! (f dfs)
1814
1815 --------------------------
1816 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
1817 setDynFlag f = do { upd (\dfs -> dopt_set dfs f)
1818                   ; mapM_ setDynFlag deps }
1819   where
1820     deps = [ d | (f', d) <- impliedFlags, f' == f ]
1821         -- When you set f, set the ones it implies
1822         -- NB: use setDynFlag recursively, in case the implied flags
1823         --     implies further flags
1824         -- When you un-set f, however, we don't un-set the things it implies
1825         --      (except for -fno-glasgow-exts, which is treated specially)
1826
1827 unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
1828
1829 --------------------------
1830 setDumpFlag :: DynFlag -> OptKind DynP
1831 setDumpFlag dump_flag
1832   = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile)
1833   where
1834         -- Certain dumpy-things are really interested in what's going
1835         -- on during recompilation checking, so in those cases we
1836         -- don't want to turn it off.
1837     want_recomp = dump_flag `notElem` [Opt_D_dump_if_trace,
1838                                        Opt_D_dump_hi_diffs]
1839
1840 forceRecompile :: DynP ()
1841 -- Whenver we -ddump, force recompilation (by switching off the
1842 -- recompilation checker), else you don't see the dump! However,
1843 -- don't switch it off in --make mode, else *everything* gets
1844 -- recompiled which probably isn't what you want
1845 forceRecompile = do { dfs <- getCmdLineState
1846                     ; when (force_recomp dfs) (setDynFlag Opt_ForceRecomp) }
1847         where
1848           force_recomp dfs = isOneShot (ghcMode dfs)
1849
1850 setVerboseCore2Core :: DynP ()
1851 setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core
1852                          forceRecompile
1853                          upd (\s -> s { shouldDumpSimplPhase = const True })
1854
1855 setDumpSimplPhases :: String -> DynP ()
1856 setDumpSimplPhases s = do forceRecompile
1857                           upd (\s -> s { shouldDumpSimplPhase = spec })
1858   where
1859     spec :: SimplifierMode -> Bool
1860     spec = join (||)
1861          . map (join (&&) . map match . split ':')
1862          . split ','
1863          $ case s of
1864              '=' : s' -> s'
1865              _        -> s
1866
1867     join :: (Bool -> Bool -> Bool)
1868          -> [SimplifierMode -> Bool]
1869          -> SimplifierMode -> Bool
1870     join _  [] = const True
1871     join op ss = foldr1 (\f g x -> f x `op` g x) ss
1872
1873     match :: String -> SimplifierMode -> Bool
1874     match "" = const True
1875     match s  = case reads s of
1876                 [(n,"")] -> phase_num  n
1877                 _        -> phase_name s
1878
1879     phase_num :: Int -> SimplifierMode -> Bool
1880     phase_num n (SimplPhase k _) = n == k
1881     phase_num _ _                = False
1882
1883     phase_name :: String -> SimplifierMode -> Bool
1884     phase_name s SimplGently       = s == "gentle"
1885     phase_name s (SimplPhase _ ss) = s `elem` ss
1886
1887 setVerbosity :: Maybe Int -> DynP ()
1888 setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
1889
1890 addCmdlineHCInclude :: String -> DynP ()
1891 addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
1892
1893 extraPkgConf_ :: FilePath -> DynP ()
1894 extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
1895
1896 exposePackage, hidePackage, ignorePackage :: String -> DynP ()
1897 exposePackage p =
1898   upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
1899 hidePackage p =
1900   upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
1901 ignorePackage p =
1902   upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
1903
1904 setPackageName :: String -> DynFlags -> DynFlags
1905 setPackageName p
1906   | Nothing <- unpackPackageId pid
1907   = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
1908   | otherwise
1909   = \s -> s{ thisPackage = pid }
1910   where
1911         pid = stringToPackageId p
1912
1913 -- If we're linking a binary, then only targets that produce object
1914 -- code are allowed (requests for other target types are ignored).
1915 setTarget :: HscTarget -> DynP ()
1916 setTarget l = upd set
1917   where
1918    set dfs
1919      | ghcLink dfs /= LinkBinary || isObjectTarget l  = dfs{ hscTarget = l }
1920      | otherwise = dfs
1921
1922 -- Changes the target only if we're compiling object code.  This is
1923 -- used by -fasm and -fvia-C, which switch from one to the other, but
1924 -- not from bytecode to object-code.  The idea is that -fasm/-fvia-C
1925 -- can be safely used in an OPTIONS_GHC pragma.
1926 setObjTarget :: HscTarget -> DynP ()
1927 setObjTarget l = upd set
1928   where
1929    set dfs
1930      | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l }
1931      | otherwise = dfs
1932
1933 setOptLevel :: Int -> DynFlags -> DynFlags
1934 setOptLevel n dflags
1935    | hscTarget dflags == HscInterpreted && n > 0
1936         = dflags
1937             -- not in IO any more, oh well:
1938             -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
1939    | otherwise
1940         = updOptLevel n dflags
1941
1942
1943 -- -Odph is equivalent to
1944 --
1945 --    -O2                               optimise as much as possible
1946 --    -fno-method-sharing               sharing specialisation defeats fusion
1947 --                                      sometimes
1948 --    -fdicts-cheap                     always inline dictionaries
1949 --    -fmax-simplifier-iterations20     this is necessary sometimes
1950 --    -fno-spec-constr-threshold        run SpecConstr even for big loops
1951 --    -fno-spec-constr-count            SpecConstr as much as possible
1952 --    -finline-enough-args              hack to prevent excessive inlining
1953 --
1954 setDPHOpt :: DynFlags -> DynFlags
1955 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
1956                                          , specConstrThreshold = Nothing
1957                                          , specConstrCount     = Nothing
1958                                          })
1959                    `dopt_set`   Opt_DictsCheap
1960                    `dopt_unset` Opt_MethodSharing
1961                    `dopt_set`   Opt_InlineIfEnoughArgs
1962
1963 data DPHBackend = DPHPar
1964                 | DPHSeq
1965                 | DPHThis
1966         deriving(Eq, Ord, Enum, Show)
1967
1968 setDPHBackend :: DPHBackend -> DynP ()
1969 setDPHBackend backend
1970   = do
1971       upd $ \dflags -> dflags { dphBackend = backend }
1972       mapM_ exposePackage (dph_packages backend)
1973   where
1974     dph_packages DPHThis = []
1975     dph_packages DPHPar  = ["dph-prim-par", "dph-par"]
1976     dph_packages DPHSeq  = ["dph-prim-seq", "dph-seq"]
1977
1978 dphPackage :: DynFlags -> PackageId
1979 dphPackage dflags = case dphBackend dflags of
1980                       DPHPar  -> dphParPackageId
1981                       DPHSeq  -> dphSeqPackageId
1982                       DPHThis -> thisPackage dflags
1983
1984 setMainIs :: String -> DynP ()
1985 setMainIs arg
1986   | not (null main_fn) && isLower (head main_fn)
1987      -- The arg looked like "Foo.Bar.baz"
1988   = upd $ \d -> d{ mainFunIs = Just main_fn,
1989                    mainModIs = mkModule mainPackageId (mkModuleName main_mod) }
1990
1991   | isUpper (head arg)  -- The arg looked like "Foo" or "Foo.Bar"
1992   = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) }
1993
1994   | otherwise                   -- The arg looked like "baz"
1995   = upd $ \d -> d{ mainFunIs = Just arg }
1996   where
1997     (main_mod, main_fn) = splitLongestPrefix arg (== '.')
1998
1999 -- | Get the unqualified name of the function to use as the \"main\" for the main module.
2000 -- Either returns the default name or the one configured on the command line with -main-is
2001 getMainFun :: DynFlags -> RdrName
2002 getMainFun dflags = case (mainFunIs dflags) of
2003     Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
2004     Nothing -> main_RDR_Unqual
2005
2006 -----------------------------------------------------------------------------
2007 -- Paths & Libraries
2008
2009 addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP ()
2010
2011 -- -i on its own deletes the import paths
2012 addImportPath "" = upd (\s -> s{importPaths = []})
2013 addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
2014
2015
2016 addLibraryPath p =
2017   upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
2018
2019 addIncludePath p =
2020   upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
2021
2022 addFrameworkPath p =
2023   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
2024
2025 #ifndef mingw32_TARGET_OS
2026 split_marker :: Char
2027 split_marker = ':'   -- not configurable (ToDo)
2028 #endif
2029
2030 splitPathList :: String -> [String]
2031 splitPathList s = filter notNull (splitUp s)
2032                 -- empty paths are ignored: there might be a trailing
2033                 -- ':' in the initial list, for example.  Empty paths can
2034                 -- cause confusion when they are translated into -I options
2035                 -- for passing to gcc.
2036   where
2037 #ifndef mingw32_TARGET_OS
2038     splitUp xs = split split_marker xs
2039 #else
2040      -- Windows: 'hybrid' support for DOS-style paths in directory lists.
2041      --
2042      -- That is, if "foo:bar:baz" is used, this interpreted as
2043      -- consisting of three entries, 'foo', 'bar', 'baz'.
2044      -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
2045      -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
2046      --
2047      -- Notice that no attempt is made to fully replace the 'standard'
2048      -- split marker ':' with the Windows / DOS one, ';'. The reason being
2049      -- that this will cause too much breakage for users & ':' will
2050      -- work fine even with DOS paths, if you're not insisting on being silly.
2051      -- So, use either.
2052     splitUp []             = []
2053     splitUp (x:':':div:xs) | div `elem` dir_markers
2054                            = ((x:':':div:p): splitUp rs)
2055                            where
2056                               (p,rs) = findNextPath xs
2057           -- we used to check for existence of the path here, but that
2058           -- required the IO monad to be threaded through the command-line
2059           -- parser which is quite inconvenient.  The
2060     splitUp xs = cons p (splitUp rs)
2061                where
2062                  (p,rs) = findNextPath xs
2063
2064                  cons "" xs = xs
2065                  cons x  xs = x:xs
2066
2067     -- will be called either when we've consumed nought or the
2068     -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
2069     -- finding the next split marker.
2070     findNextPath xs =
2071         case break (`elem` split_markers) xs of
2072            (p, _:ds) -> (p, ds)
2073            (p, xs)   -> (p, xs)
2074
2075     split_markers :: [Char]
2076     split_markers = [':', ';']
2077
2078     dir_markers :: [Char]
2079     dir_markers = ['/', '\\']
2080 #endif
2081
2082 -- -----------------------------------------------------------------------------
2083 -- tmpDir, where we store temporary files.
2084
2085 setTmpDir :: FilePath -> DynFlags -> DynFlags
2086 setTmpDir dir dflags = dflags{ tmpDir = normalise dir }
2087   -- we used to fix /cygdrive/c/.. on Windows, but this doesn't
2088   -- seem necessary now --SDM 7/2/2008
2089
2090 -----------------------------------------------------------------------------
2091 -- Hpc stuff
2092
2093 setOptHpcDir :: String -> DynP ()
2094 setOptHpcDir arg  = upd $ \ d -> d{hpcDir = arg}
2095
2096 -----------------------------------------------------------------------------
2097 -- Via-C compilation stuff
2098
2099 -- There are some options that we need to pass to gcc when compiling
2100 -- Haskell code via C, but are only supported by recent versions of
2101 -- gcc.  The configure script decides which of these options we need,
2102 -- and puts them in the file "extra-gcc-opts" in $topdir, which is
2103 -- read before each via-C compilation.  The advantage of having these
2104 -- in a separate file is that the file can be created at install-time
2105 -- depending on the available gcc version, and even re-generated  later
2106 -- if gcc is upgraded.
2107 --
2108 -- The options below are not dependent on the version of gcc, only the
2109 -- platform.
2110
2111 machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
2112                               [String]) -- for registerised HC compilations
2113 machdepCCOpts _dflags
2114 #if alpha_TARGET_ARCH
2115         =       ( ["-w", "-mieee"
2116 #ifdef HAVE_THREADED_RTS_SUPPORT
2117                     , "-D_REENTRANT"
2118 #endif
2119                    ], [] )
2120         -- For now, to suppress the gcc warning "call-clobbered
2121         -- register used for global register variable", we simply
2122         -- disable all warnings altogether using the -w flag. Oh well.
2123
2124 #elif hppa_TARGET_ARCH
2125         -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
2126         -- (very nice, but too bad the HP /usr/include files don't agree.)
2127         = ( ["-D_HPUX_SOURCE"], [] )
2128
2129 #elif m68k_TARGET_ARCH
2130       -- -fno-defer-pop : for the .hc files, we want all the pushing/
2131       --    popping of args to routines to be explicit; if we let things
2132       --    be deferred 'til after an STGJUMP, imminent death is certain!
2133       --
2134       -- -fomit-frame-pointer : *don't*
2135       --     It's better to have a6 completely tied up being a frame pointer
2136       --     rather than let GCC pick random things to do with it.
2137       --     (If we want to steal a6, then we would try to do things
2138       --     as on iX86, where we *do* steal the frame pointer [%ebp].)
2139         = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
2140
2141 #elif i386_TARGET_ARCH
2142       -- -fno-defer-pop : basically the same game as for m68k
2143       --
2144       -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
2145       --   the fp (%ebp) for our register maps.
2146         =  let n_regs = stolen_x86_regs _dflags
2147                sta = opt_Static
2148            in
2149                     ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
2150                       ],
2151                       [ "-fno-defer-pop",
2152                         "-fomit-frame-pointer",
2153                         -- we want -fno-builtin, because when gcc inlines
2154                         -- built-in functions like memcpy() it tends to
2155                         -- run out of registers, requiring -monly-n-regs
2156                         "-fno-builtin",
2157                         "-DSTOLEN_X86_REGS="++show n_regs ]
2158                     )
2159
2160 #elif ia64_TARGET_ARCH
2161         = ( [], ["-fomit-frame-pointer", "-G0"] )
2162
2163 #elif x86_64_TARGET_ARCH
2164         = ( [], ["-fomit-frame-pointer",
2165                  "-fno-asynchronous-unwind-tables",
2166                         -- the unwind tables are unnecessary for HC code,
2167                         -- and get in the way of -split-objs.  Another option
2168                         -- would be to throw them away in the mangler, but this
2169                         -- is easier.
2170                  "-fno-builtin"
2171                         -- calling builtins like strlen() using the FFI can
2172                         -- cause gcc to run out of regs, so use the external
2173                         -- version.
2174                 ] )
2175
2176 #elif sparc_TARGET_ARCH
2177         = ( [], ["-w"] )
2178         -- For now, to suppress the gcc warning "call-clobbered
2179         -- register used for global register variable", we simply
2180         -- disable all warnings altogether using the -w flag. Oh well.
2181
2182 #elif powerpc_apple_darwin_TARGET
2183       -- -no-cpp-precomp:
2184       --     Disable Apple's precompiling preprocessor. It's a great thing
2185       --     for "normal" programs, but it doesn't support register variable
2186       --     declarations.
2187         = ( [], ["-no-cpp-precomp"] )
2188 #else
2189         = ( [], [] )
2190 #endif
2191
2192 picCCOpts :: DynFlags -> [String]
2193 picCCOpts _dflags
2194 #if darwin_TARGET_OS
2195       -- Apple prefers to do things the other way round.
2196       -- PIC is on by default.
2197       -- -mdynamic-no-pic:
2198       --     Turn off PIC code generation.
2199       -- -fno-common:
2200       --     Don't generate "common" symbols - these are unwanted
2201       --     in dynamic libraries.
2202
2203     | opt_PIC
2204         = ["-fno-common", "-U __PIC__","-D__PIC__"]
2205     | otherwise
2206         = ["-mdynamic-no-pic"]
2207 #elif mingw32_TARGET_OS
2208       -- no -fPIC for Windows
2209     | opt_PIC
2210         = ["-U __PIC__","-D__PIC__"]
2211     | otherwise
2212         = []
2213 #else
2214     | opt_PIC
2215         = ["-fPIC", "-U __PIC__", "-D__PIC__"]
2216     | otherwise
2217         = []
2218 #endif
2219
2220 -- -----------------------------------------------------------------------------
2221 -- Splitting
2222
2223 can_split :: Bool
2224 can_split = cSplitObjs == "YES"
2225
2226 -- -----------------------------------------------------------------------------
2227 -- Compiler Info
2228
2229 compilerInfo :: [(String, String)]
2230 compilerInfo = [("Project name",                cProjectName),
2231                 ("Project version",             cProjectVersion),
2232                 ("Booter version",              cBooterVersion),
2233                 ("Stage",                       cStage),
2234                 ("Interface file version",      cHscIfaceFileVersion),
2235                 ("Have interpreter",            cGhcWithInterpreter),
2236                 ("Object splitting",            cSplitObjs),
2237                 ("Have native code generator",  cGhcWithNativeCodeGen),
2238                 ("Support SMP",                 cGhcWithSMP),
2239                 ("Unregisterised",              cGhcUnregisterised),
2240                 ("Tables next to code",         cGhcEnableTablesNextToCode),
2241                 ("Win32 DLLs",                  cEnableWin32DLLs),
2242                 ("RTS ways",                    cGhcRTSWays),
2243                 ("Leading underscore",          cLeadingUnderscore),
2244                 ("Debug on",                    show debugIsOn)
2245                ]
2246