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