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