compiler/main/DynFlags.hs

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