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