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