compiler/main/DynFlags.hs

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