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_if_trace
 250    | Opt_D_dump_splices
 251    | Opt_D_dump_BCOs
 252    | Opt_D_dump_vect
 253    | Opt_D_source_stats
 254    | Opt_D_verbose_core2core
 255    | Opt_D_verbose_stg2stg
 256    | Opt_D_dump_hi
 257    | Opt_D_dump_hi_diffs
 258    | Opt_D_dump_minimal_imports
 259    | Opt_DoCoreLinting
 260    | Opt_DoStgLinting
 261
 262    | Opt_WarnIsError            -- -Werror; makes warnings fatal
 263    | Opt_WarnDuplicateExports
 264    | Opt_WarnHiShadows
 265    | Opt_WarnIncompletePatterns
 266    | Opt_WarnMissingFields
 267    | Opt_WarnMissingMethods
 268    | Opt_WarnMissingSigs
 269    | Opt_WarnNameShadowing
 270    | Opt_WarnOverlappingPatterns
 271    | Opt_WarnSimplePatterns
 272    | Opt_WarnTypeDefaults
 273    | Opt_WarnUnusedBinds
 274    | Opt_WarnUnusedImports
 275    | Opt_WarnUnusedMatches
 276    | Opt_WarnDeprecations
 277    | Opt_WarnMisc
 278
 279    -- language opts
 280    | Opt_AllowOverlappingInstances
 281    | Opt_AllowUndecidableInstances
 282    | Opt_AllowIncoherentInstances
 283    | Opt_NoMonomorphismRestriction
 284    | Opt_GlasgowExts
 285    | Opt_FFI
 286    | Opt_PArr                          -- syntactic support for parallel arrays
 287    | Opt_Arrows                        -- Arrow-notation syntax
 288    | Opt_TH
 289    | Opt_ImplicitParams
 290    | Opt_Generics
 291    | Opt_NoImplicitPrelude
 292
 293    -- optimisation opts
 294    | Opt_Strictness
 295    | Opt_CSE
 296    | Opt_IgnoreInterfacePragmas
 297    | Opt_OmitInterfacePragmas
 298    | Opt_DoLambdaEtaExpansion
 299    | Opt_IgnoreAsserts
 300    | Opt_DoEtaReduction
 301    | Opt_CaseMerge
 302    | Opt_UnboxStrictFields
 303
 304    deriving (Eq)
 305
 306 data DynFlags = DynFlags {
 307   coreToDo              :: Maybe [CoreToDo], -- reserved for use with -Ofile
 308   stgToDo               :: [StgToDo],
 309   hscLang               :: HscLang,
 310   hscOutName            :: String,      -- name of the output file
 311   hscStubHOutName       :: String,      -- name of the .stub_h output file
 312   hscStubCOutName       :: String,      -- name of the .stub_c output file
 313   extCoreName           :: String,      -- name of the .core output file
 314   verbosity             :: Int,         -- verbosity level
 315   optLevel              :: Int,         -- optimisation level
 316   maxSimplIterations    :: Int,         -- max simplifier iterations
 317   ruleCheck             :: Maybe String,
 318   cppFlag               :: Bool,        -- preprocess with cpp?
 319   ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
 320   stolen_x86_regs       :: Int,
 321   cmdlineHcIncludes     :: [String],    -- -#includes
 322
 323   -- options for particular phases
 324   opt_L                 :: [String],
 325   opt_P                 :: [String],
 326   opt_F                 :: [String],
 327   opt_c                 :: [String],
 328   opt_a                 :: [String],
 329   opt_m                 :: [String],
 330 #ifdef ILX
 331   opt_I                 :: [String],
 332   opt_i                 :: [String],
 333 #endif
 334
 335   -- hsc dynamic flags
 336   flags                 :: [DynFlag]
 337  }
 338
 339 data HscLang
 340   = HscC
 341   | HscAsm
 342   | HscJava
 343   | HscILX
 344   | HscInterpreted
 345   | HscNothing
 346     deriving (Eq, Show)
 347
 348 defaultHscLang
 349   | cGhcWithNativeCodeGen == "YES" &&
 350         (prefixMatch "i386" cTARGETPLATFORM ||
 351          prefixMatch "sparc" cTARGETPLATFORM ||
 352          prefixMatch "powerpc" cTARGETPLATFORM)   =  HscAsm
 353   | otherwise                                   =  HscC
 354
 355 defaultDynFlags = DynFlags {
 356   coreToDo = Nothing, stgToDo = [],
 357   hscLang = defaultHscLang,
 358   hscOutName = "",
 359   hscStubHOutName = "", hscStubCOutName = "",
 360   extCoreName = "",
 361   verbosity             = 0,
 362   optLevel              = 0,
 363   maxSimplIterations    = 4,
 364   ruleCheck             = Nothing,
 365   cppFlag               = False,
 366   ppFlag                = False,
 367   stolen_x86_regs       = 4,
 368   cmdlineHcIncludes     = [],
 369   opt_L                 = [],
 370   opt_P                 = [],
 371   opt_F                 = [],
 372   opt_c                 = [],
 373   opt_a                 = [],
 374   opt_m                 = [],
 375 #ifdef ILX
 376   opt_I                 = [],
 377   opt_i                 = [],
 378 #endif
 379   flags = [
 380             Opt_Generics,
 381                         -- Generating the helper-functions for
 382                         -- generics is now on by default
 383             Opt_Strictness,
 384                         -- strictness is on by default, but this only
 385                         -- applies to -O.
 386             Opt_CSE,
 387                         -- similarly for CSE.
 388             Opt_DoLambdaEtaExpansion,
 389                         -- This one is important for a tiresome reason:
 390                         -- we want to make sure that the bindings for data
 391                         -- constructors are eta-expanded.  This is probably
 392                         -- a good thing anyway, but it seems fragile.
 393
 394             -- and the default no-optimisation options:
 395             Opt_IgnoreInterfacePragmas,
 396             Opt_OmitInterfacePragmas
 397
 398            ] ++ standardWarnings,
 399   }
 400
 401 {-
 402     Verbosity levels:
 403
 404     0   |   print errors & warnings only
 405     1   |   minimal verbosity: print "compiling M ... done." for each module.
 406     2   |   equivalent to -dshow-passes
 407     3   |   equivalent to existing "ghc -v"
 408     4   |   "ghc -v -ddump-most"
 409     5   |   "ghc -v -ddump-all"
 410 -}
 411
 412 dopt :: DynFlag -> DynFlags -> Bool
 413 dopt f dflags  = f `elem` (flags dflags)
 414
 415 dopt_CoreToDo :: DynFlags -> Maybe [CoreToDo]
 416 dopt_CoreToDo = coreToDo
 417
 418 dopt_StgToDo :: DynFlags -> [StgToDo]
 419 dopt_StgToDo = stgToDo
 420
 421 dopt_OutName :: DynFlags -> String
 422 dopt_OutName = hscOutName
 423
 424 dopt_HscLang :: DynFlags -> HscLang
 425 dopt_HscLang = hscLang
 426
 427 dopt_set :: DynFlags -> DynFlag -> DynFlags
 428 dopt_set dfs f = dfs{ flags = f : flags dfs }
 429
 430 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 431 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 432
 433 getOpts :: (DynFlags -> [a]) -> IO [a]
 434         -- We add to the options from the front, so we need to reverse the list
 435 getOpts opts = dynFlag opts >>= return . reverse
 436
 437 -- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags
 438 -- (-fvia-C, -fasm, -filx respectively).
 439 setLang l = updDynFlags (\ dfs -> case hscLang dfs of
 440                                         HscC   -> dfs{ hscLang = l }
 441                                         HscAsm -> dfs{ hscLang = l }
 442                                         HscILX -> dfs{ hscLang = l }
 443                                         _      -> dfs)
 444
 445 getVerbFlag = do
 446    verb <- dynFlag verbosity
 447    if verb >= 3  then return  "-v" else return ""
 448
 449 -----------------------------------------------------------------------------
 450 -- Setting the optimisation level
 451
 452 setOptLevel :: Int -> IO ()
 453 setOptLevel n
 454   = do dflags <- getDynFlags
 455        if hscLang dflags == HscInterpreted && n > 0
 456           then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
 457           else updDynFlags (setOptLevel' n)
 458
 459 setOptLevel' n dfs
 460   = if (n >= 1)
 461      then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O
 462      else dfs2{ optLevel = n }
 463   where
 464    dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
 465    dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
 466
 467    extra_dopts
 468         | n == 0    = opt_0_dopts
 469         | otherwise = opt_1_dopts
 470
 471    remove_dopts
 472         | n == 0    = opt_1_dopts
 473         | otherwise = opt_0_dopts
 474
 475 opt_0_dopts =  [
 476         Opt_IgnoreInterfacePragmas,
 477         Opt_OmitInterfacePragmas
 478     ]
 479
 480 opt_1_dopts = [
 481         Opt_IgnoreAsserts,
 482         Opt_DoEtaReduction,
 483         Opt_CaseMerge
 484      ]
 485
 486 -- Core-to-core phases:
 487
 488 buildCoreToDo :: DynFlags -> [CoreToDo]
 489 buildCoreToDo dflags = core_todo
 490   where
 491     opt_level  = optLevel dflags
 492     max_iter   = maxSimplIterations dflags
 493     strictness = dopt Opt_Strictness dflags
 494     cse        = dopt Opt_CSE dflags
 495     rule_check = ruleCheck dflags
 496
 497     core_todo =
 498      if opt_level == 0 then
 499       [
 500         CoreDoSimplify (SimplPhase 0) [
 501             MaxSimplifierIterations max_iter
 502         ]
 503       ]
 504
 505      else {- opt_level >= 1 -} [
 506
 507         -- initial simplify: mk specialiser happy: minimum effort please
 508         CoreDoSimplify SimplGently [
 509                         --      Simplify "gently"
 510                         -- Don't inline anything till full laziness has bitten
 511                         -- In particular, inlining wrappers inhibits floating
 512                         -- e.g. ...(case f x of ...)...
 513                         --  ==> ...(case (case x of I# x# -> fw x#) of ...)...
 514                         --  ==> ...(case x of I# x# -> case fw x# of ...)...
 515                         -- and now the redex (f x) isn't floatable any more
 516                         -- Similarly, don't apply any rules until after full
 517                         -- laziness.  Notably, list fusion can prevent floating.
 518
 519             NoCaseOfCase,
 520                         -- Don't do case-of-case transformations.
 521                         -- This makes full laziness work better
 522             MaxSimplifierIterations max_iter
 523         ],
 524
 525         -- Specialisation is best done before full laziness
 526         -- so that overloaded functions have all their dictionary lambdas manifest
 527         CoreDoSpecialising,
 528
 529         CoreDoFloatOutwards (FloatOutSw False False),
 530         CoreDoFloatInwards,
 531
 532         CoreDoSimplify (SimplPhase 2) [
 533                 -- Want to run with inline phase 2 after the specialiser to give
 534                 -- maximum chance for fusion to work before we inline build/augment
 535                 -- in phase 1.  This made a difference in 'ansi' where an
 536                 -- overloaded function wasn't inlined till too late.
 537            MaxSimplifierIterations max_iter
 538         ],
 539         case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
 540
 541         CoreDoSimplify (SimplPhase 1) [
 542                 -- Need inline-phase2 here so that build/augment get
 543                 -- inlined.  I found that spectral/hartel/genfft lost some useful
 544                 -- strictness in the function sumcode' if augment is not inlined
 545                 -- before strictness analysis runs
 546            MaxSimplifierIterations max_iter
 547         ],
 548         case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
 549
 550         CoreDoSimplify (SimplPhase 0) [
 551                 -- Phase 0: allow all Ids to be inlined now
 552                 -- This gets foldr inlined before strictness analysis
 553
 554            MaxSimplifierIterations 3
 555                 -- At least 3 iterations because otherwise we land up with
 556                 -- huge dead expressions because of an infelicity in the
 557                 -- simpifier.
 558                 --      let k = BIG in foldr k z xs
 559                 -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
 560                 -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
 561                 -- Don't stop now!
 562
 563         ],
 564         case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 565
 566 #ifdef OLD_STRICTNESS
 567         CoreDoOldStrictness
 568 #endif
 569         if strictness then CoreDoStrictness else CoreDoNothing,
 570         CoreDoWorkerWrapper,
 571         CoreDoGlomBinds,
 572
 573         CoreDoSimplify (SimplPhase 0) [
 574            MaxSimplifierIterations max_iter
 575         ],
 576
 577         CoreDoFloatOutwards (FloatOutSw False   -- Not lambdas
 578                                         True),  -- Float constants
 579                 -- nofib/spectral/hartel/wang doubles in speed if you
 580                 -- do full laziness late in the day.  It only happens
 581                 -- after fusion and other stuff, so the early pass doesn't
 582                 -- catch it.  For the record, the redex is
 583                 --        f_el22 (f_el21 r_midblock)
 584
 585
 586         -- We want CSE to follow the final full-laziness pass, because it may
 587         -- succeed in commoning up things floated out by full laziness.
 588         -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
 589
 590         if cse then CoreCSE else CoreDoNothing,
 591
 592         CoreDoFloatInwards,
 593
 594 -- Case-liberation for -O2.  This should be after
 595 -- strictness analysis and the simplification which follows it.
 596
 597         case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
 598
 599         if opt_level >= 2 then
 600            CoreLiberateCase
 601         else
 602            CoreDoNothing,
 603         if opt_level >= 2 then
 604            CoreDoSpecConstr
 605         else
 606            CoreDoNothing,
 607
 608         -- Final clean-up simplification:
 609         CoreDoSimplify (SimplPhase 0) [
 610           MaxSimplifierIterations max_iter
 611         ]
 612      ]
 613
 614 -- --------------------------------------------------------------------------
 615 -- Mess about with the mutable variables holding the dynamic arguments
 616
 617 -- v_InitDynFlags
 618 --      is the "baseline" dynamic flags, initialised from
 619 --      the defaults and command line options, and updated by the
 620 --      ':s' command in GHCi.
 621 --
 622 -- v_DynFlags
 623 --      is the dynamic flags for the current compilation.  It is reset
 624 --      to the value of v_InitDynFlags before each compilation, then
 625 --      updated by reading any OPTIONS pragma in the current module.
 626
 627 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 628 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 629
 630 setDynFlags :: DynFlags -> IO ()
 631 setDynFlags dfs = writeIORef v_DynFlags dfs
 632
 633 saveDynFlags :: IO ()
 634 saveDynFlags = do dfs <- readIORef v_DynFlags
 635                   writeIORef v_InitDynFlags dfs
 636
 637 restoreDynFlags :: IO DynFlags
 638 restoreDynFlags = do dfs <- readIORef v_InitDynFlags
 639                      writeIORef v_DynFlags dfs
 640                      return dfs
 641
 642 getDynFlags :: IO DynFlags
 643 getDynFlags = readIORef v_DynFlags
 644
 645 updDynFlags :: (DynFlags -> DynFlags) -> IO ()
 646 updDynFlags f = do dfs <- readIORef v_DynFlags
 647                    writeIORef v_DynFlags (f dfs)
 648
 649 dynFlag :: (DynFlags -> a) -> IO a
 650 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 651
 652 setDynFlag, unSetDynFlag :: DynFlag -> IO ()
 653 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 654 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 655 \end{code}
 656
 657
 658 %************************************************************************
 659 %*                                                                      *
 660 \subsection{Warnings}
 661 %*                                                                      *
 662 %************************************************************************
 663
 664 \begin{code}
 665 standardWarnings
 666     = [ Opt_WarnDeprecations,
 667         Opt_WarnOverlappingPatterns,
 668         Opt_WarnMissingFields,
 669         Opt_WarnMissingMethods,
 670         Opt_WarnDuplicateExports
 671       ]
 672
 673 minusWOpts
 674     = standardWarnings ++
 675       [ Opt_WarnUnusedBinds,
 676         Opt_WarnUnusedMatches,
 677         Opt_WarnUnusedImports,
 678         Opt_WarnIncompletePatterns,
 679         Opt_WarnMisc
 680       ]
 681
 682 minusWallOpts
 683     = minusWOpts ++
 684       [ Opt_WarnTypeDefaults,
 685         Opt_WarnNameShadowing,
 686         Opt_WarnMissingSigs,
 687         Opt_WarnHiShadows
 688       ]
 689 \end{code}
 690
 691 %************************************************************************
 692 %*                                                                      *
 693 \subsection{Classifying command-line options}
 694 %*                                                                      *
 695 %************************************************************************
 696
 697 \begin{code}
 698 -- v_Statis_hsc_opts is here to avoid a circular dependency with
 699 -- main/DriverState.
 700 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 701
 702 lookUp           :: FastString -> Bool
 703 lookup_int       :: String -> Maybe Int
 704 lookup_def_int   :: String -> Int -> Int
 705 lookup_def_float :: String -> Float -> Float
 706 lookup_str       :: String -> Maybe String
 707
 708 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
 709 packed_static_opts   = map mkFastString unpacked_static_opts
 710
 711 lookUp     sw = sw `elem` packed_static_opts
 712
 713 lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
 714
 715 lookup_int sw = case (lookup_str sw) of
 716                   Nothing -> Nothing
 717                   Just xx -> Just (read xx)
 718
 719 lookup_def_int sw def = case (lookup_str sw) of
 720                             Nothing -> def              -- Use default
 721                             Just xx -> read xx
 722
 723 lookup_def_float sw def = case (lookup_str sw) of
 724                             Nothing -> def              -- Use default
 725                             Just xx -> read xx
 726
 727
 728 {-
 729  Putting the compiler options into temporary at-files
 730  may turn out to be necessary later on if we turn hsc into
 731  a pure Win32 application where I think there's a command-line
 732  length limit of 255. unpacked_opts understands the @ option.
 733
 734 unpacked_opts :: [String]
 735 unpacked_opts =
 736   concat $
 737   map (expandAts) $
 738   map unpackFS argv  -- NOT ARGV any more: v_Static_hsc_opts
 739   where
 740    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 741    expandAts l = [l]
 742 -}
 743 \end{code}
 744
 745 %************************************************************************
 746 %*                                                                      *
 747 \subsection{Static options}
 748 %*                                                                      *
 749 %************************************************************************
 750
 751 \begin{code}
 752 -- debugging opts
 753 opt_PprStyle_NoPrags            = lookUp  FSLIT("-dppr-noprags")
 754 opt_PprStyle_Debug              = lookUp  FSLIT("-dppr-debug")
 755 opt_PprStyle_RawTypes           = lookUp  FSLIT("-dppr-rawtypes")
 756 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 757
 758 -- profiling opts
 759 opt_AutoSccsOnAllToplevs        = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
 760 opt_AutoSccsOnExportedToplevs   = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
 761 opt_AutoSccsOnIndividualCafs    = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
 762 opt_AutoSccsOnDicts             = lookUp  FSLIT("-fauto-sccs-on-dicts")
 763 opt_SccProfilingOn              = lookUp  FSLIT("-fscc-profiling")
 764 opt_DoTickyProfiling            = lookUp  FSLIT("-fticky-ticky")
 765
 766 -- language opts
 767 opt_AllStrict                   = lookUp  FSLIT("-fall-strict")
 768 opt_DictsStrict                 = lookUp  FSLIT("-fdicts-strict")
 769 opt_IrrefutableTuples           = lookUp  FSLIT("-firrefutable-tuples")
 770 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 771 opt_NumbersStrict               = lookUp  FSLIT("-fnumbers-strict")
 772 opt_Parallel                    = lookUp  FSLIT("-fparallel")
 773 opt_SMP                         = lookUp  FSLIT("-fsmp")
 774 opt_Flatten                     = lookUp  FSLIT("-fflatten")
 775
 776 -- optimisation opts
 777 opt_NoMethodSharing             = lookUp  FSLIT("-fno-method-sharing")
 778 opt_DoSemiTagging               = lookUp  FSLIT("-fsemi-tagging")
 779 opt_CprOff                      = lookUp  FSLIT("-fcpr-off")
 780 opt_RulesOff                    = lookUp  FSLIT("-frules-off")
 781         -- Switch off CPR analysis in the new demand analyser
 782 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 783 opt_MaxWorkerArgs               = lookup_def_int "-fmax-worker-args" (10::Int)
 784
 785 {-
 786    The optional '-inpackage=P' flag tells what package
 787    we are compiling this module for.
 788    The Prelude, for example is compiled with '-inpackage std'
 789 -}
 790 opt_InPackage                   = case lookup_str "-inpackage=" of
 791                                     Just p  -> mkFastString p
 792                                     Nothing -> FSLIT("Main")    -- The package name if none is specified
 793
 794 opt_EmitCExternDecls            = lookUp  FSLIT("-femit-extern-decls")
 795 opt_EnsureSplittableC           = lookUp  FSLIT("-fglobalise-toplev-names")
 796 opt_GranMacros                  = lookUp  FSLIT("-fgransim")
 797 opt_HiVersion                   = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
 798 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 799 opt_NoHiCheck                   = lookUp  FSLIT("-fno-hi-version-check")
 800 opt_OmitBlackHoling             = lookUp  FSLIT("-dno-black-holing")
 801 opt_RuntimeTypes                = lookUp  FSLIT("-fruntime-types")
 802
 803 -- Simplifier switches
 804 opt_SimplNoPreInlining          = lookUp  FSLIT("-fno-pre-inlining")
 805         -- NoPreInlining is there just to see how bad things
 806         -- get if you don't do it!
 807 opt_SimplExcessPrecision        = lookUp  FSLIT("-fexcess-precision")
 808
 809 -- Unfolding control
 810 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 811 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 812 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 813 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 814 opt_UF_UpdateInPlace            = lookUp  FSLIT("-funfolding-update-in-place")
 815
 816 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 817 opt_UF_DearOp   = ( 4 :: Int)
 818
 819 opt_NoPruneDecls                = lookUp  FSLIT("-fno-prune-decls")
 820 opt_Static                      = lookUp  FSLIT("-static")
 821 opt_Unregisterised              = lookUp  FSLIT("-funregisterised")
 822 opt_EmitExternalCore            = lookUp  FSLIT("-fext-core")
 823 \end{code}
 824
 825 %************************************************************************
 826 %*                                                                      *
 827 \subsection{List of static hsc flags}
 828 %*                                                                      *
 829 %************************************************************************
 830
 831 \begin{code}
 832 isStaticHscFlag f =
 833   f `elem` [
 834         "fauto-sccs-on-all-toplevs",
 835         "fauto-sccs-on-exported-toplevs",
 836         "fauto-sccs-on-individual-cafs",
 837         "fauto-sccs-on-dicts",
 838         "fscc-profiling",
 839         "fticky-ticky",
 840         "fall-strict",
 841         "fdicts-strict",
 842         "firrefutable-tuples",
 843         "fnumbers-strict",
 844         "fparallel",
 845         "fsmp",
 846         "fflatten",
 847         "fsemi-tagging",
 848         "flet-no-escape",
 849         "femit-extern-decls",
 850         "fglobalise-toplev-names",
 851         "fgransim",
 852         "fno-hi-version-check",
 853         "dno-black-holing",
 854         "fno-method-sharing",
 855         "fruntime-types",
 856         "fno-pre-inlining",
 857         "fexcess-precision",
 858         "funfolding-update-in-place",
 859         "fno-prune-decls",
 860         "static",
 861         "funregisterised",
 862         "fext-core",
 863         "frule-check",
 864         "frules-off",
 865         "fcpr-off"
 866         ]
 867   || any (flip prefixMatch f) [
 868         "fcontext-stack",
 869         "fliberate-case-threshold",
 870         "fmax-worker-args",
 871         "fhistory-size",
 872         "funfolding-creation-threshold",
 873         "funfolding-use-threshold",
 874         "funfolding-fun-discount",
 875         "funfolding-keeness-factor"
 876      ]
 877 \end{code}
 878
 879 %************************************************************************
 880 %*                                                                      *
 881 \subsection{Misc functions for command-line options}
 882 %*                                                                      *
 883 %************************************************************************
 884
 885
 886
 887 \begin{code}
 888 startsWith :: String -> String -> Maybe String
 889 -- startsWith pfx (pfx++rest) = Just rest
 890
 891 startsWith []     str = Just str
 892 startsWith (c:cs) (s:ss)
 893   = if c /= s then Nothing else startsWith cs ss
 894 startsWith  _     []  = Nothing
 895
 896 endsWith  :: String -> String -> Maybe String
 897 endsWith cs ss
 898   = case (startsWith (reverse cs) (reverse ss)) of
 899       Nothing -> Nothing
 900       Just rs -> Just (reverse rs)
 901 \end{code}