compiler/main/DynFlags.hs

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