compiler/main/DynFlags.hs

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