2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CmdLineOpts]{Things to do with command-line options}
7 #include "HsVersions.h"
10 CmdLineInfo(..), SwitchResult(..),
11 GlobalSwitch(..), SimplifierSwitch(..),
16 #endif {- Data Parallel Haskell -}
19 switchIsOn, stringSwitchSet, intSwitchSet,
21 -- to make the interface self-sufficient
26 import Maybes ( maybeToBool, Maybe(..) )
29 #ifdef __GLASGOW_HASKELL__
30 import PreludeGlaST -- bad bad bad boy, Will
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.)
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'').
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}).
48 We use function @classifyOpts@ to take raw command-line arguments from
49 @GetArgs@ and get back the @CmdLineInfo@, which is what we really
52 %************************************************************************
54 \subsection[CmdLineOpts-datatype]{Datatypes associated with command-line options}
56 %************************************************************************
60 = (GlobalSwitch -> SwitchResult, -- Switch lookup function
61 [CoreToDo], -- Core-to-core spec
63 [PodizeToDo], -- Podizer spec
64 [CoreToDo], -- post podized Core-to-core spec
66 [StgToDo] -- Stg-to-stg spec
70 = SwBool Bool -- on/off
71 | SwString String -- nothing or a String
72 | SwInt Int -- nothing or an Int
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.
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.
86 | CoreDoCalcInlinings1
87 | CoreDoCalcInlinings2
96 | CoreDoAutoCostCentres
97 | CoreDoFoldrBuildWorkerWrapper
98 | CoreDoFoldrBuildWWAnal
101 --| CoreDoHaskLetlessPrint
107 | StgDoUpdateAnalysis
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).
118 = PodizeNeeded Int -- Which dimensioned PODs need vectorizing
119 #endif {- Data Parallel Haskell -}
122 @GlobalSwitches@ may be visible everywhere in the compiler.
123 @SimplifierSwitches@ (which follow) are visible only in the main
124 Core-to-Core simplifier.
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
132 | AsmTarget String -- architecture we are generating code for
135 | Haskell_1_3 -- if set => Haskell 1.3; else 1.2
136 | GlasgowExts -- Glasgow Haskell extensions allowed
137 | CompilingPrelude -- Compiling prelude source
139 | HideBuiltinNames -- fiddle builtin namespace; used for compiling Prelude
140 | HideMostBuiltinNames
141 | EnsureSplittableC String -- (by globalising all top-level Ids w/ this String)
144 | PprStyle_User -- printing "level" (mostly for debugging)
148 | DoCoreLinting -- paranoia flags
151 | OmitInterfacePragmas
153 | OmitReexportedInstances
155 | UnfoldingUseThreshold Int -- global one; see also SimplUnf...
156 | UnfoldingCreationThreshold Int -- ditto
157 | UnfoldingOverrideThreshold Int
159 | ReportWhyUnfoldingsDisallowed
160 | UseGetMentionedVars
166 | AutoSccsOnExportedToplevs
167 | AutoSccsOnAllToplevs
168 | AutoSccsOnIndividualCafs
169 | SccGroup String -- name of "group" for this cost centres in this module
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.
181 | SpecialiseImports -- Treat non-essential spec requests as errors
182 | ShowImportSpecs -- Output spec requests for non-essential specs
183 | OmitDefaultInstanceMethods
184 | SpecialiseOverloaded
189 -- this batch of flags is for particular experiments;
190 -- v unlikely to be used in any other circumstance
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.
201 | ReturnInRegsThreshold Int
202 | VectoredReturnThreshold Int -- very likely UNUSED
204 | D_dump_rif2hs -- debugging: print out various things
220 --ANDY: | D_dump_core_passes_info -- A Gill-ism
222 | D_verbose_core2core
230 | PodizeVeryAggresive
231 | PodizeExtremelyAggresive
235 #endif {- Data Parallel Haskell -}
239 data SimplifierSwitch
241 | SimplFloatLetsExposingWHNF
242 | SimplOkToFloatPrimOps
243 | SimplAlwaysFloatLetsFromLets
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
254 | SimplDoNewOccurAnal -- use the *new*, all singing, Occurance analysis
255 | SimplDoInlineFoldrBuild
256 -- inline foldr/build (*after* f/b rule is used)
259 | SimplDoLambdaEtaExpansion
260 | SimplDoEtaReduction
262 | EssentialUnfoldingsOnly -- never mind the thresholds, only
263 -- do unfoldings that *must* be done
264 -- (to saturate constructors and primitives)
266 | ShowSimplifierProgress -- report counts on every interation
268 | MaxSimplifierIterations Int
270 | SimplUnfoldingUseThreshold Int -- per-simplification variants
271 | SimplUnfoldingCreationThreshold Int
273 | KeepSpecPragmaIds -- We normally *toss* Ids we can do without
276 | SimplNoLetFromCase -- used when turning off floating entirely
277 | SimplNoLetFromApp -- (for experimentation only) WDP 95/10
278 | SimplNoLetFromStrictLet
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
288 -- So only use this flag inside List.hs
289 -- (Sigh, what a HACK, Andy. WDP 96/01)
302 %************************************************************************
304 \subsection[CmdLineOpts-classify]{Classifying command-line options}
306 %************************************************************************
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
316 = sep opts [] [] [] -- accumulators...
318 sep :: [String] -- cmd-line opts (input)
319 -> [GlobalSwitch] -- switch accumulator
320 -> [CoreToDo] -> [StgToDo] -- to_do accumulators
321 -> MainIO CmdLineInfo -- result
323 sep [] glob_sw core_td stg_td
330 sep (opt1:opts) glob_sw core_td stg_td
332 #else {- Data Parallel Haskell -}
334 = sep opts [] [] [] [] [] -- accumulators...
336 sep :: [String] -- cmd-line opts (input)
337 -> [GlobalSwitch] -- switch accumulator
338 -> [CoreToDo] -> [PodizeToDo] -- to_do accumulators
339 -> [CoreToDo] -> [StgToDo]
340 -> MainIO CmdLineInfo -- result
342 -- see also the related "simpl_sep" function, used
343 -- to collect up the SimplifierSwitches for a "-fsimplify".
345 sep [] glob_sw core_td pod_td pcore_td stg_td
354 sep (opt1:opts) glob_sw core_td pod_td pcore_td stg_td
355 #endif {- Data Parallel Haskell -}
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
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
376 #endif {- Data Parallel Haskell -}
379 #define GLOBAL_SIMPL_SW(switch) simpl_sep opts (switch:simpl_sw) glob_sw core_td stg_td
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
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)
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 -}
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)
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)
445 "-dverbose-simpl" ->GLOBAL_SW(D_verbose_core2core)
446 "-dverbose-stg" -> GLOBAL_SW(D_verbose_stg2stg)
448 "-fuse-get-mentioned-vars" -> GLOBAL_SW(UseGetMentionedVars)
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)
460 "-fsemi-tagging" -> GLOBAL_SW(DoSemiTagging)
462 "-fsimplify" -> -- gather up SimplifierSwitches specially...
463 simpl_sep opts [] glob_sw core_td stg_td
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)
488 "-freport-disallowed-unfoldings"
489 -> GLOBAL_SW(ReportWhyUnfoldingsDisallowed)
491 "-fomit-derived-read" -> GLOBAL_SW(OmitDerivedRead)
493 "-ffoldr-build-on" -> GLOBAL_SW(FoldrBuildOn)
494 "-ffoldr-build-trace" -> GLOBAL_SW(FoldrBuildTrace)
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)
502 "-flet-no-escape" -> GLOBAL_SW(StgDoLetNoEscapes)
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 -}
514 "-v" -> GLOBAL_SW(Verbose)
516 "-fglasgow-exts" -> GLOBAL_SW(GlasgowExts)
517 "-prelude" -> GLOBAL_SW(CompilingPrelude)
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)
524 "-fticky-ticky" -> GLOBAL_SW(DoTickyProfiling)
526 "-dppr-user" -> GLOBAL_SW(PprStyle_User)
527 "-dppr-debug" -> GLOBAL_SW(PprStyle_Debug)
528 "-dppr-all" -> GLOBAL_SW(PprStyle_All)
530 "-fhide-builtin-names"-> GLOBAL_SW(HideBuiltinNames)
531 "-fmin-builtin-names" -> GLOBAL_SW(HideMostBuiltinNames)
533 "-fconcurrent" -> GLOBAL_SW(ForConcurrent)
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)
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
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))
553 | starts_with_rirt -> -- trace ("rirt:"++after_rirt) $
554 GLOBAL_SW(ReturnInRegsThreshold (read after_rirt))
556 | starts_with_gtn -> GLOBAL_SW(EnsureSplittableC after_gtn)
559 _ -> writeMn stderr ("*** WARNING: bad option: "++opt1++"\n") `thenMn` ( \ _ ->
560 -- NB: the driver is really supposed to handle bad options
565 starts_with :: String -> String -> Maybe String
567 starts_with [] str = Just str
568 starts_with (c:cs) (s:ss)
569 = if c /= s then Nothing else starts_with cs ss
573 -- ToDo: DPH-ify "simpl_sep"!
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
581 -- "simpl_sep" tailcalls "sep" once it's seen one set
582 -- of SimplifierSwitches for a CoreDoSimplify.
585 simpl_sep input@[] simpl_sw glob_sw core_td stg_td
586 = panic "simpl_sep []"
589 -- The SimplifierSwitches should be delimited by "(" and ")".
591 simpl_sep ("(":opts) [{-better be empty-}] glob_sw core_td stg_td
592 = simpl_sep opts [] glob_sw core_td stg_td
594 simpl_sep (")":opts) simpl_sw glob_sw core_td stg_td
596 this_CoreDoSimplify = CoreDoSimplify (isAmongSimpl simpl_sw)
598 sep opts glob_sw (this_CoreDoSimplify : core_td) stg_td
600 simpl_sep (opt1:opts) simpl_sw glob_sw core_td stg_td
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
612 case opt1 of -- the non-"just match a string" options are at the end...
613 "-fshow-simplifier-progress" -> GLOBAL_SIMPL_SW(ShowSimplifierProgress)
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)
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))
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 )
649 %************************************************************************
651 \subsection[CmdLineOpts-order]{Switch ordering}
653 %************************************************************************
655 In spite of the @Produce*@ and @SccGroup@ constructors, these things
656 behave just like enumeration types.
659 instance Eq GlobalSwitch where
660 a == b = tagOf_Switch a _EQ_ tagOf_Switch b
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
666 instance Eq SimplifierSwitch where
667 a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
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
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)
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)
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!-}
751 tagOf_Switch _ = case (panic "tagOf_Switch") of -- BUG avoidance
754 lAST_SWITCH_TAG = IBOX(tagOf_Switch D_source_stats)
756 #else {- Data Parallel Haskell -}
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)
766 tagOf_Switch _ = case (panic "tagOf_Switch") of -- BUG avoidance
769 lAST_SWITCH_TAG = IBOX(tagOf_Switch D_dump_nextC)
771 #endif {- Data Parallel Haskell -}
774 (Note For Will): Could you please leave a little extra room between
775 your last option and @D_dump_spec@... Thanks... jon...
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!
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)
818 tagOf_SimplSwitch _ = case (panic "tagOf_SimplSwitch") of -- BUG avoidance
819 s -> tagOf_SimplSwitch s
821 lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplDontFoldBackAppend)
824 %************************************************************************
826 \subsection[CmdLineOpts-lookup]{Switch lookup}
828 %************************************************************************
831 isAmong :: [GlobalSwitch] -> GlobalSwitch -> SwitchResult
832 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
836 tidied_on_switches = foldl rm_dups [] on_switches
838 sw_tbl :: Array Int SwitchResult
840 sw_tbl = (array (0, lAST_SWITCH_TAG) -- bounds...
844 all_undefined = [ i := SwBool False | i <- [0 .. lAST_SWITCH_TAG ] ]
846 defined_elems = map mk_assoc_elem tidied_on_switches
848 #ifndef __GLASGOW_HASKELL__
849 \ switch -> sw_tbl ! IBOX((tagOf_Switch switch)) -- but this is fast!
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 ->
855 case (indexArray# stuff (tagOf_Switch switch)) of
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
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
872 mk_assoc_elem k@(ReturnInRegsThreshold lvl) = IBOX(tagOf_Switch k) := SwInt lvl
874 mk_assoc_elem k = IBOX(tagOf_Switch k) := SwBool True -- I'm here, Mom!
876 -- cannot have duplicates if we are going to use the array thing
878 rm_dups switches_so_far switch
879 = if switch `is_elem` switches_so_far
881 else switch : switches_so_far
883 sw `is_elem` [] = False
884 sw `is_elem` (s:ss) = (tagOf_Switch sw) _EQ_ (tagOf_Switch s)
888 Same thing for @SimplifierSwitches@; for efficiency reasons, we
889 probably do {\em not} want something overloaded.
891 isAmongSimpl on_switches
893 tidied_on_switches = foldl rm_dups [] on_switches
895 sw_tbl :: Array Int SwitchResult
897 sw_tbl = (array (0, lAST_SIMPL_SWITCH_TAG) -- bounds...
901 all_undefined = [ i := SwBool False | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
903 defined_elems = map mk_assoc_elem tidied_on_switches
905 #ifndef __GLASGOW_HASKELL__
906 \ switch -> sw_tbl ! IBOX((tagOf_SimplSwitch switch)) -- but this is fast!
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 ->
912 case (indexArray# stuff (tagOf_SimplSwitch switch)) of
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
921 mk_assoc_elem k = IBOX(tagOf_SimplSwitch k) := SwBool True -- I'm here, Mom!
923 -- cannot have duplicates if we are going to use the array thing
925 rm_dups switches_so_far switch
926 = if switch `is_elem` switches_so_far
928 else switch : switches_so_far
930 sw `is_elem` [] = False
931 sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
935 %************************************************************************
937 \subsection[CmdLineOpts-misc]{Misc functions for command-line options}
939 %************************************************************************
943 switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
945 switchIsOn lookup_fn switch
946 = case (lookup_fn switch) of
947 SwBool False -> False
950 stringSwitchSet :: (switch -> SwitchResult)
951 -> (String -> switch)
954 stringSwitchSet lookup_fn switch
955 = case (lookup_fn (switch (panic "stringSwitchSet"))) of
956 SwString str -> Just str
959 intSwitchSet :: (switch -> SwitchResult)
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