ghc/compiler/main/CmdLineOpts.lhs

   1
   2 % (c) The University of Glasgow, 1996-2000
   3 %
   4 \section[CmdLineOpts]{Things to do with command-line options}
   5
   6 \begin{code}
   7
   8 module CmdLineOpts (
   9         CoreToDo(..), buildCoreToDo, StgToDo(..),
  10         SimplifierSwitch(..),
  11         SimplifierMode(..), FloatOutSwitches(..),
  12
  13         HscLang(..),
  14         DynFlag(..),    -- needed non-abstractly by DriverFlags
  15         DynFlags(..),
  16
  17         v_Static_hsc_opts,
  18
  19         isStaticHscFlag,
  20
  21         -- Manipulating DynFlags
  22         defaultDynFlags,                -- DynFlags
  23         defaultHscLang,                 -- HscLang
  24         dopt,                           -- DynFlag -> DynFlags -> Bool
  25         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
  26         dopt_CoreToDo,                  -- DynFlags -> [CoreToDo]
  27         dopt_StgToDo,                   -- DynFlags -> [StgToDo]
  28         dopt_HscLang,                   -- DynFlags -> HscLang
  29         dopt_OutName,                   -- DynFlags -> String
  30         getOpts,                        -- (DynFlags -> [a]) -> IO [a]
  31         setLang,
  32         getVerbFlag,
  33         setOptLevel,
  34
  35         -- Manipulating the DynFlags state
  36         getDynFlags,                    -- IO DynFlags
  37         setDynFlags,                    -- DynFlags -> IO ()
  38         updDynFlags,                    -- (DynFlags -> DynFlags) -> IO ()
  39         dynFlag,                        -- (DynFlags -> a) -> IO a
  40         setDynFlag, unSetDynFlag,       -- DynFlag -> IO ()
  41         saveDynFlags,                   -- IO ()
  42         restoreDynFlags,                -- IO DynFlags
  43
  44         -- sets of warning opts
  45         standardWarnings,
  46         minusWOpts,
  47         minusWallOpts,
  48
  49         -- Output style options
  50         opt_PprStyle_NoPrags,
  51         opt_PprStyle_RawTypes,
  52         opt_PprUserLength,
  53         opt_PprStyle_Debug,
  54
  55         -- profiling opts
  56         opt_AutoSccsOnAllToplevs,
  57         opt_AutoSccsOnExportedToplevs,
  58         opt_AutoSccsOnIndividualCafs,
  59         opt_AutoSccsOnDicts,
  60         opt_SccProfilingOn,
  61         opt_DoTickyProfiling,
  62
  63         -- language opts
  64         opt_AllStrict,
  65         opt_DictsStrict,
  66         opt_MaxContextReductionDepth,
  67         opt_IrrefutableTuples,
  68         opt_NumbersStrict,
  69         opt_Parallel,
  70         opt_SMP,
  71         opt_RuntimeTypes,
  72         opt_Flatten,
  73
  74         -- optimisation opts
  75         opt_NoMethodSharing,
  76         opt_DoSemiTagging,
  77         opt_LiberateCaseThreshold,
  78         opt_CprOff,
  79         opt_RulesOff,
  80         opt_SimplNoPreInlining,
  81         opt_SimplExcessPrecision,
  82         opt_MaxWorkerArgs,
  83
  84         -- Unfolding control
  85         opt_UF_CreationThreshold,
  86         opt_UF_UseThreshold,
  87         opt_UF_FunAppDiscount,
  88         opt_UF_KeenessFactor,
  89         opt_UF_UpdateInPlace,
  90         opt_UF_CheapOp,
  91         opt_UF_DearOp,
  92
  93         -- misc opts
  94         opt_InPackage,
  95         opt_EmitCExternDecls,
  96         opt_EnsureSplittableC,
  97         opt_GranMacros,
  98         opt_HiVersion,
  99         opt_HistorySize,
 100         opt_NoHiCheck,
 101         opt_OmitBlackHoling,
 102         opt_NoPruneDecls,
 103         opt_Static,
 104         opt_Unregisterised,
 105         opt_EmitExternalCore
 106     ) where
 107
 108 #include "HsVersions.h"
 109
 110 import Constants        -- Default values for some flags
 111 import Util
 112 import FastString       ( FastString, mkFastString )
 113 import Config
 114 import Maybes           ( firstJust )
 115
 116 import GLAEXTS
 117 import DATA_IOREF       ( IORef, readIORef, writeIORef )
 118 import UNSAFE_IO        ( unsafePerformIO )
 119 \end{code}
 120
 121 %************************************************************************
 122 %*                                                                      *
 123 \subsection{Command-line options}
 124 %*                                                                      *
 125 %************************************************************************
 126
 127 The hsc command-line options are split into two categories:
 128
 129   - static flags
 130   - dynamic flags
 131
 132 Static flags are represented by top-level values of type Bool or Int,
 133 for example.  They therefore have the same value throughout the
 134 invocation of hsc.
 135
 136 Dynamic flags are represented by an abstract type, DynFlags, which is
 137 passed into hsc by the compilation manager for every compilation.
 138 Dynamic flags are those that change on a per-compilation basis,
 139 perhaps because they may be present in the OPTIONS pragma at the top
 140 of a module.
 141
 142 Other flag-related blurb:
 143
 144 A list of {\em ToDo}s is things to be done in a particular part of
 145 processing.  A (fictitious) example for the Core-to-Core simplifier
 146 might be: run the simplifier, then run the strictness analyser, then
 147 run the simplifier again (three ``todos'').
 148
 149 There are three ``to-do processing centers'' at the moment.  In the
 150 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
 151 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
 152 (\tr{simplStg/SimplStg.lhs}).
 153
 154 %************************************************************************
 155 %*                                                                      *
 156 \subsection{Datatypes associated with command-line options}
 157 %*                                                                      *
 158 %************************************************************************
 159
 160 \begin{code}
 161 data CoreToDo           -- These are diff core-to-core passes,
 162                         -- which may be invoked in any order,
 163                         -- as many times as you like.
 164
 165   = CoreDoSimplify      -- The core-to-core simplifier.
 166         SimplifierMode
 167         [SimplifierSwitch]
 168                         -- Each run of the simplifier can take a different
 169                         -- set of simplifier-specific flags.
 170   | CoreDoFloatInwards
 171   | CoreDoFloatOutwards FloatOutSwitches
 172   | CoreLiberateCase
 173   | CoreDoPrintCore
 174   | CoreDoStaticArgs
 175   | CoreDoStrictness
 176   | CoreDoWorkerWrapper
 177   | CoreDoSpecialising
 178   | CoreDoSpecConstr
 179   | CoreDoOldStrictness
 180   | CoreDoGlomBinds
 181   | CoreCSE
 182   | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
 183                                                 -- matching this string
 184
 185   | CoreDoNothing        -- useful when building up lists of these things
 186 \end{code}
 187
 188 \begin{code}
 189 data StgToDo
 190   = StgDoMassageForProfiling  -- should be (next to) last
 191   -- There's also setStgVarInfo, but its absolute "lastness"
 192   -- is so critical that it is hardwired in (no flag).
 193   | D_stg_stats
 194 \end{code}
 195
 196 \begin{code}
 197 data SimplifierMode             -- See comments in SimplMonad
 198   = SimplGently
 199   | SimplPhase Int
 200
 201 data SimplifierSwitch
 202   = MaxSimplifierIterations Int
 203   | NoCaseOfCase
 204
 205 data FloatOutSwitches
 206   = FloatOutSw  Bool    -- True <=> float lambdas to top level
 207                 Bool    -- True <=> float constants to top level,
 208                         --          even if they do not escape a lambda
 209 \end{code}
 210
 211 %************************************************************************
 212 %*                                                                      *
 213 \subsection{Dynamic command-line options}
 214 %*                                                                      *
 215 %************************************************************************
 216
 217 \begin{code}
 218 data DynFlag
 219
 220    -- debugging flags
 221    = Opt_D_dump_absC
 222    | Opt_D_dump_asm
 223    | Opt_D_dump_cpranal
 224    | Opt_D_dump_deriv
 225    | Opt_D_dump_ds
 226    | Opt_D_dump_flatC
 227    | Opt_D_dump_foreign
 228    | Opt_D_dump_inlinings
 229    | Opt_D_dump_occur_anal
 230    | Opt_D_dump_parsed
 231    | Opt_D_dump_realC
 232    | Opt_D_dump_rn
 233    | Opt_D_dump_simpl
 234    | Opt_D_dump_simpl_iterations
 235    | Opt_D_dump_spec
 236    | Opt_D_dump_prep
 237    | Opt_D_dump_stg
 238    | Opt_D_dump_stranal
 239    | Opt_D_dump_tc
 240    | Opt_D_dump_types
 241    | Opt_D_dump_rules
 242    | Opt_D_dump_cse
 243    | Opt_D_dump_worker_wrapper
 244    | Opt_D_dump_rn_trace
 245    | Opt_D_dump_rn_stats
 246    | Opt_D_dump_stix
 247    | Opt_D_dump_simpl_stats
 248    | Opt_D_dump_tc_trace
 249    | Opt_D_dump_splices
 250    | Opt_D_dump_BCOs
 251    | Opt_D_dump_vect
 252    | Opt_D_source_stats
 253    | Opt_D_verbose_core2core
 254    | Opt_D_verbose_stg2stg
 255    | Opt_D_dump_hi
 256    | Opt_D_dump_hi_diffs
 257    | Opt_D_dump_minimal_imports
 258    | Opt_DoCoreLinting
 259    | Opt_DoStgLinting
 260
 261    | Opt_WarnIsError            -- -Werror; makes warnings fatal
 262    | Opt_WarnDuplicateExports
 263    | Opt_WarnHiShadows
 264    | Opt_WarnIncompletePatterns
 265    | Opt_WarnMissingFields
 266    | Opt_WarnMissingMethods
 267    | Opt_WarnMissingSigs
 268    | Opt_WarnNameShadowing
 269    | Opt_WarnOverlappingPatterns
 270    | Opt_WarnSimplePatterns
 271    | Opt_WarnTypeDefaults
 272    | Opt_WarnUnusedBinds
 273    | Opt_WarnUnusedImports
 274    | Opt_WarnUnusedMatches
 275    | Opt_WarnDeprecations
 276    | Opt_WarnMisc
 277
 278    -- language opts
 279    | Opt_AllowOverlappingInstances
 280    | Opt_AllowUndecidableInstances
 281    | Opt_AllowIncoherentInstances
 282    | Opt_NoMonomorphismRestriction
 283    | Opt_GlasgowExts
 284    | Opt_FFI
 285    | Opt_PArr                          -- syntactic support for parallel arrays
 286    | Opt_Arrows                        -- Arrow-notation syntax
 287    | Opt_TH
 288    | Opt_ImplicitParams
 289    | Opt_Generics
 290    | Opt_NoImplicitPrelude
 291
 292    -- optimisation opts
 293    | Opt_Strictness
 294    | Opt_CSE
 295    | Opt_IgnoreInterfacePragmas
 296    | Opt_OmitInterfacePragmas
 297    | Opt_DoLambdaEtaExpansion
 298    | Opt_IgnoreAsserts
 299    | Opt_DoEtaReduction
 300    | Opt_CaseMerge
 301    | Opt_UnboxStrictFields
 302
 303    deriving (Eq)
 304
 305 data DynFlags = DynFlags {
 306   coreToDo              :: Maybe [CoreToDo], -- reserved for use with -Ofile
 307   stgToDo               :: [StgToDo],
 308   hscLang               :: HscLang,
 309   hscOutName            :: String,      -- name of the output file
 310   hscStubHOutName       :: String,      -- name of the .stub_h output file
 311   hscStubCOutName       :: String,      -- name of the .stub_c output file
 312   extCoreName           :: String,      -- name of the .core output file
 313   verbosity             :: Int,         -- verbosity level
 314   optLevel              :: Int,         -- optimisation level
 315   maxSimplIterations    :: Int,         -- max simplifier iterations
 316   ruleCheck             :: Maybe String,
 317   cppFlag               :: Bool,        -- preprocess with cpp?
 318   ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
 319   stolen_x86_regs       :: Int,
 320   cmdlineHcIncludes     :: [String],    -- -#includes
 321
 322   -- options for particular phases
 323   opt_L                 :: [String],
 324   opt_P                 :: [String],
 325   opt_F                 :: [String],
 326   opt_c                 :: [String],
 327   opt_a                 :: [String],
 328   opt_m                 :: [String],
 329 #ifdef ILX
 330   opt_I                 :: [String],
 331   opt_i                 :: [String],
 332 #endif
 333
 334   -- hsc dynamic flags
 335   flags                 :: [DynFlag]
 336  }
 337
 338 data HscLang
 339   = HscC
 340   | HscAsm
 341   | HscJava
 342   | HscILX
 343   | HscInterpreted
 344   | HscNothing
 345     deriving (Eq, Show)
 346
 347 defaultHscLang
 348   | cGhcWithNativeCodeGen == "YES" &&
 349         (prefixMatch "i386" cTARGETPLATFORM ||
 350          prefixMatch "sparc" cTARGETPLATFORM ||
 351          prefixMatch "powerpc" cTARGETPLATFORM)   =  HscAsm
 352   | otherwise                                   =  HscC
 353
 354 defaultDynFlags = DynFlags {
 355   coreToDo = Nothing, stgToDo = [],
 356   hscLang = defaultHscLang,
 357   hscOutName = "",
 358   hscStubHOutName = "", hscStubCOutName = "",
 359   extCoreName = "",
 360   verbosity             = 0,
 361   optLevel              = 0,
 362   maxSimplIterations    = 4,
 363   ruleCheck             = Nothing,
 364   cppFlag               = False,
 365   ppFlag                = False,
 366   stolen_x86_regs       = 4,
 367   cmdlineHcIncludes     = [],
 368   opt_L                 = [],
 369   opt_P                 = [],
 370   opt_F                 = [],
 371   opt_c                 = [],
 372   opt_a                 = [],
 373   opt_m                 = [],
 374 #ifdef ILX
 375   opt_I                 = [],
 376   opt_i                 = [],
 377 #endif
 378   flags = [
 379             Opt_Generics,
 380                         -- Generating the helper-functions for
 381                         -- generics is now on by default
 382             Opt_Strictness,
 383                         -- strictness is on by default, but this only
 384                         -- applies to -O.
 385             Opt_CSE,
 386                         -- similarly for CSE.
 387             Opt_DoLambdaEtaExpansion,
 388                         -- This one is important for a tiresome reason:
 389                         -- we want to make sure that the bindings for data
 390                         -- constructors are eta-expanded.  This is probably
 391                         -- a good thing anyway, but it seems fragile.
 392
 393             -- and the default no-optimisation options:
 394             Opt_IgnoreInterfacePragmas,
 395             Opt_OmitInterfacePragmas
 396
 397            ] ++ standardWarnings,
 398   }
 399
 400 {-
 401     Verbosity levels:
 402
 403     0   |   print errors & warnings only
 404     1   |   minimal verbosity: print "compiling M ... done." for each module.
 405     2   |   equivalent to -dshow-passes
 406     3   |   equivalent to existing "ghc -v"
 407     4   |   "ghc -v -ddump-most"
 408     5   |   "ghc -v -ddump-all"
 409 -}
 410
 411 dopt :: DynFlag -> DynFlags -> Bool
 412 dopt f dflags  = f `elem` (flags dflags)
 413
 414 dopt_CoreToDo :: DynFlags -> Maybe [CoreToDo]
 415 dopt_CoreToDo = coreToDo
 416
 417 dopt_StgToDo :: DynFlags -> [StgToDo]
 418 dopt_StgToDo = stgToDo
 419
 420 dopt_OutName :: DynFlags -> String
 421 dopt_OutName = hscOutName
 422
 423 dopt_HscLang :: DynFlags -> HscLang
 424 dopt_HscLang = hscLang
 425
 426 dopt_set :: DynFlags -> DynFlag -> DynFlags
 427 dopt_set dfs f = dfs{ flags = f : flags dfs }
 428
 429 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 430 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 431
 432 getOpts :: (DynFlags -> [a]) -> IO [a]
 433         -- We add to the options from the front, so we need to reverse the list
 434 getOpts opts = dynFlag opts >>= return . reverse
 435
 436 -- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags
 437 -- (-fvia-C, -fasm, -filx respectively).
 438 setLang l = updDynFlags (\ dfs -> case hscLang dfs of
 439                                         HscC   -> dfs{ hscLang = l }
 440                                         HscAsm -> dfs{ hscLang = l }
 441                                         HscILX -> dfs{ hscLang = l }
 442                                         _      -> dfs)
 443
 444 getVerbFlag = do
 445    verb <- dynFlag verbosity
 446    if verb >= 3  then return  "-v" else return ""
 447
 448 -----------------------------------------------------------------------------
 449 -- Setting the optimisation level
 450
 451 setOptLevel :: Int -> IO ()
 452 setOptLevel n
 453   = do dflags <- getDynFlags
 454        if hscLang dflags == HscInterpreted && n > 0
 455           then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
 456           else updDynFlags (setOptLevel' n)
 457
 458 setOptLevel' n dfs
 459   = if (n >= 1)
 460      then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O
 461      else dfs2{ optLevel = n }
 462   where
 463    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
 464    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
 465
 466    extra_dopts
 467         | n == 0    = opt_0_dopts
 468         | otherwise = opt_1_dopts
 469
 470    remove_dopts
 471         | n == 0    = opt_1_dopts
 472         | otherwise = opt_0_dopts
 473
 474 opt_0_dopts =  [
 475         Opt_IgnoreInterfacePragmas,
 476         Opt_OmitInterfacePragmas
 477     ]
 478
 479 opt_1_dopts = [
 480         Opt_IgnoreAsserts,
 481         Opt_DoEtaReduction,
 482         Opt_CaseMerge
 483      ]
 484
 485 -- Core-to-core phases:
 486
 487 buildCoreToDo :: DynFlags -> [CoreToDo]
 488 buildCoreToDo dflags = core_todo
 489   where
 490     opt_level  = optLevel dflags
 491     max_iter   = maxSimplIterations dflags
 492     strictness = dopt Opt_Strictness dflags
 493     cse        = dopt Opt_CSE dflags
 494     rule_check = ruleCheck dflags
 495
 496     core_todo =
 497      if opt_level == 0 then
 498       [
 499         CoreDoSimplify (SimplPhase 0) [
 500             MaxSimplifierIterations max_iter
 501         ]
 502       ]
 503
 504      else {- opt_level >= 1 -} [
 505
 506         -- initial simplify: mk specialiser happy: minimum effort please
 507         CoreDoSimplify SimplGently [
 508                         --      Simplify "gently"
 509                         -- Don't inline anything till full laziness has bitten
 510                         -- In particular, inlining wrappers inhibits floating
 511                         -- e.g. ...(case f x of ...)...
 512                         --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
 513                         --  ==> ...(case x of I# x# -> case fw x# of ...)...
 514                         -- and now the redex (f x) isn't floatable any more
 515                         -- Similarly, don't apply any rules until after full
 516                         -- laziness.  Notably, list fusion can prevent floating.
 517
 518             NoCaseOfCase,
 519                         -- Don't do case-of-case transformations.
 520                         -- This makes full laziness work better
 521             MaxSimplifierIterations max_iter
 522         ],
 523
 524         -- Specialisation is best done before full laziness
 525         -- so that overloaded functions have all their dictionary lambdas manifest
 526         CoreDoSpecialising,
 527
 528         CoreDoFloatOutwards (FloatOutSw False False),
 529         CoreDoFloatInwards,
 530
 531         CoreDoSimplify (SimplPhase 2) [
 532                 -- Want to run with inline phase 2 after the specialiser to give
 533                 -- maximum chance for fusion to work before we inline build/augment
 534                 -- in phase 1.  This made a difference in 'ansi' where an
 535                 -- overloaded function wasn't inlined till too late.
 536            MaxSimplifierIterations max_iter
 537         ],
 538         case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
 539
 540         CoreDoSimplify (SimplPhase 1) [
 541                 -- Need inline-phase2 here so that build/augment get
 542                 -- inlined.  I found that spectral/hartel/genfft lost some useful
 543                 -- strictness in the function sumcode' if augment is not inlined
 544                 -- before strictness analysis runs
 545            MaxSimplifierIterations max_iter
 546         ],
 547         case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
 548
 549         CoreDoSimplify (SimplPhase 0) [
 550                 -- Phase 0: allow all Ids to be inlined now
 551                 -- This gets foldr inlined before strictness analysis
 552
 553            MaxSimplifierIterations 3
 554                 -- At least 3 iterations because otherwise we land up with
 555                 -- huge dead expressions because of an infelicity in the
 556                 -- simpifier.
 557                 --      let k = BIG in foldr k z xs
 558                 -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 559                 -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 560                 -- Don't stop now!
 561
 562         ],
 563         case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 564
 565 #ifdef OLD_STRICTNESS
 566         CoreDoOldStrictness
 567 #endif
 568         if strictness then CoreDoStrictness else CoreDoNothing,
 569         CoreDoWorkerWrapper,
 570         CoreDoGlomBinds,
 571
 572         CoreDoSimplify (SimplPhase 0) [
 573            MaxSimplifierIterations max_iter
 574         ],
 575
 576         CoreDoFloatOutwards (FloatOutSw False   -- Not lambdas
 577                                         True),  -- Float constants
 578                 -- nofib/spectral/hartel/wang doubles in speed if you
 579                 -- do full laziness late in the day.  It only happens
 580                 -- after fusion and other stuff, so the early pass doesn't
 581                 -- catch it.  For the record, the redex is
 582                 --        f_el22 (f_el21 r_midblock)
 583
 584
 585         -- We want CSE to follow the final full-laziness pass, because it may
 586         -- succeed in commoning up things floated out by full laziness.
 587         -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 588
 589         if cse then CoreCSE else CoreDoNothing,
 590
 591         CoreDoFloatInwards,
 592
 593 -- Case-liberation for -O2.  This should be after
 594 -- strictness analysis and the simplification which follows it.
 595
 596         case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 597
 598         if opt_level >= 2 then
 599            CoreLiberateCase
 600         else
 601            CoreDoNothing,
 602         if opt_level >= 2 then
 603            CoreDoSpecConstr
 604         else
 605            CoreDoNothing,
 606
 607         -- Final clean-up simplification:
 608         CoreDoSimplify (SimplPhase 0) [
 609           MaxSimplifierIterations max_iter
 610         ]
 611      ]
 612
 613 -- --------------------------------------------------------------------------
 614 -- Mess about with the mutable variables holding the dynamic arguments
 615
 616 -- v_InitDynFlags
 617 --      is the "baseline" dynamic flags, initialised from
 618 --      the defaults and command line options, and updated by the
 619 --      ':s' command in GHCi.
 620 --
 621 -- v_DynFlags
 622 --      is the dynamic flags for the current compilation.  It is reset
 623 --      to the value of v_InitDynFlags before each compilation, then
 624 --      updated by reading any OPTIONS pragma in the current module.
 625
 626 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 627 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 628
 629 setDynFlags :: DynFlags -> IO ()
 630 setDynFlags dfs = writeIORef v_DynFlags dfs
 631
 632 saveDynFlags :: IO ()
 633 saveDynFlags = do dfs <- readIORef v_DynFlags
 634                   writeIORef v_InitDynFlags dfs
 635
 636 restoreDynFlags :: IO DynFlags
 637 restoreDynFlags = do dfs <- readIORef v_InitDynFlags
 638                      writeIORef v_DynFlags dfs
 639                      return dfs
 640
 641 getDynFlags :: IO DynFlags
 642 getDynFlags = readIORef v_DynFlags
 643
 644 updDynFlags :: (DynFlags -> DynFlags) -> IO ()
 645 updDynFlags f = do dfs <- readIORef v_DynFlags
 646                    writeIORef v_DynFlags (f dfs)
 647
 648 dynFlag :: (DynFlags -> a) -> IO a
 649 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 650
 651 setDynFlag, unSetDynFlag :: DynFlag -> IO ()
 652 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 653 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 654 \end{code}
 655
 656
 657 %************************************************************************
 658 %*                                                                      *
 659 \subsection{Warnings}
 660 %*                                                                      *
 661 %************************************************************************
 662
 663 \begin{code}
 664 standardWarnings
 665     = [ Opt_WarnDeprecations,
 666         Opt_WarnOverlappingPatterns,
 667         Opt_WarnMissingFields,
 668         Opt_WarnMissingMethods,
 669         Opt_WarnDuplicateExports
 670       ]
 671
 672 minusWOpts
 673     = standardWarnings ++
 674       [ Opt_WarnUnusedBinds,
 675         Opt_WarnUnusedMatches,
 676         Opt_WarnUnusedImports,
 677         Opt_WarnIncompletePatterns,
 678         Opt_WarnMisc
 679       ]
 680
 681 minusWallOpts
 682     = minusWOpts ++
 683       [ Opt_WarnTypeDefaults,
 684         Opt_WarnNameShadowing,
 685         Opt_WarnMissingSigs,
 686         Opt_WarnHiShadows
 687       ]
 688 \end{code}
 689
 690 %************************************************************************
 691 %*                                                                      *
 692 \subsection{Classifying command-line options}
 693 %*                                                                      *
 694 %************************************************************************
 695
 696 \begin{code}
 697 -- v_Statis_hsc_opts is here to avoid a circular dependency with
 698 -- main/DriverState.
 699 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 700
 701 lookUp           :: FastString -> Bool
 702 lookup_int       :: String -> Maybe Int
 703 lookup_def_int   :: String -> Int -> Int
 704 lookup_def_float :: String -> Float -> Float
 705 lookup_str       :: String -> Maybe String
 706
 707 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
 708 packed_static_opts   = map mkFastString unpacked_static_opts
 709
 710 lookUp     sw = sw `elem` packed_static_opts
 711
 712 lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
 713
 714 lookup_int sw = case (lookup_str sw) of
 715                   Nothing -> Nothing
 716                   Just xx -> Just (read xx)
 717
 718 lookup_def_int sw def = case (lookup_str sw) of
 719                             Nothing -> def              -- Use default
 720                             Just xx -> read xx
 721
 722 lookup_def_float sw def = case (lookup_str sw) of
 723                             Nothing -> def              -- Use default
 724                             Just xx -> read xx
 725
 726
 727 {-
 728  Putting the compiler options into temporary at-files
 729  may turn out to be necessary later on if we turn hsc into
 730  a pure Win32 application where I think there's a command-line
 731  length limit of 255. unpacked_opts understands the @ option.
 732
 733 unpacked_opts :: [String]
 734 unpacked_opts =
 735   concat $
 736   map (expandAts) $
 737   map unpackFS argv  -- NOT ARGV any more: v_Static_hsc_opts
 738   where
 739    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 740    expandAts l = [l]
 741 -}
 742 \end{code}
 743
 744 %************************************************************************
 745 %*                                                                      *
 746 \subsection{Static options}
 747 %*                                                                      *
 748 %************************************************************************
 749
 750 \begin{code}
 751 -- debugging opts
 752 opt_PprStyle_NoPrags            = lookUp  FSLIT("-dppr-noprags")
 753 opt_PprStyle_Debug              = lookUp  FSLIT("-dppr-debug")
 754 opt_PprStyle_RawTypes           = lookUp  FSLIT("-dppr-rawtypes")
 755 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 756
 757 -- profiling opts
 758 opt_AutoSccsOnAllToplevs        = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
 759 opt_AutoSccsOnExportedToplevs   = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
 760 opt_AutoSccsOnIndividualCafs    = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
 761 opt_AutoSccsOnDicts             = lookUp  FSLIT("-fauto-sccs-on-dicts")
 762 opt_SccProfilingOn              = lookUp  FSLIT("-fscc-profiling")
 763 opt_DoTickyProfiling            = lookUp  FSLIT("-fticky-ticky")
 764
 765 -- language opts
 766 opt_AllStrict                   = lookUp  FSLIT("-fall-strict")
 767 opt_DictsStrict                 = lookUp  FSLIT("-fdicts-strict")
 768 opt_IrrefutableTuples           = lookUp  FSLIT("-firrefutable-tuples")
 769 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 770 opt_NumbersStrict               = lookUp  FSLIT("-fnumbers-strict")
 771 opt_Parallel                    = lookUp  FSLIT("-fparallel")
 772 opt_SMP                         = lookUp  FSLIT("-fsmp")
 773 opt_Flatten                     = lookUp  FSLIT("-fflatten")
 774
 775 -- optimisation opts
 776 opt_NoMethodSharing             = lookUp  FSLIT("-fno-method-sharing")
 777 opt_DoSemiTagging               = lookUp  FSLIT("-fsemi-tagging")
 778 opt_CprOff                      = lookUp  FSLIT("-fcpr-off")
 779 opt_RulesOff                    = lookUp  FSLIT("-frules-off")
 780         -- Switch off CPR analysis in the new demand analyser
 781 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 782 opt_MaxWorkerArgs               = lookup_def_int "-fmax-worker-args" (10::Int)
 783
 784 {-
 785    The optional '-inpackage=P' flag tells what package
 786    we are compiling this module for.
 787    The Prelude, for example is compiled with '-inpackage std'
 788 -}
 789 opt_InPackage                   = case lookup_str "-inpackage=" of
 790                                     Just p  -> mkFastString p
 791                                     Nothing -> FSLIT("Main")    -- The package name if none is specified
 792
 793 opt_EmitCExternDecls            = lookUp  FSLIT("-femit-extern-decls")
 794 opt_EnsureSplittableC           = lookUp  FSLIT("-fglobalise-toplev-names")
 795 opt_GranMacros                  = lookUp  FSLIT("-fgransim")
 796 opt_HiVersion                   = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
 797 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 798 opt_NoHiCheck                   = lookUp  FSLIT("-fno-hi-version-check")
 799 opt_OmitBlackHoling             = lookUp  FSLIT("-dno-black-holing")
 800 opt_RuntimeTypes                = lookUp  FSLIT("-fruntime-types")
 801
 802 -- Simplifier switches
 803 opt_SimplNoPreInlining          = lookUp  FSLIT("-fno-pre-inlining")
 804         -- NoPreInlining is there just to see how bad things
 805         -- get if you don't do it!
 806 opt_SimplExcessPrecision        = lookUp  FSLIT("-fexcess-precision")
 807
 808 -- Unfolding control
 809 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 810 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 811 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 812 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 813 opt_UF_UpdateInPlace            = lookUp  FSLIT("-funfolding-update-in-place")
 814
 815 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 816 opt_UF_DearOp   = ( 4 :: Int)
 817
 818 opt_NoPruneDecls                = lookUp  FSLIT("-fno-prune-decls")
 819 opt_Static                      = lookUp  FSLIT("-static")
 820 opt_Unregisterised              = lookUp  FSLIT("-funregisterised")
 821 opt_EmitExternalCore            = lookUp  FSLIT("-fext-core")
 822 \end{code}
 823
 824 %************************************************************************
 825 %*                                                                      *
 826 \subsection{List of static hsc flags}
 827 %*                                                                      *
 828 %************************************************************************
 829
 830 \begin{code}
 831 isStaticHscFlag f =
 832   f `elem` [
 833         "fauto-sccs-on-all-toplevs",
 834         "fauto-sccs-on-exported-toplevs",
 835         "fauto-sccs-on-individual-cafs",
 836         "fauto-sccs-on-dicts",
 837         "fscc-profiling",
 838         "fticky-ticky",
 839         "fall-strict",
 840         "fdicts-strict",
 841         "firrefutable-tuples",
 842         "fnumbers-strict",
 843         "fparallel",
 844         "fsmp",
 845         "fflatten",
 846         "fsemi-tagging",
 847         "flet-no-escape",
 848         "femit-extern-decls",
 849         "fglobalise-toplev-names",
 850         "fgransim",
 851         "fno-hi-version-check",
 852         "dno-black-holing",
 853         "fno-method-sharing",
 854         "fruntime-types",
 855         "fno-pre-inlining",
 856         "fexcess-precision",
 857         "funfolding-update-in-place",
 858         "fno-prune-decls",
 859         "static",
 860         "funregisterised",
 861         "fext-core",
 862         "frule-check",
 863         "frules-off",
 864         "fcpr-off"
 865         ]
 866   || any (flip prefixMatch f) [
 867         "fcontext-stack",
 868         "fliberate-case-threshold",
 869         "fmax-worker-args",
 870         "fhistory-size",
 871         "funfolding-creation-threshold",
 872         "funfolding-use-threshold",
 873         "funfolding-fun-discount",
 874         "funfolding-keeness-factor"
 875      ]
 876 \end{code}
 877
 878 %************************************************************************
 879 %*                                                                      *
 880 \subsection{Misc functions for command-line options}
 881 %*                                                                      *
 882 %************************************************************************
 883
 884
 885
 886 \begin{code}
 887 startsWith :: String -> String -> Maybe String
 888 -- startsWith pfx (pfx++rest) = Just rest
 889
 890 startsWith []     str = Just str
 891 startsWith (c:cs) (s:ss)
 892   = if c /= s then Nothing else startsWith cs ss
 893 startsWith  _     []  = Nothing
 894
 895 endsWith  :: String -> String -> Maybe String
 896 endsWith cs ss
 897   = case (startsWith (reverse cs) (reverse ss)) of
 898       Nothing -> Nothing
 899       Just rs -> Just (reverse rs)
 900 \end{code}