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