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 #ifdef ILX
 320   opt_I                 :: [String],
 321   opt_i                 :: [String],
 322 #endif
 323
 324   -- hsc dynamic flags
 325   flags                 :: [DynFlag]
 326  }
 327
 328 data HscLang
 329   = HscC
 330   | HscAsm
 331   | HscJava
 332   | HscILX
 333   | HscInterpreted
 334     deriving (Eq, Show)
 335
 336 defaultDynFlags = DynFlags {
 337   coreToDo = [], stgToDo = [],
 338   hscLang = HscC,
 339   hscOutName = "",
 340   hscStubHOutName = "", hscStubCOutName = "",
 341   extCoreName = "",
 342   verbosity = 0,
 343   cppFlag               = False,
 344   stolen_x86_regs       = 4,
 345   cmdlineHcIncludes     = [],
 346   opt_L                 = [],
 347   opt_P                 = [],
 348   opt_c                 = [],
 349   opt_a                 = [],
 350   opt_m                 = [],
 351 #ifdef ILX
 352   opt_I                 = [],
 353   opt_i                 = [],
 354 #endif
 355   flags = standardWarnings,
 356   }
 357
 358 {-
 359     Verbosity levels:
 360
 361     0   |   print errors & warnings only
 362     1   |   minimal verbosity: print "compiling M ... done." for each module.
 363     2   |   equivalent to -dshow-passes
 364     3   |   equivalent to existing "ghc -v"
 365     4   |   "ghc -v -ddump-most"
 366     5   |   "ghc -v -ddump-all"
 367 -}
 368
 369 dopt :: DynFlag -> DynFlags -> Bool
 370 dopt f dflags  = f `elem` (flags dflags)
 371
 372 dopt_CoreToDo :: DynFlags -> [CoreToDo]
 373 dopt_CoreToDo = coreToDo
 374
 375 dopt_StgToDo :: DynFlags -> [StgToDo]
 376 dopt_StgToDo = stgToDo
 377
 378 dopt_OutName :: DynFlags -> String
 379 dopt_OutName = hscOutName
 380
 381 dopt_HscLang :: DynFlags -> HscLang
 382 dopt_HscLang = hscLang
 383
 384 dopt_set :: DynFlags -> DynFlag -> DynFlags
 385 dopt_set dfs f = dfs{ flags = f : flags dfs }
 386
 387 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 388 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
 389 \end{code}
 390
 391 -----------------------------------------------------------------------------
 392 -- Mess about with the mutable variables holding the dynamic arguments
 393
 394 -- v_InitDynFlags
 395 --      is the "baseline" dynamic flags, initialised from
 396 --      the defaults and command line options, and updated by the
 397 --      ':s' command in GHCi.
 398 --
 399 -- v_DynFlags
 400 --      is the dynamic flags for the current compilation.  It is reset
 401 --      to the value of v_InitDynFlags before each compilation, then
 402 --      updated by reading any OPTIONS pragma in the current module.
 403
 404 \begin{code}
 405 GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
 406 GLOBAL_VAR(v_DynFlags,     defaultDynFlags, DynFlags)
 407
 408 setDynFlags :: DynFlags -> IO ()
 409 setDynFlags dfs = writeIORef v_DynFlags dfs
 410
 411 saveDynFlags :: IO ()
 412 saveDynFlags = do dfs <- readIORef v_DynFlags
 413                   writeIORef v_InitDynFlags dfs
 414
 415 restoreDynFlags :: IO DynFlags
 416 restoreDynFlags = do dfs <- readIORef v_InitDynFlags
 417                      writeIORef v_DynFlags dfs
 418                      return dfs
 419
 420 getDynFlags :: IO DynFlags
 421 getDynFlags = readIORef v_DynFlags
 422
 423 updDynFlags :: (DynFlags -> DynFlags) -> IO ()
 424 updDynFlags f = do dfs <- readIORef v_DynFlags
 425                    writeIORef v_DynFlags (f dfs)
 426
 427 dynFlag :: (DynFlags -> a) -> IO a
 428 dynFlag f = do dflags <- readIORef v_DynFlags; return (f dflags)
 429
 430 setDynFlag, unSetDynFlag :: DynFlag -> IO ()
 431 setDynFlag f   = updDynFlags (\dfs -> dopt_set dfs f)
 432 unSetDynFlag f = updDynFlags (\dfs -> dopt_unset dfs f)
 433 \end{code}
 434
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsection{Warnings}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 \begin{code}
 443 standardWarnings
 444     = [ Opt_WarnDeprecations,
 445         Opt_WarnOverlappingPatterns,
 446         Opt_WarnMissingFields,
 447         Opt_WarnMissingMethods,
 448         Opt_WarnDuplicateExports
 449       ]
 450
 451 minusWOpts
 452     = standardWarnings ++
 453       [ Opt_WarnUnusedBinds,
 454         Opt_WarnUnusedMatches,
 455         Opt_WarnUnusedImports,
 456         Opt_WarnIncompletePatterns,
 457         Opt_WarnMisc
 458       ]
 459
 460 minusWallOpts
 461     = minusWOpts ++
 462       [ Opt_WarnTypeDefaults,
 463         Opt_WarnNameShadowing,
 464         Opt_WarnMissingSigs,
 465         Opt_WarnHiShadows
 466       ]
 467 \end{code}
 468
 469 %************************************************************************
 470 %*                                                                      *
 471 \subsection{Classifying command-line options}
 472 %*                                                                      *
 473 %************************************************************************
 474
 475 \begin{code}
 476 -- v_Statis_hsc_opts is here to avoid a circular dependency with
 477 -- main/DriverState.
 478 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 479
 480 lookUp           :: FAST_STRING -> Bool
 481 lookup_int       :: String -> Maybe Int
 482 lookup_def_int   :: String -> Int -> Int
 483 lookup_def_float :: String -> Float -> Float
 484 lookup_str       :: String -> Maybe String
 485
 486 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
 487 packed_static_opts   = map _PK_ unpacked_static_opts
 488
 489 lookUp     sw = sw `elem` packed_static_opts
 490
 491 lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
 492
 493 lookup_int sw = case (lookup_str sw) of
 494                   Nothing -> Nothing
 495                   Just xx -> Just (read xx)
 496
 497 lookup_def_int sw def = case (lookup_str sw) of
 498                             Nothing -> def              -- Use default
 499                             Just xx -> read xx
 500
 501 lookup_def_float sw def = case (lookup_str sw) of
 502                             Nothing -> def              -- Use default
 503                             Just xx -> read xx
 504
 505
 506 {-
 507  Putting the compiler options into temporary at-files
 508  may turn out to be necessary later on if we turn hsc into
 509  a pure Win32 application where I think there's a command-line
 510  length limit of 255. unpacked_opts understands the @ option.
 511
 512 unpacked_opts :: [String]
 513 unpacked_opts =
 514   concat $
 515   map (expandAts) $
 516   map _UNPK_ argv  -- NOT ARGV any more: v_Static_hsc_opts
 517   where
 518    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
 519    expandAts l = [l]
 520 -}
 521 \end{code}
 522
 523 %************************************************************************
 524 %*                                                                      *
 525 \subsection{Static options}
 526 %*                                                                      *
 527 %************************************************************************
 528
 529 \begin{code}
 530 -- debugging opts
 531 opt_PprStyle_NoPrags            = lookUp  SLIT("-dppr-noprags")
 532 opt_PprStyle_Debug              = lookUp  SLIT("-dppr-debug")
 533 opt_PprStyle_RawTypes           = lookUp  SLIT("-dppr-rawtypes")
 534 opt_PprUserLength               = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 535
 536 -- profiling opts
 537 opt_AutoSccsOnAllToplevs        = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 538 opt_AutoSccsOnExportedToplevs   = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
 539 opt_AutoSccsOnIndividualCafs    = lookUp  SLIT("-fauto-sccs-on-individual-cafs")
 540 opt_AutoSccsOnDicts             = lookUp  SLIT("-fauto-sccs-on-dicts")
 541 opt_SccProfilingOn              = lookUp  SLIT("-fscc-profiling")
 542 opt_DoTickyProfiling            = lookUp  SLIT("-fticky-ticky")
 543
 544 -- language opts
 545 opt_AllStrict                   = lookUp  SLIT("-fall-strict")
 546 opt_NoMonomorphismRestriction   = lookUp  SLIT("-fno-monomorphism-restriction")
 547 opt_DictsStrict                 = lookUp  SLIT("-fdicts-strict")
 548 opt_IrrefutableTuples           = lookUp  SLIT("-firrefutable-tuples")
 549 opt_MaxContextReductionDepth    = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 550 opt_NumbersStrict               = lookUp  SLIT("-fnumbers-strict")
 551 opt_Parallel                    = lookUp  SLIT("-fparallel")
 552 opt_SMP                         = lookUp  SLIT("-fsmp")
 553
 554 -- optimisation opts
 555 opt_NoMethodSharing             = lookUp  SLIT("-fno-method-sharing")
 556 opt_DoSemiTagging               = lookUp  SLIT("-fsemi-tagging")
 557 opt_FoldrBuildOn                = lookUp  SLIT("-ffoldr-build-on")
 558 opt_LiberateCaseThreshold       = lookup_def_int "-fliberate-case-threshold" (10::Int)
 559 opt_StgDoLetNoEscapes           = lookUp  SLIT("-flet-no-escape")
 560 opt_UnfoldCasms                 = lookUp  SLIT("-funfold-casms-in-hi-file")
 561 opt_UsageSPOn                   = lookUp  SLIT("-fusagesp-on")
 562 opt_UnboxStrictFields           = lookUp  SLIT("-funbox-strict-fields")
 563 opt_MaxWorkerArgs               = lookup_def_int "-fmax-worker-args" (10::Int)
 564
 565 {-
 566    The optional '-inpackage=P' flag tells what package
 567    we are compiling this module for.
 568    The Prelude, for example is compiled with '-inpackage std'
 569 -}
 570 opt_InPackage                   = case lookup_str "-inpackage=" of
 571                                     Just p  -> _PK_ p
 572                                     Nothing -> SLIT("Main")     -- The package name if none is specified
 573
 574 opt_EmitCExternDecls            = lookUp  SLIT("-femit-extern-decls")
 575 opt_EnsureSplittableC           = lookUp  SLIT("-fglobalise-toplev-names")
 576 opt_GranMacros                  = lookUp  SLIT("-fgransim")
 577 opt_HiVersion                   = read cProjectVersionInt :: Int
 578 opt_HistorySize                 = lookup_def_int "-fhistory-size" 20
 579 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 580 opt_IgnoreIfacePragmas          = lookUp  SLIT("-fignore-interface-pragmas")
 581 opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 582 opt_OmitBlackHoling             = lookUp  SLIT("-dno-black-holing")
 583 opt_OmitInterfacePragmas        = lookUp  SLIT("-fomit-interface-pragmas")
 584 opt_RuntimeTypes                = lookUp  SLIT("-fruntime-types")
 585
 586 -- Simplifier switches
 587 opt_SimplNoPreInlining          = lookUp  SLIT("-fno-pre-inlining")
 588         -- NoPreInlining is there just to see how bad things
 589         -- get if you don't do it!
 590 opt_SimplDoEtaReduction         = lookUp  SLIT("-fdo-eta-reduction")
 591 opt_SimplDoLambdaEtaExpansion   = lookUp  SLIT("-fdo-lambda-eta-expansion")
 592 opt_SimplCaseMerge              = lookUp  SLIT("-fcase-merge")
 593 opt_SimplExcessPrecision        = lookUp  SLIT("-fexcess-precision")
 594
 595 -- Unfolding control
 596 opt_UF_CreationThreshold        = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 597 opt_UF_UseThreshold             = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
 598 opt_UF_FunAppDiscount           = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 599 opt_UF_KeenessFactor            = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 600 opt_UF_UpdateInPlace            = lookUp  SLIT("-funfolding-update-in-place")
 601
 602 opt_UF_CheapOp  = ( 1 :: Int)   -- Only one instruction; and the args are charged for
 603 opt_UF_DearOp   = ( 4 :: Int)
 604
 605 opt_NoPruneDecls                = lookUp  SLIT("-fno-prune-decls")
 606 opt_NoPruneTyDecls              = lookUp  SLIT("-fno-prune-tydecls")
 607 opt_Static                      = lookUp  SLIT("-static")
 608 opt_Unregisterised              = lookUp  SLIT("-funregisterised")
 609 opt_EmitExternalCore            = lookUp  SLIT("-fext-core")
 610 \end{code}
 611
 612 %************************************************************************
 613 %*                                                                      *
 614 \subsection{List of static hsc flags}
 615 %*                                                                      *
 616 %************************************************************************
 617
 618 \begin{code}
 619 isStaticHscFlag f =
 620   f `elem` [
 621         "fauto-sccs-on-all-toplevs",
 622         "fauto-sccs-on-exported-toplevs",
 623         "fauto-sccs-on-individual-cafs",
 624         "fauto-sccs-on-dicts",
 625         "fscc-profiling",
 626         "fticky-ticky",
 627         "fall-strict",
 628         "fdicts-strict",
 629         "firrefutable-tuples",
 630         "fnumbers-strict",
 631         "fparallel",
 632         "fsmp",
 633         "fsemi-tagging",
 634         "ffoldr-build-on",
 635         "flet-no-escape",
 636         "funfold-casms-in-hi-file",
 637         "fusagesp-on",
 638         "funbox-strict-fields",
 639         "femit-extern-decls",
 640         "fglobalise-toplev-names",
 641         "fgransim",
 642         "fignore-asserts",
 643         "fignore-interface-pragmas",
 644         "fno-hi-version-check",
 645         "dno-black-holing",
 646         "fno-method-sharing",
 647         "fno-monomorphism-restriction",
 648         "fomit-interface-pragmas",
 649         "fruntime-types",
 650         "fno-pre-inlining",
 651         "fdo-eta-reduction",
 652         "fdo-lambda-eta-expansion",
 653         "fcase-merge",
 654         "fexcess-precision",
 655         "funfolding-update-in-place",
 656         "fno-prune-decls",
 657         "fno-prune-tydecls",
 658         "static",
 659         "funregisterised",
 660         "fext-core"
 661         ]
 662   || any (flip prefixMatch f) [
 663         "fcontext-stack",
 664         "fliberate-case-threshold",
 665         "fmax-worker-args",
 666         "fhistory-size",
 667         "funfolding-creation-threshold",
 668         "funfolding-use-threshold",
 669         "funfolding-fun-discount",
 670         "funfolding-keeness-factor"
 671      ]
 672 \end{code}
 673
 674 %************************************************************************
 675 %*                                                                      *
 676 \subsection{Switch ordering}
 677 %*                                                                      *
 678 %************************************************************************
 679
 680 These things behave just like enumeration types.
 681
 682 \begin{code}
 683 instance Eq SimplifierSwitch where
 684     a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
 685
 686 instance Ord SimplifierSwitch where
 687     a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
 688     a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
 689
 690
 691 tagOf_SimplSwitch (SimplInlinePhase _)          = _ILIT(1)
 692 tagOf_SimplSwitch (MaxSimplifierIterations _)   = _ILIT(2)
 693 tagOf_SimplSwitch DontApplyRules                = _ILIT(3)
 694 tagOf_SimplSwitch SimplLetToCase                = _ILIT(4)
 695 tagOf_SimplSwitch NoCaseOfCase                  = _ILIT(5)
 696
 697 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 698
 699 lAST_SIMPL_SWITCH_TAG = 5
 700 \end{code}
 701
 702 %************************************************************************
 703 %*                                                                      *
 704 \subsection{Switch lookup}
 705 %*                                                                      *
 706 %************************************************************************
 707
 708 \begin{code}
 709 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 710 isAmongSimpl on_switches                -- Switches mentioned later occur *earlier*
 711                                         -- in the list; defaults right at the end.
 712   = let
 713         tidied_on_switches = foldl rm_dups [] on_switches
 714                 -- The fold*l* ensures that we keep the latest switches;
 715                 -- ie the ones that occur earliest in the list.
 716
 717         sw_tbl :: Array Int SwitchResult
 718         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 719                         all_undefined)
 720                  // defined_elems
 721
 722         all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 723
 724         defined_elems = map mk_assoc_elem tidied_on_switches
 725     in
 726     -- (avoid some unboxing, bounds checking, and other horrible things:)
 727 #if __GLASGOW_HASKELL__ < 405
 728     case sw_tbl of { Array bounds_who_needs_'em stuff ->
 729 #else
 730     case sw_tbl of { Array _ _ stuff ->
 731 #endif
 732     \ switch ->
 733         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 734 #if __GLASGOW_HASKELL__ < 400
 735           Lift v -> v
 736 #elif __GLASGOW_HASKELL__ < 403
 737           (# _, v #) -> v
 738 #else
 739           (# v #) -> v
 740 #endif
 741     }
 742   where
 743     mk_assoc_elem k@(MaxSimplifierIterations lvl)
 744         = (iBox (tagOf_SimplSwitch k), SwInt lvl)
 745     mk_assoc_elem k@(SimplInlinePhase n)
 746         = (iBox (tagOf_SimplSwitch k), SwInt n)
 747     mk_assoc_elem k
 748         = (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
 749
 750     -- cannot have duplicates if we are going to use the array thing
 751     rm_dups switches_so_far switch
 752       = if switch `is_elem` switches_so_far
 753         then switches_so_far
 754         else switch : switches_so_far
 755       where
 756         sw `is_elem` []     = False
 757         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
 758                             || sw `is_elem` ss
 759 \end{code}
 760
 761
 762 %************************************************************************
 763 %*                                                                      *
 764 \subsection{Misc functions for command-line options}
 765 %*                                                                      *
 766 %************************************************************************
 767
 768
 769 \begin{code}
 770 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 771
 772 switchIsOn lookup_fn switch
 773   = case (lookup_fn switch) of
 774       SwBool False -> False
 775       _            -> True
 776
 777 intSwitchSet :: (switch -> SwitchResult)
 778              -> (Int -> switch)
 779              -> Maybe Int
 780
 781 intSwitchSet lookup_fn switch
 782   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 783       SwInt int -> Just int
 784       _         -> Nothing
 785 \end{code}
 786
 787 \begin{code}
 788 startsWith :: String -> String -> Maybe String
 789 -- startsWith pfx (pfx++rest) = Just rest
 790
 791 startsWith []     str = Just str
 792 startsWith (c:cs) (s:ss)
 793   = if c /= s then Nothing else startsWith cs ss
 794 startsWith  _     []  = Nothing
 795
 796 endsWith  :: String -> String -> Maybe String
 797 endsWith cs ss
 798   = case (startsWith (reverse cs) (reverse ss)) of
 799       Nothing -> Nothing
 800       Just rs -> Just (reverse rs)
 801 \end{code}