compiler/main/DynFlags.hs

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