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