compiler/main/DynFlags.hs

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