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