ghc/compiler/main/CmdLineOpts.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[CmdLineOpts]{Things to do with command-line options}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module CmdLineOpts (
  10         CmdLineInfo(..), SwitchResult(..),
  11         GlobalSwitch(..), SimplifierSwitch(..),
  12         CoreToDo(..),
  13         StgToDo(..),
  14 #ifdef DPH
  15         PodizeToDo(..),
  16 #endif {- Data Parallel Haskell -}
  17
  18         classifyOpts,
  19         switchIsOn, stringSwitchSet, intSwitchSet,
  20
  21         -- to make the interface self-sufficient
  22         Maybe, MainIO(..)
  23     ) where
  24
  25 import MainMonad
  26 import Maybes           ( maybeToBool, Maybe(..) )
  27 import Outputable
  28 import Util
  29 #ifdef __GLASGOW_HASKELL__
  30 import PreludeGlaST     -- bad bad bad boy, Will
  31 #endif
  32 \end{code}
  33
  34 A command-line {\em switch} is (generally) either on or off; e.g., the
  35 ``verbose'' (-v) switch is either on or off.  (The \tr{-G<group>}
  36 switch is an exception; it's set to a string, or nothing.)
  37
  38 A list of {\em ToDo}s is things to be done in a particular part of
  39 processing.  A (fictitious) example for the Core-to-Core simplifier
  40 might be: run the simplifier, then run the strictness analyser, then
  41 run the simplifier again (three ``todos'').
  42
  43 There are three ``to-do processing centers'' at the moment.  In the
  44 main loop (\tr{main/Main.lhs}), in the Core-to-Core processing loop
  45 (\tr{simplCore/SimplCore.lhs), and in the STG-to-STG processing loop
  46 (\tr{simplStg/SimplStg.lhs}).
  47
  48 We use function @classifyOpts@ to take raw command-line arguments from
  49 @GetArgs@ and get back the @CmdLineInfo@, which is what we really
  50 want.
  51
  52 %************************************************************************
  53 %*                                                                      *
  54 \subsection[CmdLineOpts-datatype]{Datatypes associated with command-line options}
  55 %*                                                                      *
  56 %************************************************************************
  57
  58 \begin{code}
  59 type CmdLineInfo
  60   = (GlobalSwitch -> SwitchResult,      -- Switch lookup function
  61      [CoreToDo],                        -- Core-to-core spec
  62 #ifdef DPH
  63      [PodizeToDo],                      -- Podizer spec
  64      [CoreToDo],                        -- post podized Core-to-core spec
  65 #endif
  66      [StgToDo]                          -- Stg-to-stg spec
  67     )
  68
  69 data SwitchResult
  70   = SwBool      Bool    -- on/off
  71   | SwString    String  -- nothing or a String
  72   | SwInt       Int     -- nothing or an Int
  73 \end{code}
  74
  75 \begin{code}
  76 data CoreToDo           -- These are diff core-to-core passes,
  77                         -- which may be invoked in any order,
  78                         -- as many times as you like.
  79
  80   = CoreDoSimplify      -- The core-to-core simplifier.
  81         (SimplifierSwitch -> SwitchResult)
  82                         -- Each run of the simplifier can take a different
  83                         -- set of simplifier-specific flags.
  84
  85   | CoreDoArityAnalysis -- UNUSED right now
  86   | CoreDoCalcInlinings1
  87   | CoreDoCalcInlinings2
  88   | CoreDoFloatInwards
  89   | CoreDoFullLaziness
  90   | CoreLiberateCase
  91   | CoreDoPrintCore
  92   | CoreDoStaticArgs
  93   | CoreDoStrictness
  94   | CoreDoSpecialising
  95   | CoreDoDeforest
  96   | CoreDoAutoCostCentres
  97   | CoreDoFoldrBuildWorkerWrapper
  98   | CoreDoFoldrBuildWWAnal
  99 -- ANDY:
 100 --| CoreDoHaskPrint
 101 --| CoreDoHaskLetlessPrint
 102 \end{code}
 103
 104 \begin{code}
 105 data StgToDo
 106   = StgDoStaticArgs
 107   | StgDoUpdateAnalysis
 108   | StgDoLambdaLift
 109   | StgDoMassageForProfiling  -- should be (next to) last
 110   -- There's also setStgVarInfo, but its absolute "lastness"
 111   -- is so critical that it is hardwired in (no flag).
 112   | D_stg_stats
 113 \end{code}
 114
 115 \begin{code}
 116 #ifdef DPH
 117 data PodizeToDo
 118   = PodizeNeeded Int            -- Which dimensioned PODs need vectorizing
 119 #endif {- Data Parallel Haskell -}
 120 \end{code}
 121
 122 @GlobalSwitches@ may be visible everywhere in the compiler.
 123 @SimplifierSwitches@ (which follow) are visible only in the main
 124 Core-to-Core simplifier.
 125
 126 \begin{code}
 127 data GlobalSwitch
 128   = ProduceC    String  -- generate C output into this file
 129   | ProduceS    String  -- generate native-code assembler into this file
 130   | ProduceHi   String  -- generate .hi interface  into this file
 131 --UNUSED:  | ProduceHu  String  -- generate .hu usage-info into this file
 132
 133   | AsmTarget   String  -- architecture we are generating code for
 134   | ForConcurrent
 135
 136   | Haskell_1_3         -- if set => Haskell 1.3; else 1.2
 137   | GlasgowExts         -- Glasgow Haskell extensions allowed
 138   | CompilingPrelude    -- Compiling prelude source
 139
 140   | HideBuiltinNames    -- fiddle builtin namespace; used for compiling Prelude
 141   | HideMostBuiltinNames
 142   | EnsureSplittableC String -- (by globalising all top-level Ids w/ this String)
 143
 144   | Verbose
 145   | PprStyle_User       -- printing "level" (mostly for debugging)
 146   | PprStyle_Debug
 147   | PprStyle_All
 148
 149   | DoCoreLinting       -- paranoia flags
 150   | EmitArityChecks
 151
 152   | OmitInterfacePragmas
 153   | OmitDerivedRead
 154   | OmitReexportedInstances
 155
 156   | UnfoldingUseThreshold      Int  -- global one; see also SimplUnf...
 157   | UnfoldingCreationThreshold Int  -- ditto
 158   | UnfoldingOverrideThreshold Int
 159
 160   | ReportWhyUnfoldingsDisallowed
 161   | UseGetMentionedVars
 162   | ShowPragmaNameErrs
 163   | NameShadowingNotOK
 164   | SigsRequired
 165
 166   | SccProfilingOn
 167   | AutoSccsOnExportedToplevs
 168   | AutoSccsOnAllToplevs
 169   | AutoSccsOnIndividualCafs
 170 --UNUSED:  | AutoSccsOnIndividualDicts
 171   | SccGroup String     -- name of "group" for this cost centres in this module
 172
 173   | DoTickyProfiling
 174
 175   | DoSemiTagging
 176
 177   -- ToDo: turn these into SimplifierSwitches?
 178   | FoldrBuildOn        -- If foldr/build-style transformations are on.
 179                         -- See also SimplDoFoldrBuild, which is used
 180                         -- inside the simplifier.
 181   | FoldrBuildTrace     -- show all foldr/build optimisations.
 182
 183   | SpecialiseImports      -- Treat non-essential spec requests as errors
 184   | ShowImportSpecs        -- Output spec requests for non-essential specs
 185   | OmitUnspecialisedCode  -- ToDo? (Patrick)
 186   | SpecialiseOverloaded
 187   | SpecialiseUnboxed
 188   | SpecialiseAll
 189   | SpecialiseTrace
 190
 191   -- this batch of flags is for particular experiments;
 192   -- v unlikely to be used in any other circumstance
 193 --UNUSED:  | OmitStkChecks
 194   | OmitBlackHoling
 195   | StgDoLetNoEscapes
 196   | IgnoreStrictnessPragmas -- ToDo: still useful?
 197   | IrrefutableTuples       -- We inject extra "LazyPat"s in the typechecker
 198   | IrrefutableEverything   -- (TcPat); doing it any earlier would mean that
 199                             -- deriving-generated code wouldn't be irrefutablified.
 200   | AllStrict
 201   | AllDemanded
 202
 203 -- NOT REALLY USED:  | D_dump_type_info -- for Robin Popplestone stuff
 204
 205   | D_dump_rif2hs       -- debugging: print out various things
 206   | D_dump_rn4
 207   | D_dump_tc
 208   | D_dump_deriv
 209   | D_dump_ds
 210   | D_dump_occur_anal
 211   | D_dump_simpl
 212   | D_dump_spec
 213   | D_dump_stranal
 214   | D_dump_deforest
 215   | D_dump_stg
 216   | D_dump_absC
 217   | D_dump_flatC
 218   | D_dump_realC
 219   | D_dump_asm
 220   | D_dump_core_passes          -- A Gill-ism
 221   | D_dump_core_passes_info     -- Yet another Gill-ism
 222
 223   | D_verbose_core2core
 224   | D_verbose_stg2stg
 225   | D_simplifier_stats
 226
 227 {- ????
 228   | Extra__Flag1
 229   | Extra__Flag2
 230   | Extra__Flag3
 231   | Extra__Flag4
 232   | Extra__Flag5
 233   | Extra__Flag6
 234   | Extra__Flag7
 235   | Extra__Flag8
 236   | Extra__Flag9
 237 -}
 238
 239 #ifdef DPH
 240   | PodizeIntelligent
 241   | PodizeAggresive
 242   | PodizeVeryAggresive
 243   | PodizeExtremelyAggresive
 244   | D_dump_pod
 245   | D_dump_psimpl
 246   | D_dump_nextC
 247 #endif {- Data Parallel Haskell -}
 248 \end{code}
 249
 250 \begin{code}
 251 data SimplifierSwitch
 252   = SimplOkToDupCode
 253   | SimplFloatLetsExposingWHNF
 254   | SimplOkToFloatPrimOps
 255   | SimplAlwaysFloatLetsFromLets
 256   | SimplDoCaseElim
 257   | SimplReuseCon
 258   | SimplCaseOfCase
 259   | SimplLetToCase
 260 --UNUSED:  | SimplOkToInlineInLambdas
 261   | SimplMayDeleteConjurableIds
 262   | SimplPedanticBottoms -- see Simplifier for an explanation
 263   | SimplDoArityExpand   -- expand arity of bindings
 264   | SimplDoFoldrBuild    -- This is the per-simplification flag;
 265                          -- see also FoldrBuildOn, used elsewhere
 266                          -- in the compiler.
 267   | SimplDoNewOccurAnal  --  use the *new*, all singing, Occurance analysis
 268   | SimplDoInlineFoldrBuild
 269                          -- inline foldr/build (*after* f/b rule is used)
 270
 271   | IgnoreINLINEPragma
 272   | SimplDoLambdaEtaExpansion
 273 --UNUSED:  | SimplDoMonadEtaExpansion
 274
 275   | SimplDoEtaReduction
 276
 277   | EssentialUnfoldingsOnly -- never mind the thresholds, only
 278                             -- do unfoldings that *must* be done
 279                             -- (to saturate constructors and primitives)
 280
 281   | ShowSimplifierProgress  -- report counts on every interation
 282
 283   | MaxSimplifierIterations Int
 284
 285   | SimplUnfoldingUseThreshold      Int -- per-simplification variants
 286   | SimplUnfoldingCreationThreshold Int
 287
 288   | KeepSpecPragmaIds       -- We normally *toss* Ids we can do without
 289   | KeepUnusedBindings
 290
 291 {-
 292   | Extra__SimplFlag1
 293   | Extra__SimplFlag2
 294   | Extra__SimplFlag3
 295   | Extra__SimplFlag4
 296   | Extra__SimplFlag5
 297   | Extra__SimplFlag6
 298   | Extra__SimplFlag7
 299   | Extra__SimplFlag8
 300 -}
 301 \end{code}
 302
 303 %************************************************************************
 304 %*                                                                      *
 305 \subsection[CmdLineOpts-classify]{Classifying command-line options}
 306 %*                                                                      *
 307 %************************************************************************
 308
 309 \begin{code}
 310 classifyOpts :: [String]            -- cmd-line args, straight from GetArgs
 311              -> MainIO CmdLineInfo
 312 -- The MainIO bit is because we might find an unknown flag
 313 -- in which case we print an error message
 314
 315 #ifndef DPH
 316 classifyOpts opts
 317   = sep opts [] [] [] -- accumulators...
 318   where
 319     sep :: [String]                              -- cmd-line opts (input)
 320         -> [GlobalSwitch]                        -- switch accumulator
 321         -> [CoreToDo] -> [StgToDo]               -- to_do accumulators
 322         -> MainIO CmdLineInfo                    -- result
 323
 324     sep [] glob_sw core_td stg_td
 325       = returnMn (
 326           isAmong glob_sw,
 327           reverse core_td,
 328           reverse stg_td
 329         )
 330
 331     sep (opt1:opts) glob_sw core_td stg_td
 332
 333 #else {- Data Parallel Haskell -}
 334 classifyOpts opts
 335   = sep opts [] [] [] [] [] -- accumulators...
 336   where
 337     sep :: [String]                              -- cmd-line opts (input)
 338         -> [GlobalSwitch]                        -- switch accumulator
 339         -> [CoreToDo] -> [PodizeToDo]            -- to_do accumulators
 340         -> [CoreToDo] -> [StgToDo]
 341         -> MainIO CmdLineInfo                    -- result
 342
 343     -- see also the related "simpl_sep" function, used
 344     -- to collect up the SimplifierSwitches for a "-fsimplify".
 345
 346     sep [] glob_sw core_td pod_td pcore_td stg_td
 347       = returnMn (
 348           isAmong glob_sw,
 349           reverse core_td,
 350           reverse pod_td,
 351           reverse pcore_td,
 352           reverse stg_td
 353         )
 354
 355     sep (opt1:opts) glob_sw core_td pod_td pcore_td stg_td
 356 #endif {- Data Parallel Haskell -}
 357
 358 #ifndef DPH
 359 #define GLOBAL_SW(switch)   sep opts (switch:glob_sw) core_td stg_td
 360 #define CORE_TD(to_do)      sep opts glob_sw (to_do:core_td) stg_td
 361 #define POD_TD(to_do)       sep opts glob_sw core_td stg_td
 362 #define PAR_CORE_TD(to_do)  sep opts glob_sw core_td stg_td
 363 #define BOTH_CORE_TD(to_do) sep opts glob_sw (to_do:core_td) stg_td
 364 #define STG_TD(to_do)       sep opts glob_sw core_td (to_do:stg_td)
 365 #define IGNORE_ARG()        sep opts glob_sw core_td stg_td
 366
 367 #else
 368
 369 #define GLOBAL_SW(switch) sep opts (switch:glob_sw) core_td pod_td pcore_td stg_td
 370 #define CORE_TD(to_do)    sep opts glob_sw (to_do:core_td) pod_td pcore_td stg_td
 371 #define POD_TD(to_do)     sep opts glob_sw core_td (to_do:pod_td) pcore_td stg_td
 372 #define PAR_CORE_TD(do)   sep opts glob_sw core_td pod_td (do:pcore_td) stg_td
 373 #define BOTH_CORE_TD(do)  sep opts glob_sw (do:core_td) pod_td (do:pcore_td) stg_td
 374 #define STG_TD(to_do)     sep opts glob_sw core_td pod_td pcore_td (to_do:stg_td)
 375 #define IGNORE_ARG()      sep opts glob_sw core_td pod_td pcore_td stg_td
 376
 377 #endif {- Data Parallel Haskell -}
 378
 379 -- ToDo: DPH-ify
 380 #define GLOBAL_SIMPL_SW(switch) simpl_sep opts (switch:simpl_sw) glob_sw core_td stg_td
 381
 382       = let
 383             maybe_fasm          = starts_with "-fasm-"  opt1
 384             maybe_G             = starts_with "-G"      opt1
 385             maybe_C             = starts_with "-C"      opt1
 386             maybe_S             = starts_with "-S"      opt1
 387             maybe_hi            = starts_with "-hi"     opt1
 388             maybe_hu            = starts_with "-hu"     opt1
 389             maybe_uut           = starts_with "-funfolding-use-threshold"      opt1
 390             maybe_uct           = starts_with "-funfolding-creation-threshold" opt1
 391             maybe_uot           = starts_with "-funfolding-override-threshold" opt1
 392             maybe_gtn           = starts_with "-fglobalise-toplev-names"       opt1
 393             starts_with_fasm    = maybeToBool maybe_fasm
 394             starts_with_G       = maybeToBool maybe_G
 395             starts_with_C       = maybeToBool maybe_C
 396             starts_with_S       = maybeToBool maybe_S
 397             starts_with_hi      = maybeToBool maybe_hi
 398             starts_with_hu      = maybeToBool maybe_hu
 399             starts_with_uut     = maybeToBool maybe_uut
 400             starts_with_uct     = maybeToBool maybe_uct
 401             starts_with_uot     = maybeToBool maybe_uot
 402             starts_with_gtn     = maybeToBool maybe_gtn
 403             (Just after_fasm)   = maybe_fasm
 404             (Just after_G)      = maybe_G
 405             (Just after_C)      = maybe_C
 406             (Just after_S)      = maybe_S
 407             (Just after_hi)     = maybe_hi
 408             (Just after_hu)     = maybe_hu
 409             (Just after_uut)    = maybe_uut
 410             (Just after_uct)    = maybe_uct
 411             (Just after_uot)    = maybe_uot
 412             (Just after_gtn)    = maybe_gtn
 413         in
 414         case opt1 of -- the non-"just match a string" options are at the end...
 415           ',' : _          -> IGNORE_ARG() -- it is for the parser
 416           "-ddump-rif2hs"  -> GLOBAL_SW(D_dump_rif2hs)
 417           "-ddump-rn4"     -> GLOBAL_SW(D_dump_rn4)
 418           "-ddump-tc"      -> GLOBAL_SW(D_dump_tc)
 419           "-ddump-deriv"   -> GLOBAL_SW(D_dump_deriv)
 420           "-ddump-ds"      -> GLOBAL_SW(D_dump_ds)
 421           "-ddump-stranal" -> GLOBAL_SW(D_dump_stranal)
 422           "-ddump-deforest"-> GLOBAL_SW(D_dump_deforest)
 423           "-ddump-spec"    -> GLOBAL_SW(D_dump_spec)
 424           "-ddump-simpl"   -> GLOBAL_SW(D_dump_simpl)
 425           "-ddump-occur-anal" -> GLOBAL_SW(D_dump_occur_anal)
 426 -- NOT REALLY USED:       "-ddump-type-info"  -> GLOBAL_SW(D_dump_type_info)
 427 #ifdef DPH
 428           "-ddump-pod"   ->   GLOBAL_SW(D_dump_pod)
 429           "-ddump-psimpl"->   GLOBAL_SW(D_dump_psimpl)
 430           "-ddump-nextC" ->   GLOBAL_SW(D_dump_nextC)
 431 #endif {- Data Parallel Haskell -}
 432
 433           "-ddump-stg"  ->    GLOBAL_SW(D_dump_stg)
 434           "-ddump-absC" ->    GLOBAL_SW(D_dump_absC)
 435           "-ddump-flatC"->    GLOBAL_SW(D_dump_flatC)
 436           "-ddump-realC"->    GLOBAL_SW(D_dump_realC)
 437           "-ddump-asm"  ->    GLOBAL_SW(D_dump_asm)
 438
 439           "-ddump-core-passes"      -> GLOBAL_SW(D_dump_core_passes)
 440 -- ANDY:  "-ddump-haskell"          -> GLOBAL_SW(D_dump_core_passes_info)
 441           "-dsimplifier-stats"      -> GLOBAL_SW(D_simplifier_stats)
 442
 443           "-dverbose-simpl" ->GLOBAL_SW(D_verbose_core2core)
 444           "-dverbose-stg" ->  GLOBAL_SW(D_verbose_stg2stg)
 445
 446           "-fuse-get-mentioned-vars" -> GLOBAL_SW(UseGetMentionedVars)
 447
 448           "-fhaskell-1.3"               -> GLOBAL_SW(Haskell_1_3)
 449           "-dcore-lint"                 -> GLOBAL_SW(DoCoreLinting)
 450           "-fomit-interface-pragmas"    -> GLOBAL_SW(OmitInterfacePragmas)
 451           "-fignore-strictness-pragmas" -> GLOBAL_SW(IgnoreStrictnessPragmas)
 452           "-firrefutable-tuples"        -> GLOBAL_SW(IrrefutableTuples)
 453           "-firrefutable-everything"    -> GLOBAL_SW(IrrefutableEverything)
 454           "-fall-strict"                -> GLOBAL_SW(AllStrict)
 455           "-fall-demanded"              -> GLOBAL_SW(AllDemanded)
 456
 457           "-fsemi-tagging"   -> GLOBAL_SW(DoSemiTagging)
 458
 459           "-fsimplify"       -> -- gather up SimplifierSwitches specially...
 460                                 simpl_sep opts [] glob_sw core_td stg_td
 461
 462 --UNUSED: "-farity-analysis" -> CORE_TD(CoreDoArityAnalysis)
 463           "-fcalc-inlinings1"-> CORE_TD(CoreDoCalcInlinings1)
 464           "-fcalc-inlinings2"-> CORE_TD(CoreDoCalcInlinings2)
 465           "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
 466           "-ffull-laziness"  -> CORE_TD(CoreDoFullLaziness)
 467           "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
 468           "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
 469           "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
 470           "-fstrictness"     -> CORE_TD(CoreDoStrictness)
 471           "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
 472           "-fdeforest"       -> CORE_TD(CoreDoDeforest)
 473           "-fadd-auto-sccs"  -> CORE_TD(CoreDoAutoCostCentres)
 474           "-ffoldr-build-worker-wrapper"  -> CORE_TD(CoreDoFoldrBuildWorkerWrapper)
 475           "-ffoldr-build-ww-anal"  -> CORE_TD(CoreDoFoldrBuildWWAnal)
 476 --ANDY:   "-fprint-haskell-core" -> CORE_TD(CoreDoHaskPrint)
 477 --        "-fprint-haskell-letless-core" -> CORE_TD(CoreDoHaskLetlessPrint)
 478
 479           "-fspecialise-overloaded" -> GLOBAL_SW(SpecialiseOverloaded)
 480           "-fspecialise-unboxed"    -> GLOBAL_SW(SpecialiseUnboxed)
 481           "-fspecialise-all"        -> GLOBAL_SW(SpecialiseAll)
 482           "-fspecialise-imports"    -> GLOBAL_SW(SpecialiseImports)
 483           "-fshow-import-specs"     -> GLOBAL_SW(ShowImportSpecs)
 484           "-ftrace-specialisation"  -> GLOBAL_SW(SpecialiseTrace)
 485
 486           "-freport-disallowed-unfoldings"
 487                              -> GLOBAL_SW(ReportWhyUnfoldingsDisallowed)
 488
 489           "-fomit-derived-read" -> GLOBAL_SW(OmitDerivedRead)
 490
 491           "-ffoldr-build-on"        -> GLOBAL_SW(FoldrBuildOn)
 492           "-ffoldr-build-trace"     -> GLOBAL_SW(FoldrBuildTrace)
 493
 494           "-fstg-static-args" -> STG_TD(StgDoStaticArgs)
 495           "-fupdate-analysis" -> STG_TD(StgDoUpdateAnalysis)
 496           "-dstg-stats"       -> STG_TD(D_stg_stats)
 497           "-flambda-lift"     -> STG_TD(StgDoLambdaLift)
 498           "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
 499
 500           "-flet-no-escape"   -> GLOBAL_SW(StgDoLetNoEscapes)
 501
 502 #ifdef DPH
 503           "-fpodize-vector"              -> POD_TD(PodizeNeeded 1)
 504           "-fpodize-matrix"              -> POD_TD(PodizeNeeded 2)
 505           "-fpodize-cube"                -> POD_TD(PodizeNeeded 3)
 506           "-fpodize-intelligent"         -> GLOBAL_SW(PodizeIntelligent)
 507           "-fpodize-aggresive"           -> GLOBAL_SW(PodizeAggresive)
 508           "-fpodize-very-aggresive"      -> GLOBAL_SW(PodizeVeryAggresive)
 509           "-fpodize-extremely-aggresive" -> GLOBAL_SW(PodizeExtremelyAggresive)
 510 #endif {- Data Parallel Haskell -}
 511
 512           "-v"          ->          GLOBAL_SW(Verbose)
 513
 514           "-fglasgow-exts" ->       GLOBAL_SW(GlasgowExts)
 515           "-prelude"    ->          GLOBAL_SW(CompilingPrelude)
 516
 517           "-fscc-profiling"                 -> GLOBAL_SW(SccProfilingOn)
 518           "-fauto-sccs-on-exported-toplevs" -> GLOBAL_SW(AutoSccsOnExportedToplevs)
 519           "-fauto-sccs-on-all-toplevs"      -> GLOBAL_SW(AutoSccsOnAllToplevs)
 520           "-fauto-sccs-on-individual-cafs"  -> GLOBAL_SW(AutoSccsOnIndividualCafs)
 521 --UNUSED: "-fauto-sccs-on-individual-dicts" -> GLOBAL_SW(AutoSccsOnIndividualDicts)
 522
 523           "-fstg-reduction-counts"  -> GLOBAL_SW(DoTickyProfiling)
 524
 525           "-dppr-user"  ->          GLOBAL_SW(PprStyle_User)
 526           "-dppr-debug" ->          GLOBAL_SW(PprStyle_Debug)
 527           "-dppr-all"   ->          GLOBAL_SW(PprStyle_All)
 528
 529           "-fhide-builtin-names"->      GLOBAL_SW(HideBuiltinNames)
 530           "-fmin-builtin-names" ->      GLOBAL_SW(HideMostBuiltinNames)
 531
 532           "-fconcurrent"            -> GLOBAL_SW(ForConcurrent)
 533
 534           "-fomit-unspecialised-code" -> GLOBAL_SW(OmitUnspecialisedCode)
 535           "-fshow-pragma-name-errs" -> GLOBAL_SW(ShowPragmaNameErrs)
 536           "-fname-shadowing-not-ok" -> GLOBAL_SW(NameShadowingNotOK)
 537           "-fsignatures-required"   -> GLOBAL_SW(SigsRequired)
 538           "-fomit-reexported-instances" -> GLOBAL_SW(OmitReexportedInstances)
 539           "-darity-checks"  -> GLOBAL_SW(EmitArityChecks)
 540 --UNUSED:         "-dno-stk-chks"   -> GLOBAL_SW(OmitStkChecks)
 541           "-dno-black-holing"-> GLOBAL_SW(OmitBlackHoling)
 542
 543           _ | starts_with_fasm -> GLOBAL_SW(AsmTarget after_fasm)
 544             | starts_with_G    -> GLOBAL_SW(SccGroup  after_G)  -- profiling "group"
 545             | starts_with_C    -> GLOBAL_SW(ProduceC  after_C)  -- main C output
 546             | starts_with_S    -> GLOBAL_SW(ProduceS  after_S)  -- main .s output
 547             | starts_with_hi   -> GLOBAL_SW(ProduceHi after_hi) -- interface
 548 --UNUSED:   | starts_with_hu   -> GLOBAL_SW(ProduceHu after_hu) -- usage info
 549
 550             | starts_with_uut  -> GLOBAL_SW(UnfoldingUseThreshold      (read after_uut))
 551             | starts_with_uct  -> GLOBAL_SW(UnfoldingCreationThreshold (read after_uct))
 552             | starts_with_uot  -> GLOBAL_SW(UnfoldingOverrideThreshold (read after_uot))
 553
 554             | starts_with_gtn  -> GLOBAL_SW(EnsureSplittableC after_gtn)
 555
 556           _ -> writeMn stderr ("*** WARNING: bad option: "++opt1++"\n") `thenMn` ( \ _ ->
 557                 -- NB: the driver is really supposed to handle bad options
 558                IGNORE_ARG() )
 559
 560     ----------------
 561
 562     starts_with :: String -> String -> Maybe String
 563
 564     starts_with []     str = Just str
 565     starts_with (c:cs) (s:ss)
 566       = if c /= s then Nothing else starts_with cs ss
 567
 568     ----------------
 569
 570     -- ToDo: DPH-ify "simpl_sep"!
 571
 572     simpl_sep :: [String]                       -- cmd-line opts (input)
 573         -> [SimplifierSwitch]                   -- simplifier-switch accumulator
 574         -> [GlobalSwitch]                       -- switch accumulator
 575         -> [CoreToDo] -> [StgToDo]              -- to_do accumulators
 576         -> MainIO CmdLineInfo                   -- result
 577
 578         -- "simpl_sep" tailcalls "sep" once it's seen one set
 579         -- of SimplifierSwitches for a CoreDoSimplify.
 580
 581 #ifdef DEBUG
 582     simpl_sep input@[] simpl_sw glob_sw core_td stg_td
 583       = panic "simpl_sep []"
 584 #endif
 585
 586         -- The SimplifierSwitches should be delimited by "(" and ")".
 587
 588     simpl_sep ("(":opts) [{-better be empty-}] glob_sw core_td stg_td
 589       = simpl_sep opts [] glob_sw core_td stg_td
 590
 591     simpl_sep (")":opts) simpl_sw glob_sw core_td stg_td
 592       = let
 593             this_CoreDoSimplify = CoreDoSimplify (isAmongSimpl simpl_sw)
 594         in
 595         sep opts glob_sw (this_CoreDoSimplify : core_td) stg_td
 596
 597     simpl_sep (opt1:opts) simpl_sw glob_sw core_td stg_td
 598       = let
 599             maybe_suut          = starts_with "-fsimpl-uf-use-threshold"      opt1
 600             maybe_suct          = starts_with "-fsimpl-uf-creation-threshold" opt1
 601             maybe_msi           = starts_with "-fmax-simplifier-iterations"   opt1
 602             starts_with_suut    = maybeToBool maybe_suut
 603             starts_with_suct    = maybeToBool maybe_suct
 604             starts_with_msi     = maybeToBool maybe_msi
 605             (Just after_suut)   = maybe_suut
 606             (Just after_suct)   = maybe_suct
 607             (Just after_msi)    = maybe_msi
 608         in
 609         case opt1 of -- the non-"just match a string" options are at the end...
 610           "-fshow-simplifier-progress" -> GLOBAL_SIMPL_SW(ShowSimplifierProgress)
 611
 612           "-fcode-duplication-ok" -> GLOBAL_SIMPL_SW(SimplOkToDupCode)
 613           "-ffloat-lets-exposing-whnf"  -> GLOBAL_SIMPL_SW(SimplFloatLetsExposingWHNF)
 614           "-ffloat-primops-ok"  -> GLOBAL_SIMPL_SW(SimplOkToFloatPrimOps)
 615           "-falways-float-lets-from-lets" -> GLOBAL_SIMPL_SW(SimplAlwaysFloatLetsFromLets)
 616           "-fdo-case-elim" -> GLOBAL_SIMPL_SW(SimplDoCaseElim)
 617           "-fdo-eta-reduction" -> GLOBAL_SIMPL_SW(SimplDoEtaReduction)
 618           "-fdo-lambda-eta-expansion" -> GLOBAL_SIMPL_SW(SimplDoLambdaEtaExpansion)
 619 --UNUSED:         "-fdo-monad-eta-expansion" -> GLOBAL_SIMPL_SW(SimplDoMonadEtaExpansion)
 620           "-fdo-foldr-build"  -> GLOBAL_SIMPL_SW(SimplDoFoldrBuild)
 621           "-fdo-new-occur-anal"  -> GLOBAL_SIMPL_SW(SimplDoNewOccurAnal)
 622           "-fdo-arity-expand"  -> GLOBAL_SIMPL_SW(SimplDoArityExpand)
 623           "-fdo-inline-foldr-build"  -> GLOBAL_SIMPL_SW(SimplDoInlineFoldrBuild)
 624           "-freuse-con"       -> GLOBAL_SIMPL_SW(SimplReuseCon)
 625           "-fcase-of-case"    ->    GLOBAL_SIMPL_SW(SimplCaseOfCase)
 626           "-flet-to-case"     -> GLOBAL_SIMPL_SW(SimplLetToCase)
 627           "-fpedantic-bottoms" -> GLOBAL_SIMPL_SW(SimplPedanticBottoms)
 628           "-fkeep-spec-pragma-ids" -> GLOBAL_SIMPL_SW(KeepSpecPragmaIds)
 629           "-fkeep-unused-bindings" -> GLOBAL_SIMPL_SW(KeepUnusedBindings)
 630 --UNUSED:         "-finline-in-lambdas-ok" -> GLOBAL_SIMPL_SW(SimplOkToInlineInLambdas)
 631           "-fmay-delete-conjurable-ids" -> GLOBAL_SIMPL_SW(SimplMayDeleteConjurableIds)
 632           "-fessential-unfoldings-only" -> GLOBAL_SIMPL_SW(EssentialUnfoldingsOnly)
 633           "-fignore-inline-pragma"  -> GLOBAL_SIMPL_SW(IgnoreINLINEPragma)
 634
 635           _ | starts_with_msi  -> GLOBAL_SIMPL_SW(MaxSimplifierIterations (read after_msi))
 636             | starts_with_suut  -> GLOBAL_SIMPL_SW(SimplUnfoldingUseThreshold (read after_suut))
 637             | starts_with_suct  -> GLOBAL_SIMPL_SW(SimplUnfoldingCreationThreshold (read after_suct))
 638
 639           _ -> writeMn stderr ("*** WARNING: bad simplifier option: "++opt1++"\n") `thenMn` ( \ _ ->
 640                 -- NB: the driver is really supposed to handle bad options
 641                simpl_sep opts simpl_sw glob_sw core_td stg_td )
 642 \end{code}
 643
 644 %************************************************************************
 645 %*                                                                      *
 646 \subsection[CmdLineOpts-order]{Switch ordering}
 647 %*                                                                      *
 648 %************************************************************************
 649
 650 In spite of the @Produce*@ and @SccGroup@ constructors, these things
 651 behave just like enumeration types.
 652
 653 \begin{code}
 654 instance Eq GlobalSwitch where
 655     a == b = tagOf_Switch a _EQ_ tagOf_Switch b
 656
 657 instance Ord GlobalSwitch where
 658     a <  b  = tagOf_Switch a _LT_ tagOf_Switch b
 659     a <= b  = tagOf_Switch a _LE_ tagOf_Switch b
 660
 661 instance Eq SimplifierSwitch where
 662     a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
 663
 664 instance Ord SimplifierSwitch where
 665     a <  b  = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b
 666     a <= b  = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b
 667
 668 tagOf_Switch (ProduceC _)               =(ILIT(0) :: FAST_INT)
 669 tagOf_Switch (ProduceS _)               = ILIT(1)
 670 tagOf_Switch (ProduceHi _)              = ILIT(2)
 671 --UNUSED:tagOf_Switch (ProduceHu        _)              = ILIT(3)
 672 tagOf_Switch (AsmTarget _)              = ILIT(4)
 673 --UNUSED:tagOf_Switch ForParallel               = ILIT(5)
 674 tagOf_Switch ForConcurrent              = ILIT(6)
 675 --UNUSED:tagOf_Switch ForGRIP                   = ILIT(7)
 676 tagOf_Switch Haskell_1_3                = ILIT(8)
 677 tagOf_Switch GlasgowExts                = ILIT(9)
 678 tagOf_Switch CompilingPrelude           = ILIT(10)
 679 tagOf_Switch HideBuiltinNames           = ILIT(11)
 680 tagOf_Switch HideMostBuiltinNames       = ILIT(12)
 681 tagOf_Switch (EnsureSplittableC _)      = ILIT(13)
 682 tagOf_Switch Verbose                    = ILIT(14)
 683 tagOf_Switch PprStyle_User              = ILIT(15)
 684 tagOf_Switch PprStyle_Debug             = ILIT(16)
 685 tagOf_Switch PprStyle_All               = ILIT(17)
 686 tagOf_Switch DoCoreLinting              = ILIT(18)
 687 tagOf_Switch EmitArityChecks            = ILIT(19)
 688 tagOf_Switch OmitInterfacePragmas       = ILIT(20)
 689 tagOf_Switch OmitDerivedRead            = ILIT(21)
 690 tagOf_Switch OmitReexportedInstances    = ILIT(22)
 691 tagOf_Switch (UnfoldingUseThreshold _)  = ILIT(23)
 692 tagOf_Switch (UnfoldingCreationThreshold _) = ILIT(24)
 693 tagOf_Switch (UnfoldingOverrideThreshold _) = ILIT(25)
 694 tagOf_Switch ReportWhyUnfoldingsDisallowed = ILIT(26)
 695 tagOf_Switch UseGetMentionedVars        = ILIT(27)
 696 tagOf_Switch ShowPragmaNameErrs         = ILIT(28)
 697 tagOf_Switch NameShadowingNotOK         = ILIT(29)
 698 tagOf_Switch SigsRequired               = ILIT(30)
 699 tagOf_Switch SccProfilingOn             = ILIT(31)
 700 tagOf_Switch AutoSccsOnExportedToplevs  = ILIT(32)
 701 tagOf_Switch AutoSccsOnAllToplevs       = ILIT(33)
 702 tagOf_Switch AutoSccsOnIndividualCafs   = ILIT(34)
 703 --UNUSED:tagOf_Switch AutoSccsOnIndividualDicts = ILIT(35)
 704 tagOf_Switch (SccGroup _)               = ILIT(36)
 705 tagOf_Switch DoTickyProfiling           = ILIT(37)
 706 tagOf_Switch DoSemiTagging              = ILIT(38)
 707 tagOf_Switch FoldrBuildOn               = ILIT(39)
 708 tagOf_Switch FoldrBuildTrace            = ILIT(40)
 709 tagOf_Switch SpecialiseImports          = ILIT(41)
 710 tagOf_Switch ShowImportSpecs            = ILIT(42)
 711 tagOf_Switch OmitUnspecialisedCode      = ILIT(43)
 712 tagOf_Switch SpecialiseOverloaded       = ILIT(44)
 713 tagOf_Switch SpecialiseUnboxed          = ILIT(45)
 714 tagOf_Switch SpecialiseAll              = ILIT(46)
 715 tagOf_Switch SpecialiseTrace            = ILIT(47)
 716 --UNUSED:tagOf_Switch OmitStkChecks             = ILIT(48)
 717 tagOf_Switch OmitBlackHoling            = ILIT(49)
 718 tagOf_Switch StgDoLetNoEscapes          = ILIT(50)
 719 tagOf_Switch IgnoreStrictnessPragmas    = ILIT(51)
 720 tagOf_Switch IrrefutableTuples          = ILIT(52)
 721 tagOf_Switch IrrefutableEverything      = ILIT(53)
 722 tagOf_Switch AllStrict                  = ILIT(54)
 723 tagOf_Switch AllDemanded                = ILIT(55)
 724 -- NOT REALLY USED: tagOf_Switch D_dump_type_info               = ILIT(56)
 725 tagOf_Switch D_dump_rif2hs              = ILIT(57)
 726 tagOf_Switch D_dump_rn4                 = ILIT(58)
 727 tagOf_Switch D_dump_tc                  = ILIT(59)
 728 tagOf_Switch D_dump_deriv               = ILIT(60)
 729 tagOf_Switch D_dump_ds                  = ILIT(61)
 730 tagOf_Switch D_dump_simpl               = ILIT(62)
 731 tagOf_Switch D_dump_spec                = ILIT(63)
 732 tagOf_Switch D_dump_occur_anal          = ILIT(64)
 733 tagOf_Switch D_dump_stranal             = ILIT(65)
 734 tagOf_Switch D_dump_stg                 = ILIT(66)
 735 tagOf_Switch D_dump_absC                = ILIT(67)
 736 tagOf_Switch D_dump_flatC               = ILIT(68)
 737 tagOf_Switch D_dump_realC               = ILIT(69)
 738 tagOf_Switch D_dump_asm                 = ILIT(70)
 739 tagOf_Switch D_dump_core_passes         = ILIT(71)
 740 tagOf_Switch D_dump_core_passes_info    = ILIT(72)
 741 tagOf_Switch D_verbose_core2core        = ILIT(73)
 742 tagOf_Switch D_verbose_stg2stg          = ILIT(74)
 743 tagOf_Switch D_simplifier_stats         = ILIT(75) {-note below-}
 744
 745 {-
 746 tagOf_Switch Extra__Flag1               = ILIT(76)
 747 tagOf_Switch Extra__Flag2               = ILIT(77)
 748 tagOf_Switch Extra__Flag3               = ILIT(78)
 749 tagOf_Switch Extra__Flag4               = ILIT(79)
 750 tagOf_Switch Extra__Flag5               = ILIT(80)
 751 tagOf_Switch Extra__Flag6               = ILIT(81)
 752 tagOf_Switch Extra__Flag7               = ILIT(82)
 753 tagOf_Switch Extra__Flag8               = ILIT(83)
 754 tagOf_Switch Extra__Flag9               = ILIT(84)
 755 -}
 756
 757 #ifndef DPH
 758 tagOf_Switch _ = case (panic "tagOf_Switch") of -- BUG avoidance
 759                    s -> tagOf_Switch s
 760
 761 lAST_SWITCH_TAG = IBOX(tagOf_Switch D_simplifier_stats)
 762
 763 #else {- Data Parallel Haskell -}
 764
 765 tagOf_Switch PodizeIntelligent          = ILIT(90)
 766 tagOf_Switch PodizeAggresive            = ILIT(91)
 767 tagOf_Switch PodizeVeryAggresive        = ILIT(92)
 768 tagOf_Switch PodizeExtremelyAggresive   = ILIT(93)
 769 tagOf_Switch D_dump_pod                 = ILIT(94)
 770 tagOf_Switch D_dump_psimpl              = ILIT(95)
 771 tagOf_Switch D_dump_nextC               = ILIT(96)
 772
 773 tagOf_Switch _ = case (panic "tagOf_Switch") of -- BUG avoidance
 774                    s -> tagOf_Switch s
 775
 776 lAST_SWITCH_TAG = IBOX(tagOf_Switch D_dump_nextC)
 777
 778 #endif {- Data Parallel Haskell -}
 779 \end{code}
 780
 781 (Note For Will): Could you please leave a little extra room between
 782 your last option and @D_dump_spec@... Thanks... jon...
 783
 784 \begin{code}
 785 tagOf_SimplSwitch SimplOkToDupCode              =(ILIT(0) :: FAST_INT)
 786 tagOf_SimplSwitch SimplFloatLetsExposingWHNF    = ILIT(1)
 787 tagOf_SimplSwitch SimplOkToFloatPrimOps         = ILIT(2)
 788 tagOf_SimplSwitch SimplAlwaysFloatLetsFromLets  = ILIT(3)
 789 tagOf_SimplSwitch SimplDoCaseElim               = ILIT(4)
 790 tagOf_SimplSwitch SimplReuseCon                 = ILIT(5)
 791 tagOf_SimplSwitch SimplCaseOfCase               = ILIT(6)
 792 tagOf_SimplSwitch SimplLetToCase                = ILIT(7)
 793 --UNUSED:tagOf_SimplSwitch SimplOkToInlineInLambdas     = ILIT(8)
 794 tagOf_SimplSwitch SimplMayDeleteConjurableIds   = ILIT(9)
 795 tagOf_SimplSwitch SimplPedanticBottoms          = ILIT(10)
 796 tagOf_SimplSwitch SimplDoArityExpand            = ILIT(11)
 797 tagOf_SimplSwitch SimplDoFoldrBuild             = ILIT(12)
 798 tagOf_SimplSwitch SimplDoNewOccurAnal           = ILIT(13)
 799 tagOf_SimplSwitch SimplDoInlineFoldrBuild       = ILIT(14)
 800 tagOf_SimplSwitch IgnoreINLINEPragma            = ILIT(15)
 801 tagOf_SimplSwitch SimplDoLambdaEtaExpansion     = ILIT(16)
 802 --UNUSED:tagOf_SimplSwitch SimplDoMonadEtaExpansion     = ILIT(17)
 803 tagOf_SimplSwitch SimplDoEtaReduction           = ILIT(18)
 804 tagOf_SimplSwitch EssentialUnfoldingsOnly       = ILIT(19)
 805 tagOf_SimplSwitch ShowSimplifierProgress        = ILIT(20)
 806 tagOf_SimplSwitch (MaxSimplifierIterations _)   = ILIT(21)
 807 tagOf_SimplSwitch (SimplUnfoldingUseThreshold _)      = ILIT(22)
 808 tagOf_SimplSwitch (SimplUnfoldingCreationThreshold _) = ILIT(23)
 809 tagOf_SimplSwitch KeepSpecPragmaIds             = ILIT(24)
 810 tagOf_SimplSwitch KeepUnusedBindings            = ILIT(25)
 811
 812 {-
 813 tagOf_SimplSwitch Extra__SimplFlag1             = ILIT(26)
 814 tagOf_SimplSwitch Extra__SimplFlag2             = ILIT(27)
 815 tagOf_SimplSwitch Extra__SimplFlag3             = ILIT(28)
 816 tagOf_SimplSwitch Extra__SimplFlag4             = ILIT(29)
 817 tagOf_SimplSwitch Extra__SimplFlag5             = ILIT(30)
 818 tagOf_SimplSwitch Extra__SimplFlag6             = ILIT(31)
 819 tagOf_SimplSwitch Extra__SimplFlag8             = ILIT(32)
 820 -}
 821
 822 tagOf_SimplSwitch _ = case (panic "tagOf_SimplSwitch") of -- BUG avoidance
 823                         s -> tagOf_SimplSwitch s
 824
 825 lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch KeepUnusedBindings)
 826 \end{code}
 827
 828 %************************************************************************
 829 %*                                                                      *
 830 \subsection[CmdLineOpts-lookup]{Switch lookup}
 831 %*                                                                      *
 832 %************************************************************************
 833
 834 \begin{code}
 835 isAmong      :: [GlobalSwitch]     -> GlobalSwitch     -> SwitchResult
 836 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 837
 838 isAmong on_switches
 839   = let
 840         tidied_on_switches = foldl rm_dups [] on_switches
 841
 842         sw_tbl :: Array Int SwitchResult
 843
 844         sw_tbl = (array (0, lAST_SWITCH_TAG) -- bounds...
 845                         all_undefined)
 846                  // defined_elems
 847
 848         all_undefined = [ i := SwBool False | i <- [0 .. lAST_SWITCH_TAG ] ]
 849
 850         defined_elems = map mk_assoc_elem tidied_on_switches
 851     in
 852 #ifndef __GLASGOW_HASKELL__
 853     \ switch -> sw_tbl ! IBOX((tagOf_Switch switch))    -- but this is fast!
 854 #else
 855     -- and this is faster!
 856     -- (avoid some unboxing, bounds checking, and other horrible things:)
 857     case sw_tbl of { _Array bounds_who_needs_'em stuff ->
 858     \ switch ->
 859         case (indexArray# stuff (tagOf_Switch switch)) of
 860           _Lift v -> v
 861     }
 862 #endif
 863   where
 864     mk_assoc_elem k@(ProduceC  str) = IBOX(tagOf_Switch k) := SwString str
 865     mk_assoc_elem k@(ProduceS  str) = IBOX(tagOf_Switch k) := SwString str
 866     mk_assoc_elem k@(ProduceHi str) = IBOX(tagOf_Switch k) := SwString str
 867 --UNUSED:    mk_assoc_elem k@(ProduceHu str) = IBOX(tagOf_Switch k) := SwString str
 868     mk_assoc_elem k@(SccGroup  str) = IBOX(tagOf_Switch k) := SwString str
 869     mk_assoc_elem k@(AsmTarget str) = IBOX(tagOf_Switch k) := SwString str
 870     mk_assoc_elem k@(EnsureSplittableC str) = IBOX(tagOf_Switch k) := SwString str
 871
 872     mk_assoc_elem k@(UnfoldingUseThreshold      lvl) = IBOX(tagOf_Switch k) := SwInt lvl
 873     mk_assoc_elem k@(UnfoldingCreationThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
 874     mk_assoc_elem k@(UnfoldingOverrideThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
 875
 876     mk_assoc_elem k = IBOX(tagOf_Switch k) := SwBool True -- I'm here, Mom!
 877
 878     -- cannot have duplicates if we are going to use the array thing
 879
 880     rm_dups switches_so_far switch
 881       = if switch `is_elem` switches_so_far
 882         then switches_so_far
 883         else switch : switches_so_far
 884       where
 885         sw `is_elem` []     = False
 886         sw `is_elem` (s:ss) = (tagOf_Switch sw) _EQ_ (tagOf_Switch s)
 887                             || sw `is_elem` ss
 888 \end{code}
 889
 890 Same thing for @SimplifierSwitches@; for efficiency reasons, we
 891 probably do {\em not} want something overloaded.
 892  \begin{code}
 893 isAmongSimpl on_switches
 894   = let
 895         tidied_on_switches = foldl rm_dups [] on_switches
 896
 897         sw_tbl :: Array Int SwitchResult
 898
 899         sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
 900                         all_undefined)
 901                  // defined_elems
 902
 903         all_undefined = [ i := SwBool False | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
 904
 905         defined_elems = map mk_assoc_elem tidied_on_switches
 906     in
 907 #ifndef __GLASGOW_HASKELL__
 908     \ switch -> sw_tbl ! IBOX((tagOf_SimplSwitch switch)) -- but this is fast!
 909 #else
 910     -- and this is faster!
 911     -- (avoid some unboxing, bounds checking, and other horrible things:)
 912     case sw_tbl of { _Array bounds_who_needs_'em stuff ->
 913     \ switch ->
 914         case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 915           _Lift v -> v
 916     }
 917 #endif
 918   where
 919     mk_assoc_elem k@(MaxSimplifierIterations lvl) = IBOX(tagOf_SimplSwitch k) := SwInt lvl
 920     mk_assoc_elem k@(SimplUnfoldingUseThreshold      i) = IBOX(tagOf_SimplSwitch k) := SwInt i
 921     mk_assoc_elem k@(SimplUnfoldingCreationThreshold i) = IBOX(tagOf_SimplSwitch k) := SwInt i
 922
 923     mk_assoc_elem k = IBOX(tagOf_SimplSwitch k) := SwBool   True -- I'm here, Mom!
 924
 925     -- cannot have duplicates if we are going to use the array thing
 926
 927     rm_dups switches_so_far switch
 928       = if switch `is_elem` switches_so_far
 929         then switches_so_far
 930         else switch : switches_so_far
 931       where
 932         sw `is_elem` []     = False
 933         sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
 934                             || sw `is_elem` ss
 935 \end{code}
 936
 937 %************************************************************************
 938 %*                                                                      *
 939 \subsection[CmdLineOpts-misc]{Misc functions for command-line options}
 940 %*                                                                      *
 941 %************************************************************************
 942
 943
 944 \begin{code}
 945 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
 946
 947 switchIsOn lookup_fn switch
 948   = case (lookup_fn switch) of
 949       SwBool False -> False
 950       _            -> True
 951
 952 stringSwitchSet :: (switch -> SwitchResult)
 953                 -> (String -> switch)
 954                 -> Maybe String
 955
 956 stringSwitchSet lookup_fn switch
 957   = case (lookup_fn (switch (panic "stringSwitchSet"))) of
 958       SwString str -> Just str
 959       _            -> Nothing
 960
 961 intSwitchSet :: (switch -> SwitchResult)
 962              -> (Int -> switch)
 963              -> Maybe Int
 964
 965 intSwitchSet lookup_fn switch
 966   = case (lookup_fn (switch (panic "intSwitchSet"))) of
 967       SwInt int -> Just int
 968       _         -> Nothing
 969 \end{code}