compiler/main/DynFlags.hs

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