ghc/compiler/main/CmdLineOpts.lhs

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