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