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,       -- abstract
  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
  32         -- profiling opts
  33         opt_AutoSccsOnAllToplevs,
  34         opt_AutoSccsOnExportedToplevs,
  35         opt_AutoSccsOnIndividualCafs,
  36         opt_AutoSccsOnDicts,
  37         opt_SccProfilingOn,
  38         opt_DoTickyProfiling,
  39
  40         -- language opts
  41         opt_AllStrict,
  42         opt_DictsStrict,
  43         opt_MaxContextReductionDepth,
  44         opt_IrrefutableTuples,
  45         opt_NumbersStrict,
  46         opt_Parallel,
  47         opt_SMP,
  48
  49         -- optimisation opts
  50         opt_DoSemiTagging,
  51         opt_FoldrBuildOn,
  52         opt_LiberateCaseThreshold,
  53         opt_StgDoLetNoEscapes,
  54         opt_UnfoldCasms,
  55         opt_UsageSPOn,
  56         opt_UnboxStrictFields,
  57         opt_SimplNoPreInlining,
  58         opt_SimplDoEtaReduction,
  59         opt_SimplDoLambdaEtaExpansion,
  60         opt_SimplCaseOfCase,
  61         opt_SimplCaseMerge,
  62         opt_SimplPedanticBottoms,
  63         opt_SimplExcessPrecision,
  64
  65         -- Unfolding control
  66         opt_UF_HiFileThreshold,
  67         opt_UF_CreationThreshold,
  68         opt_UF_UseThreshold,
  69         opt_UF_FunAppDiscount,
  70         opt_UF_KeenessFactor,
  71         opt_UF_UpdateInPlace,
  72         opt_UF_CheapOp,
  73         opt_UF_DearOp,
  74
  75         -- misc opts
  76         opt_InPackage,
  77         opt_EmitCExternDecls,
  78         opt_EnsureSplittableC,
  79         opt_GranMacros,
  80         opt_HiVersion,
  81         opt_HistorySize,
  82         opt_IgnoreAsserts,
  83         opt_IgnoreIfacePragmas,
  84         opt_NoHiCheck,
  85         opt_NoImplicitPrelude,
  86         opt_OmitBlackHoling,
  87         opt_OmitInterfacePragmas,
  88         opt_NoPruneTyDecls,
  89         opt_NoPruneDecls,
  90         opt_Static,
  91         opt_Unregisterised,
  92         opt_Verbose
  93     ) where
  94
  95 #include "HsVersions.h"
  96
  97 import Array    ( array, (//) )
  98 import GlaExts
  99 import Argv
 100 import Constants        -- Default values for some flags
 101 import Util
 102 import FastTypes
 103
 104 import Maybes           ( firstJust )
 105 import Panic            ( panic )
 106
 107 #if __GLASGOW_HASKELL__ < 301
 108 import ArrBase  ( Array(..) )
 109 #else
 110 import PrelArr  ( Array(..) )
 111 #endif
 112 \end{code}
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection{Command-line options}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 The hsc command-line options are split into two categories:
 121
 122   - static flags
 123   - dynamic flags
 124
 125 Static flags are represented by top-level values of type Bool or Int,
 126 for example.  They therefore have the same value throughout the
 127 invocation of hsc.
 128
 129 Dynamic flags are represented by an abstract type, DynFlags, which is
 130 passed into hsc by the compilation manager for every compilation.
 131 Dynamic flags are those that change on a per-compilation basis,
 132 perhaps because they may be present in the OPTIONS pragma at the top
 133 of a module.
 134
 135 Other flag-related blurb:
 136
 137 A list of {\em ToDo}s is things to be done in a particular part of
 138 processing.  A (fictitious) example for the Core-to-Core simplifier
 139 might be: run the simplifier, then run the strictness analyser, then
 140 run the simplifier again (three ``todos'').
 141
 142 There are three ``to-do processing centers'' at the moment.  In the
 143 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
 144 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
 145 (\tr{simplStg/SimplStg.lhs}).
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 \subsection{Datatypes associated with command-line options}
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 \begin{code}
 154 data SwitchResult
 155   = SwBool      Bool            -- on/off
 156   | SwString    FAST_STRING     -- nothing or a String
 157   | SwInt       Int             -- nothing or an Int
 158 \end{code}
 159
 160 \begin{code}
 161 data CoreToDo           -- These are diff core-to-core passes,
 162                         -- which may be invoked in any order,
 163                         -- as many times as you like.
 164
 165   = CoreDoSimplify      -- The core-to-core simplifier.
 166         (SimplifierSwitch -> SwitchResult)
 167                         -- Each run of the simplifier can take a different
 168                         -- set of simplifier-specific flags.
 169   | CoreDoFloatInwards
 170   | CoreDoFloatOutwards Bool    -- True <=> float lambdas to top level
 171   | CoreLiberateCase
 172   | CoreDoPrintCore
 173   | CoreDoStaticArgs
 174   | CoreDoStrictness
 175   | CoreDoWorkerWrapper
 176   | CoreDoSpecialising
 177   | CoreDoUSPInf
 178   | CoreDoCPResult
 179   | CoreDoGlomBinds
 180   | CoreCSE
 181
 182   | CoreDoNothing        -- useful when building up lists of these things
 183 \end{code}
 184
 185 \begin{code}
 186 data StgToDo
 187   = StgDoStaticArgs
 188   | StgDoLambdaLift
 189   | StgDoMassageForProfiling  -- should be (next to) last
 190   -- There's also setStgVarInfo, but its absolute "lastness"
 191   -- is so critical that it is hardwired in (no flag).
 192   | D_stg_stats
 193 \end{code}
 194
 195 \begin{code}
 196 data SimplifierSwitch
 197   = MaxSimplifierIterations Int
 198   | SimplInlinePhase Int
 199   | DontApplyRules
 200   | NoCaseOfCase
 201   | SimplLetToCase
 202 \end{code}
 203
 204 %************************************************************************
 205 %*                                                                      *
 206 \subsection{Dynamic command-line options}
 207 %*                                                                      *
 208 %************************************************************************
 209
 210 \begin{code}
 211 data DynFlag
 212
 213    -- debugging flags
 214    = Opt_D_dump_all
 215    | Opt_D_dump_most
 216    | Opt_D_dump_absC
 217    | Opt_D_dump_asm
 218    | Opt_D_dump_cpranal
 219    | Opt_D_dump_deriv
 220    | Opt_D_dump_ds
 221    | Opt_D_dump_flatC
 222    | Opt_D_dump_foreign
 223    | Opt_D_dump_inlinings
 224    | Opt_D_dump_occur_anal
 225    | Opt_D_dump_parsed
 226    | Opt_D_dump_realC
 227    | Opt_D_dump_rn
 228    | Opt_D_dump_simpl
 229    | Opt_D_dump_simpl_iterations
 230    | Opt_D_dump_spec
 231    | Opt_D_dump_stg
 232    | Opt_D_dump_stranal
 233    | Opt_D_dump_tc
 234    | Opt_D_dump_types
 235    | Opt_D_dump_rules
 236    | Opt_D_dump_usagesp
 237    | Opt_D_dump_cse
 238    | Opt_D_dump_worker_wrapper
 239    | Opt_D_show_passes
 240    | Opt_D_dump_rn_trace
 241    | Opt_D_dump_rn_stats
 242    | Opt_D_dump_stix
 243    | Opt_D_dump_simpl_stats
 244    | Opt_D_source_stats
 245    | Opt_D_verbose_core2core
 246    | Opt_D_verbose_stg2stg
 247    | Opt_D_dump_hi_diffs
 248    | Opt_D_dump_minimal_imports
 249    | Opt_DoCoreLinting
 250    | Opt_DoStgLinting
 251    | Opt_DoUSPLinting
 252
 253    | Opt_WarnDuplicateExports
 254    | Opt_WarnHiShadows
 255    | Opt_WarnIncompletePatterns
 256    | Opt_WarnMissingFields
 257    | Opt_WarnMissingMethods
 258    | Opt_WarnMissingSigs
 259    | Opt_WarnNameShadowing
 260    | Opt_WarnOverlappingPatterns
 261    | Opt_WarnSimplePatterns
 262    | Opt_WarnTypeDefaults
 263    | Opt_WarnUnusedBinds
 264    | Opt_WarnUnusedImports
 265    | Opt_WarnUnusedMatches
 266    | Opt_WarnDeprecations
 267
 268    -- language opts
 269    | Opt_AllowOverlappingInstances
 270    | Opt_AllowUndecidableInstances
 271    | Opt_GlasgowExts
 272    | Opt_Generics
 273
 274    -- misc
 275    | Opt_ReportCompile
 276    deriving (Eq)
 277
 278 data DynFlags = DynFlags {
 279   coreToDo :: CoreToDo,
 280   stgToDo  :: StgToDo,
 281   hscLang  :: HscLang,
 282   flags    :: [DynFlag]
 283  }
 284
 285 dopt :: DynFlag -> DynFlags -> Bool
 286 dopt f dflags  = f `elem` (flags dflags)
 287
 288 dopt_CoreToDo :: DynFlags -> CoreToDo
 289 dopt_CoreToDo = coreToDo
 290
 291 dopt_StgToDo :: DynFlags -> StgToDo
 292 dopt_StgToDo = stgToDo
 293
 294 data HscLang
 295   = HscC     String   -- String is the filename to put output into
 296   | HscAsm   String   -- ditto
 297   | HscJava  String   -- ditto
 298   | HscInterpreter
 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}