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(..),
  10         SimplifierSwitch(..), isAmongSimpl,
  11         StgToDo(..),
  12         SwitchResult(..),
  13
  14         HscLang(..),
  15         DynFlag(..),    -- needed non-abstractly by DriverFlags
  16         DynFlags(..),
  17
  18         v_Static_hsc_opts,
  19
  20         intSwitchSet,
  21         switchIsOn,
  22         isStaticHscFlag,
  23
  24         -- Manipulating DynFlags
  25         defaultDynFlags,                -- DynFlags
  26         dopt,                           -- DynFlag -> DynFlags -> Bool
  27         dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
  28         dopt_CoreToDo,                  -- DynFlags -> [CoreToDo]
  29         dopt_StgToDo,                   -- DynFlags -> [StgToDo]
  30         dopt_HscLang,                   -- DynFlags -> HscLang
  31         dopt_OutName,                   -- DynFlags -> String
  32
  33         -- Manipulating the DynFlags state
  34         getDynFlags,                    -- IO DynFlags
  35         setDynFlags,                    -- DynFlags -> IO ()
  36         updDynFlags,                    -- (DynFlags -> DynFlags) -> IO ()
  37         dynFlag,                        -- (DynFlags -> a) -> IO a
  38         setDynFlag, unSetDynFlag,       -- DynFlag -> IO ()
  39         saveDynFlags,                   -- IO ()
  40         restoreDynFlags,                -- IO DynFlags
  41
  42         -- sets of warning opts
  43         standardWarnings,
  44         minusWOpts,
  45         minusWallOpts,
  46
  47         -- Output style options
  48         opt_PprStyle_NoPrags,
  49         opt_PprStyle_RawTypes,
  50         opt_PprUserLength,
  51         opt_PprStyle_Debug,
  52
  53         -- profiling opts
  54         opt_AutoSccsOnAllToplevs,
  55         opt_AutoSccsOnExportedToplevs,
  56         opt_AutoSccsOnIndividualCafs,
  57         opt_AutoSccsOnDicts,
  58         opt_SccProfilingOn,
  59         opt_DoTickyProfiling,
  60
  61         -- language opts
  62         opt_AllStrict,
  63         opt_DictsStrict,
  64         opt_MaxContextReductionDepth,
  65         opt_IrrefutableTuples,
  66         opt_NumbersStrict,
  67         opt_Parallel,
  68         opt_SMP,
  69         opt_NoMonomorphismRestriction,
  70         opt_RuntimeTypes,
  71
  72         -- optimisation opts
  73         opt_NoMethodSharing,
  74         opt_DoSemiTagging,
  75         opt_FoldrBuildOn,
  76         opt_LiberateCaseThreshold,
  77         opt_StgDoLetNoEscapes,
  78         opt_UnfoldCasms,
  79         opt_UsageSPOn,
  80         opt_UnboxStrictFields,
  81         opt_SimplNoPreInlining,
  82         opt_SimplDoEtaReduction,
  83         opt_SimplDoLambdaEtaExpansion,
  84         opt_SimplCaseMerge,
  85         opt_SimplExcessPrecision,
  86         opt_MaxWorkerArgs,
  87
  88         -- Unfolding control
  89         opt_UF_CreationThreshold,
  90         opt_UF_UseThreshold,
  91         opt_UF_FunAppDiscount,
  92         opt_UF_KeenessFactor,
  93         opt_UF_UpdateInPlace,
  94         opt_UF_CheapOp,
  95         opt_UF_DearOp,
  96
  97         -- misc opts
  98         opt_InPackage,
  99         opt_EmitCExternDecls,
 100         opt_EnsureSplittableC,
 101         opt_GranMacros,
 102         opt_HiVersion,
 103         opt_HistorySize,
 104         opt_IgnoreAsserts,
 105         opt_IgnoreIfacePragmas,
 106         opt_NoHiCheck,
 107         opt_OmitBlackHoling,
 108         opt_OmitInterfacePragmas,
 109         opt_NoPruneTyDecls,
 110         opt_NoPruneDecls,
 111         opt_Static,
 112         opt_Unregisterised,
 113         opt_EmitExternalCore
 114     ) where
 115
 116 #include "HsVersions.h"
 117
 118 import Array    ( array, (//) )
 119 import GlaExts
 120 import IOExts   ( IORef, readIORef, writeIORef )
 121 import Constants        -- Default values for some flags
 122 import Util
 123 import FastTypes
 124 import Config
 125
 126 import Maybes           ( firstJust )
 127 import Panic            ( panic )
 128
 129 #if __GLASGOW_HASKELL__ < 301
 130 import ArrBase  ( Array(..) )
 131 #else
 132 import PrelArr  ( Array(..) )
 133 #endif
 134 \end{code}
 135
 136 %************************************************************************
 137 %*                                                                      *
 138 \subsection{Command-line options}
 139 %*                                                                      *
 140 %************************************************************************
 141
 142 The hsc command-line options are split into two categories:
 143
 144   - static flags
 145   - dynamic flags
 146
 147 Static flags are represented by top-level values of type Bool or Int,
 148 for example.  They therefore have the same value throughout the
 149 invocation of hsc.
 150
 151 Dynamic flags are represented by an abstract type, DynFlags, which is
 152 passed into hsc by the compilation manager for every compilation.
 153 Dynamic flags are those that change on a per-compilation basis,
 154 perhaps because they may be present in the OPTIONS pragma at the top
 155 of a module.
 156
 157 Other flag-related blurb:
 158
 159 A list of {\em ToDo}s is things to be done in a particular part of
 160 processing.  A (fictitious) example for the Core-to-Core simplifier
 161 might be: run the simplifier, then run the strictness analyser, then
 162 run the simplifier again (three ``todos'').
 163
 164 There are three ``to-do processing centers'' at the moment.  In the
 165 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
 166 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
 167 (\tr{simplStg/SimplStg.lhs}).
 168
 169 %************************************************************************
 170 %*                                                                      *
 171 \subsection{Datatypes associated with command-line options}
 172 %*                                                                      *
 173 %************************************************************************
 174
 175 \begin{code}
 176 data SwitchResult
 177   = SwBool      Bool            -- on/off
 178   | SwString    FAST_STRING     -- nothing or a String
 179   | SwInt       Int             -- nothing or an Int
 180 \end{code}
 181
 182 \begin{code}
 183 data CoreToDo           -- These are diff core-to-core passes,
 184                         -- which may be invoked in any order,
 185                         -- as many times as you like.
 186
 187   = CoreDoSimplify      -- The core-to-core simplifier.
 188         (SimplifierSwitch -> SwitchResult)
 189                         -- Each run of the simplifier can take a different
 190                         -- set of simplifier-specific flags.
 191   | CoreDoFloatInwards
 192   | CoreDoFloatOutwards Bool    -- True <=> float lambdas to top level
 193   | CoreLiberateCase
 194   | CoreDoPrintCore
 195   | CoreDoStaticArgs
 196   | CoreDoStrictness
 197   | CoreDoWorkerWrapper
 198   | CoreDoSpecialising
 199   | CoreDoSpecConstr
 200   | CoreDoUSPInf
 201   | CoreDoCPResult
 202   | CoreDoGlomBinds
 203   | CoreCSE
 204
 205   | CoreDoNothing        -- useful when building up lists of these things
 206 \end{code}
 207
 208 \begin{code}
 209 data StgToDo
 210   = StgDoMassageForProfiling  -- should be (next to) last
 211   -- There's also setStgVarInfo, but its absolute "lastness"
 212   -- is so critical that it is hardwired in (no flag).
 213   | D_stg_stats
 214 \end{code}
 215
 216 \begin{code}
 217 data SimplifierSwitch
 218   = MaxSimplifierIterations Int
 219   | SimplInlinePhase Int
 220   | DontApplyRules
 221   | NoCaseOfCase
 222   | SimplLetToCase
 223 \end{code}
 224
 225 %************************************************************************
 226 %*                                                                      *
 227 \subsection{Dynamic command-line options}
 228 %*                                                                      *
 229 %************************************************************************
 230
 231 \begin{code}
 232 data DynFlag
 233
 234    -- debugging flags
 235    = Opt_D_dump_absC
 236    | Opt_D_dump_asm
 237    | Opt_D_dump_cpranal
 238    | Opt_D_dump_deriv
 239    | Opt_D_dump_ds
 240    | Opt_D_dump_flatC
 241    | Opt_D_dump_foreign
 242    | Opt_D_dump_inlinings
 243    | Opt_D_dump_occur_anal
 244    | Opt_D_dump_parsed
 245    | Opt_D_dump_realC
 246    | Opt_D_dump_rn
 247    | Opt_D_dump_simpl
 248    | Opt_D_dump_simpl_iterations
 249    | Opt_D_dump_spec
 250    | Opt_D_dump_sat
 251    | Opt_D_dump_stg
 252    | Opt_D_dump_stranal
 253    | Opt_D_dump_tc
 254    | Opt_D_dump_types
 255    | Opt_D_dump_rules
 256    | Opt_D_dump_usagesp
 257    | Opt_D_dump_cse
 258    | Opt_D_dump_worker_wrapper
 259    | Opt_D_dump_rn_trace
 260    | Opt_D_dump_rn_stats
 261    | Opt_D_dump_stix
 262    | Opt_D_dump_simpl_stats
 263    | Opt_D_dump_tc_trace
 264    | Opt_D_dump_BCOs
 265    | Opt_D_source_stats
 266    | Opt_D_verbose_core2core
 267    | Opt_D_verbose_stg2stg
 268    | Opt_D_dump_hi
 269    | Opt_D_dump_hi_diffs
 270    | Opt_D_dump_minimal_imports
 271    | Opt_DoCoreLinting
 272    | Opt_DoStgLinting
 273    | Opt_DoUSPLinting
 274
 275    | Opt_WarnDuplicateExports
 276    | Opt_WarnHiShadows
 277    | Opt_WarnIncompletePatterns
 278    | Opt_WarnMissingFields
 279    | Opt_WarnMissingMethods
 280    | Opt_WarnMissingSigs
 281    | Opt_WarnNameShadowing
 282    | Opt_WarnOverlappingPatterns
 283    | Opt_WarnSimplePatterns
 284    | Opt_WarnTypeDefaults
 285    | Opt_WarnUnusedBinds
 286    | Opt_WarnUnusedImports
 287    | Opt_WarnUnusedMatches
 288    | Opt_WarnDeprecations
 289    | Opt_WarnMisc
 290
 291    -- language opts
 292    | Opt_AllowOverlappingInstances
 293    | Opt_AllowUndecidableInstances
 294    | Opt_GlasgowExts
 295    | Opt_Generics
 296    | Opt_NoImplicitPrelude
 297
 298    deriving (Eq)
 299
 300 data DynFlags = DynFlags {
 301   coreToDo              :: [CoreToDo],
 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   cppFlag               :: Bool,        -- preprocess with cpp?
 310   stolen_x86_regs       :: Int,
 311   cmdlineHcIncludes     :: [String],    -- -#includes
 312
 313   -- options for particular phases
 314   opt_L                 :: [String],
 315   opt_P                 :: [String],
 316   opt_c                 :: [String],
 317   opt_a                 :: [String],
 318   opt_m                 :: [String],
 319
 320   -- hsc dynamic flags
 321   flags                 :: [DynFlag]
 322  }
 323
 324 data HscLang
 325   = HscC
 326   | HscAsm
 327   | HscJava
 328   | HscILX
 329   | HscInterpreted
 330     deriving (Eq, Show)
 331
 332 defaultDynFlags = DynFlags {
 333   coreToDo = [], stgToDo = [],
 334   hscLang = HscC,
 335   hscOutName = "",
 336   hscStubHOutName = "", hscStubCOutName = "",
 337   extCoreName = "",
 338   verbosity = 0,
 339   cppFlag               = False,
 340   stolen_x86_regs       = 4,
 341   cmdlineHcIncludes     = [],
 342   opt_L                 = [],
 343   opt_P                 = [],
 344   opt_c                 = [],
 345   opt_a                 = [],
 346   opt_m                 = [],
 347   flags = standardWarnings,
 348   }
 349
 350 {-
 351     Verbosity levels:
 352
 353     0   |   print errors & warnings only
 354     1   |   minimal verbosity: print "compiling M ... done." for each module.
 355     2   |   equivalent to -dshow-passes
 356     3   |   equivalent to existing "ghc -v"
 357     4   |   "ghc -v -ddump-most"
 358     5   |   "ghc -v -ddump-all"
 359 -}
 360
 361 dopt :: DynFlag -> DynFlags -> Bool
 362 dopt f dflags  = f `elem` (flags dflags)
 363
 364 dopt_CoreToDo :: DynFlags -> [CoreToDo]
 365 dopt_CoreToDo = coreToDo
 366
 367 dopt_StgToDo :: DynFlags -> [StgToDo]
 368 dopt_StgToDo = stgToDo
 369
 370 dopt_OutName :: DynFlags -> String
 371 dopt_OutName = hscOutName
 372
 373 dopt_HscLang :: DynFlags -> HscLang
 374 dopt_HscLang = hscLang
 375
 376 dopt_set :: DynFlags -> DynFlag -> DynFlags
 377 dopt_set dfs f = dfs{ flags = f : flags dfs }
 378
 379 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 380 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 381 \end{code}
 382
 383 -----------------------------------------------------------------------------
 384 -- Mess about with the mutable variables holding the dynamic arguments
 385
 386 -- v_InitDynFlags
 387 --      is the "baseline" dynamic flags, initialised from
 388 --      the defaults and command line options, and updated by the
 389 --      ':s' command in GHCi.
 390 --
 391 -- v_DynFlags
 392 --      is the dynamic flags for the current compilation.  It is reset
 393 --      to the value of v_InitDynFlags before each compilation, then
 394 --      updated by reading any OPTIONS pragma in the current module.
 395
 396 \begin{code}
 397 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 398 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 399
 400 setDynFlags :: DynFlags -> IO ()
 401 setDynFlags dfs = writeIORef v_DynFlags dfs
 402
 403 saveDynFlags :: IO ()
 404 saveDynFlags = do dfs <- readIORef v_DynFlags
 405                   writeIORef v_InitDynFlags dfs
 406
 407 restoreDynFlags :: IO DynFlags
 408 restoreDynFlags = do dfs <- readIORef v_InitDynFlags
 409                      writeIORef v_DynFlags dfs
 410                      return dfs
 411
 412 getDynFlags :: IO DynFlags
 413 getDynFlags = readIORef v_DynFlags
 414
 415 updDynFlags :: (DynFlags -> DynFlags) -> IO ()
 416 updDynFlags f = do dfs <- readIORef v_DynFlags
 417                    writeIORef v_DynFlags (f dfs)
 418
 419 dynFlag :: (DynFlags -> a) -> IO a
 420 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 421
 422 setDynFlag, unSetDynFlag :: DynFlag -> IO ()
 423 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 424 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 425 \end{code}
 426
 427
 428 %************************************************************************
 429 %*                                                                      *
 430 \subsection{Warnings}
 431 %*                                                                      *
 432 %************************************************************************
 433
 434 \begin{code}
 435 standardWarnings
 436     = [ Opt_WarnDeprecations,
 437         Opt_WarnOverlappingPatterns,
 438         Opt_WarnMissingFields,
 439         Opt_WarnMissingMethods,
 440         Opt_WarnDuplicateExports
 441       ]
 442
 443 minusWOpts
 444     = standardWarnings ++
 445       [ Opt_WarnUnusedBinds,
 446         Opt_WarnUnusedMatches,
 447         Opt_WarnUnusedImports,
 448         Opt_WarnIncompletePatterns,
 449         Opt_WarnMisc
 450       ]
 451
 452 minusWallOpts
 453     = minusWOpts ++
 454       [ Opt_WarnTypeDefaults,
 455         Opt_WarnNameShadowing,
 456         Opt_WarnMissingSigs,
 457         Opt_WarnHiShadows
 458       ]
 459 \end{code}
 460
 461 %************************************************************************
 462 %*                                                                      *
 463 \subsection{Classifying command-line options}
 464 %*                                                                      *
 465 %************************************************************************
 466
 467 \begin{code}
 468 -- v_Statis_hsc_opts is here to avoid a circular dependency with
 469 -- main/DriverState.
 470 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 471
 472 lookUp           :: FAST_STRING -> Bool
 473 lookup_int       :: String -> Maybe Int
 474 lookup_def_int   :: String -> Int -> Int
 475 lookup_def_float :: String -> Float -> Float
 476 lookup_str       :: String -> Maybe String
 477
 478 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
 479 packed_static_opts   = map _PK_ unpacked_static_opts
 480
 481 lookUp     sw = sw `elem` packed_static_opts
 482
 483 lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
 484
 485 lookup_int sw = case (lookup_str sw) of
 486                   Nothing -> Nothing
 487                   Just xx -> Just (read xx)
 488
 489 lookup_def_int sw def = case (lookup_str sw) of
 490                             Nothing -> def              -- Use default
 491                             Just xx -> read xx
 492
 493 lookup_def_float sw def = case (lookup_str sw) of
 494                             Nothing -> def              -- Use default
 495                             Just xx -> read xx
 496
 497
 498 {-
 499  Putting the compiler options into temporary at-files
 500  may turn out to be necessary later on if we turn hsc into
 501  a pure Win32 application where I think there's a command-line
 502  length limit of 255. unpacked_opts understands the @ option.
 503
 504 unpacked_opts :: [String]
 505 unpacked_opts =
 506   concat $
 507   map (expandAts) $
 508   map _UNPK_ argv  -- NOT ARGV any more: v_Static_hsc_opts
 509   where
 510    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 511    expandAts l = [l]
 512 -}
 513 \end{code}
 514
 515 %************************************************************************
 516 %*                                                                      *
 517 \subsection{Static options}
 518 %*                                                                      *
 519 %************************************************************************
 520
 521 \begin{code}
 522 -- debugging opts
 523 opt_PprStyle_NoPrags            = lookUp  SLIT("-dppr-noprags")
 524 opt_PprStyle_Debug              = lookUp  SLIT("-dppr-debug")
 525 opt_PprStyle_RawTypes           = lookUp  SLIT("-dppr-rawtypes")
 526 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 527
 528 -- profiling opts
 529 opt_AutoSccsOnAllToplevs        = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 530 opt_AutoSccsOnExportedToplevs   = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
 531 opt_AutoSccsOnIndividualCafs    = lookUp  SLIT("-fauto-sccs-on-individual-cafs")
 532 opt_AutoSccsOnDicts             = lookUp  SLIT("-fauto-sccs-on-dicts")
 533 opt_SccProfilingOn              = lookUp  SLIT("-fscc-profiling")
 534 opt_DoTickyProfiling            = lookUp  SLIT("-fticky-ticky")
 535
 536 -- language opts
 537 opt_AllStrict                   = lookUp  SLIT("-fall-strict")
 538 opt_NoMonomorphismRestriction   = lookUp  SLIT("-fno-monomorphism-restriction")
 539 opt_DictsStrict                 = lookUp  SLIT("-fdicts-strict")
 540 opt_IrrefutableTuples           = lookUp  SLIT("-firrefutable-tuples")
 541 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 542 opt_NumbersStrict               = lookUp  SLIT("-fnumbers-strict")
 543 opt_Parallel                    = lookUp  SLIT("-fparallel")
 544 opt_SMP                         = lookUp  SLIT("-fsmp")
 545
 546 -- optimisation opts
 547 opt_NoMethodSharing             = lookUp  SLIT("-fno-method-sharing")
 548 opt_DoSemiTagging               = lookUp  SLIT("-fsemi-tagging")
 549 opt_FoldrBuildOn                = lookUp  SLIT("-ffoldr-build-on")
 550 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 551 opt_StgDoLetNoEscapes           = lookUp  SLIT("-flet-no-escape")
 552 opt_UnfoldCasms                 = lookUp  SLIT("-funfold-casms-in-hi-file")
 553 opt_UsageSPOn                   = lookUp  SLIT("-fusagesp-on")
 554 opt_UnboxStrictFields           = lookUp  SLIT("-funbox-strict-fields")
 555 opt_MaxWorkerArgs               = lookup_def_int "-fmax-worker-args" (10::Int)
 556
 557 {-
 558    The optional '-inpackage=P' flag tells what package
 559    we are compiling this module for.
 560    The Prelude, for example is compiled with '-inpackage std'
 561 -}
 562 opt_InPackage                   = case lookup_str "-inpackage=" of
 563                                     Just p  -> _PK_ p
 564                                     Nothing -> SLIT("Main")     -- The package name if none is specified
 565
 566 opt_EmitCExternDecls            = lookUp  SLIT("-femit-extern-decls")
 567 opt_EnsureSplittableC           = lookUp  SLIT("-fglobalise-toplev-names")
 568 opt_GranMacros                  = lookUp  SLIT("-fgransim")
 569 opt_HiVersion                   = read cProjectVersionInt :: Int
 570 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 571 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 572 opt_IgnoreIfacePragmas          = lookUp  SLIT("-fignore-interface-pragmas")
 573 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 574 opt_OmitBlackHoling             = lookUp  SLIT("-dno-black-holing")
 575 opt_OmitInterfacePragmas        = lookUp  SLIT("-fomit-interface-pragmas")
 576 opt_RuntimeTypes                = lookUp  SLIT("-fruntime-types")
 577
 578 -- Simplifier switches
 579 opt_SimplNoPreInlining          = lookUp  SLIT("-fno-pre-inlining")
 580         -- NoPreInlining is there just to see how bad things
 581         -- get if you don't do it!
 582 opt_SimplDoEtaReduction         = lookUp  SLIT("-fdo-eta-reduction")
 583 opt_SimplDoLambdaEtaExpansion   = lookUp  SLIT("-fdo-lambda-eta-expansion")
 584 opt_SimplCaseMerge              = lookUp  SLIT("-fcase-merge")
 585 opt_SimplExcessPrecision        = lookUp  SLIT("-fexcess-precision")
 586
 587 -- Unfolding control
 588 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 589 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 590 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 591 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 592 opt_UF_UpdateInPlace            = lookUp  SLIT("-funfolding-update-in-place")
 593
 594 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 595 opt_UF_DearOp   = ( 4 :: Int)
 596
 597 opt_NoPruneDecls                = lookUp  SLIT("-fno-prune-decls")
 598 opt_NoPruneTyDecls              = lookUp  SLIT("-fno-prune-tydecls")
 599 opt_Static                      = lookUp  SLIT("-static")
 600 opt_Unregisterised              = lookUp  SLIT("-funregisterised")
 601 opt_EmitExternalCore            = lookUp  SLIT("-fext-core")
 602 \end{code}
 603
 604 %************************************************************************
 605 %*                                                                      *
 606 \subsection{List of static hsc flags}
 607 %*                                                                      *
 608 %************************************************************************
 609
 610 \begin{code}
 611 isStaticHscFlag f =
 612   f `elem` [
 613         "fauto-sccs-on-all-toplevs",
 614         "fauto-sccs-on-exported-toplevs",
 615         "fauto-sccs-on-individual-cafs",
 616         "fauto-sccs-on-dicts",
 617         "fscc-profiling",
 618         "fticky-ticky",
 619         "fall-strict",
 620         "fdicts-strict",
 621         "firrefutable-tuples",
 622         "fnumbers-strict",
 623         "fparallel",
 624         "fsmp",
 625         "fsemi-tagging",
 626         "ffoldr-build-on",
 627         "flet-no-escape",
 628         "funfold-casms-in-hi-file",
 629         "fusagesp-on",
 630         "funbox-strict-fields",
 631         "femit-extern-decls",
 632         "fglobalise-toplev-names",
 633         "fgransim",
 634         "fignore-asserts",
 635         "fignore-interface-pragmas",
 636         "fno-hi-version-check",
 637         "dno-black-holing",
 638         "fno-method-sharing",
 639         "fno-monomorphism-restriction",
 640         "fomit-interface-pragmas",
 641         "fruntime-types",
 642         "fno-pre-inlining",
 643         "fdo-eta-reduction",
 644         "fdo-lambda-eta-expansion",
 645         "fcase-merge",
 646         "fexcess-precision",
 647         "funfolding-update-in-place",
 648         "fno-prune-decls",
 649         "fno-prune-tydecls",
 650         "static",
 651         "funregisterised",
 652         "fext-core"
 653         ]
 654   || any (flip prefixMatch f) [
 655         "fcontext-stack",
 656         "fliberate-case-threshold",
 657         "fmax-worker-args",
 658         "fhistory-size",
 659         "funfolding-creation-threshold",
 660         "funfolding-use-threshold",
 661         "funfolding-fun-discount",
 662         "funfolding-keeness-factor"
 663      ]
 664 \end{code}
 665
 666 %************************************************************************
 667 %*                                                                      *
 668 \subsection{Switch ordering}
 669 %*                                                                      *
 670 %************************************************************************
 671
 672 These things behave just like enumeration types.
 673
 674 \begin{code}
 675 instance Eq SimplifierSwitch where
 676     a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
 677
 678 instance Ord SimplifierSwitch where
 679     a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
 680     a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
 681
 682
 683 tagOf_SimplSwitch (SimplInlinePhase _)          = _ILIT(1)
 684 tagOf_SimplSwitch (MaxSimplifierIterations _)   = _ILIT(2)
 685 tagOf_SimplSwitch DontApplyRules                = _ILIT(3)
 686 tagOf_SimplSwitch SimplLetToCase                = _ILIT(4)
 687 tagOf_SimplSwitch NoCaseOfCase                  = _ILIT(5)
 688
 689 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 690
 691 lAST_SIMPL_SWITCH_TAG = 5
 692 \end{code}
 693
 694 %************************************************************************
 695 %*                                                                      *
 696 \subsection{Switch lookup}
 697 %*                                                                      *
 698 %************************************************************************
 699
 700 \begin{code}
 701 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 702 isAmongSimpl on_switches                -- Switches mentioned later occur *earlier*
 703                                         -- in the list; defaults right at the end.
 704   = let
 705         tidied_on_switches = foldl rm_dups [] on_switches
 706                 -- The fold*l* ensures that we keep the latest switches;
 707                 -- ie the ones that occur earliest in the list.
 708
 709         sw_tbl :: Array Int SwitchResult
 710         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 711                         all_undefined)
 712                  // defined_elems
 713
 714         all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 715
 716         defined_elems = map mk_assoc_elem tidied_on_switches
 717     in
 718     -- (avoid some unboxing, bounds checking, and other horrible things:)
 719 #if __GLASGOW_HASKELL__ < 405
 720     case sw_tbl of { Array bounds_who_needs_'em stuff ->
 721 #else
 722     case sw_tbl of { Array _ _ stuff ->
 723 #endif
 724     \ switch ->
 725         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 726 #if __GLASGOW_HASKELL__ < 400
 727           Lift v -> v
 728 #elif __GLASGOW_HASKELL__ < 403
 729           (# _, v #) -> v
 730 #else
 731           (# v #) -> v
 732 #endif
 733     }
 734   where
 735     mk_assoc_elem k@(MaxSimplifierIterations lvl)
 736         = (iBox (tagOf_SimplSwitch k), SwInt lvl)
 737     mk_assoc_elem k@(SimplInlinePhase n)
 738         = (iBox (tagOf_SimplSwitch k), SwInt n)
 739     mk_assoc_elem k
 740         = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
 741
 742     -- cannot have duplicates if we are going to use the array thing
 743     rm_dups switches_so_far switch
 744       = if switch `is_elem` switches_so_far
 745         then switches_so_far
 746         else switch : switches_so_far
 747       where
 748         sw `is_elem` []     = False
 749         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
 750                             || sw `is_elem` ss
 751 \end{code}
 752
 753
 754 %************************************************************************
 755 %*                                                                      *
 756 \subsection{Misc functions for command-line options}
 757 %*                                                                      *
 758 %************************************************************************
 759
 760
 761 \begin{code}
 762 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 763
 764 switchIsOn lookup_fn switch
 765   = case (lookup_fn switch) of
 766       SwBool False -> False
 767       _            -> True
 768
 769 intSwitchSet :: (switch -> SwitchResult)
 770              -> (Int -> switch)
 771              -> Maybe Int
 772
 773 intSwitchSet lookup_fn switch
 774   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 775       SwInt int -> Just int
 776       _         -> Nothing
 777 \end{code}
 778
 779 \begin{code}
 780 startsWith :: String -> String -> Maybe String
 781 -- startsWith pfx (pfx++rest) = Just rest
 782
 783 startsWith []     str = Just str
 784 startsWith (c:cs) (s:ss)
 785   = if c /= s then Nothing else startsWith cs ss
 786 startsWith  _     []  = Nothing
 787
 788 endsWith  :: String -> String -> Maybe String
 789 endsWith cs ss
 790   = case (startsWith (reverse cs) (reverse ss)) of
 791       Nothing -> Nothing
 792       Just rs -> Just (reverse rs)
 793 \end{code}