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