ghc/compiler/main/CmdLineOpts.lhs

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