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