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