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