compiler/main/DynFlags.hs

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