ghc/compiler/main/CmdLineOpts.lhs

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