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