-classifyOpts :: [String] -- cmd-line args, straight from GetArgs
- -> MainIO CmdLineInfo
--- The MainIO bit is because we might find an unknown flag
--- in which case we print an error message
-
-#ifndef DPH
-classifyOpts opts
- = sep opts [] [] [] -- accumulators...
- where
- sep :: [String] -- cmd-line opts (input)
- -> [GlobalSwitch] -- switch accumulator
- -> [CoreToDo] -> [StgToDo] -- to_do accumulators
- -> MainIO CmdLineInfo -- result
-
- sep [] glob_sw core_td stg_td
- = returnMn (
- isAmong glob_sw,
- reverse core_td,
- reverse stg_td
- )
-
- sep (opt1:opts) glob_sw core_td stg_td
-
-#else {- Data Parallel Haskell -}
-classifyOpts opts
- = sep opts [] [] [] [] [] -- accumulators...
- where
- sep :: [String] -- cmd-line opts (input)
- -> [GlobalSwitch] -- switch accumulator
- -> [CoreToDo] -> [PodizeToDo] -- to_do accumulators
- -> [CoreToDo] -> [StgToDo]
- -> MainIO CmdLineInfo -- result
-
- -- see also the related "simpl_sep" function, used
- -- to collect up the SimplifierSwitches for a "-fsimplify".
-
- sep [] glob_sw core_td pod_td pcore_td stg_td
- = returnMn (
- isAmong glob_sw,
- reverse core_td,
- reverse pod_td,
- reverse pcore_td,
- reverse stg_td
- )
-
- sep (opt1:opts) glob_sw core_td pod_td pcore_td stg_td
-#endif {- Data Parallel Haskell -}
-
-#ifndef DPH
-#define GLOBAL_SW(switch) sep opts (switch:glob_sw) core_td stg_td
-#define CORE_TD(to_do) sep opts glob_sw (to_do:core_td) stg_td
-#define POD_TD(to_do) sep opts glob_sw core_td stg_td
-#define PAR_CORE_TD(to_do) sep opts glob_sw core_td stg_td
-#define BOTH_CORE_TD(to_do) sep opts glob_sw (to_do:core_td) stg_td
-#define STG_TD(to_do) sep opts glob_sw core_td (to_do:stg_td)
-#define IGNORE_ARG() sep opts glob_sw core_td stg_td
-
-#else
-
-#define GLOBAL_SW(switch) sep opts (switch:glob_sw) core_td pod_td pcore_td stg_td
-#define CORE_TD(to_do) sep opts glob_sw (to_do:core_td) pod_td pcore_td stg_td
-#define POD_TD(to_do) sep opts glob_sw core_td (to_do:pod_td) pcore_td stg_td
-#define PAR_CORE_TD(do) sep opts glob_sw core_td pod_td (do:pcore_td) stg_td
-#define BOTH_CORE_TD(do) sep opts glob_sw (do:core_td) pod_td (do:pcore_td) stg_td
-#define STG_TD(to_do) sep opts glob_sw core_td pod_td pcore_td (to_do:stg_td)
-#define IGNORE_ARG() sep opts glob_sw core_td pod_td pcore_td stg_td
-
-#endif {- Data Parallel Haskell -}
-
--- ToDo: DPH-ify
-#define GLOBAL_SIMPL_SW(switch) simpl_sep opts (switch:simpl_sw) glob_sw core_td stg_td
-
- = let
- maybe_fasm = starts_with "-fasm-" opt1
- maybe_G = starts_with "-G" opt1
- maybe_C = starts_with "-C" opt1
- maybe_S = starts_with "-S" opt1
- maybe_hi = starts_with "-hi" opt1
- maybe_hu = starts_with "-hu" opt1
- maybe_uut = starts_with "-funfolding-use-threshold" opt1
- maybe_uct = starts_with "-funfolding-creation-threshold" opt1
- maybe_uot = starts_with "-funfolding-override-threshold" opt1
- maybe_gtn = starts_with "-fglobalise-toplev-names" opt1
- starts_with_fasm = maybeToBool maybe_fasm
- starts_with_G = maybeToBool maybe_G
- starts_with_C = maybeToBool maybe_C
- starts_with_S = maybeToBool maybe_S
- starts_with_hi = maybeToBool maybe_hi
- starts_with_hu = maybeToBool maybe_hu
- starts_with_uut = maybeToBool maybe_uut
- starts_with_uct = maybeToBool maybe_uct
- starts_with_uot = maybeToBool maybe_uot
- starts_with_gtn = maybeToBool maybe_gtn
- (Just after_fasm) = maybe_fasm
- (Just after_G) = maybe_G
- (Just after_C) = maybe_C
- (Just after_S) = maybe_S
- (Just after_hi) = maybe_hi
- (Just after_hu) = maybe_hu
- (Just after_uut) = maybe_uut
- (Just after_uct) = maybe_uct
- (Just after_uot) = maybe_uot
- (Just after_gtn) = maybe_gtn
- in
- case opt1 of -- the non-"just match a string" options are at the end...
- ',' : _ -> IGNORE_ARG() -- it is for the parser
- "-ddump-rif2hs" -> GLOBAL_SW(D_dump_rif2hs)
- "-ddump-rn4" -> GLOBAL_SW(D_dump_rn4)
- "-ddump-tc" -> GLOBAL_SW(D_dump_tc)
- "-ddump-deriv" -> GLOBAL_SW(D_dump_deriv)
- "-ddump-ds" -> GLOBAL_SW(D_dump_ds)
- "-ddump-stranal" -> GLOBAL_SW(D_dump_stranal)
- "-ddump-deforest"-> GLOBAL_SW(D_dump_deforest)
- "-ddump-spec" -> GLOBAL_SW(D_dump_spec)
- "-ddump-simpl" -> GLOBAL_SW(D_dump_simpl)
- "-ddump-occur-anal" -> GLOBAL_SW(D_dump_occur_anal)
--- NOT REALLY USED: "-ddump-type-info" -> GLOBAL_SW(D_dump_type_info)
-#ifdef DPH
- "-ddump-pod" -> GLOBAL_SW(D_dump_pod)
- "-ddump-psimpl"-> GLOBAL_SW(D_dump_psimpl)
- "-ddump-nextC" -> GLOBAL_SW(D_dump_nextC)
-#endif {- Data Parallel Haskell -}
-
- "-ddump-stg" -> GLOBAL_SW(D_dump_stg)
- "-ddump-absC" -> GLOBAL_SW(D_dump_absC)
- "-ddump-flatC"-> GLOBAL_SW(D_dump_flatC)
- "-ddump-realC"-> GLOBAL_SW(D_dump_realC)
- "-ddump-asm" -> GLOBAL_SW(D_dump_asm)
-
- "-ddump-core-passes" -> GLOBAL_SW(D_dump_core_passes)
--- ANDY: "-ddump-haskell" -> GLOBAL_SW(D_dump_core_passes_info)
- "-dsimplifier-stats" -> GLOBAL_SW(D_simplifier_stats)
-
- "-dverbose-simpl" ->GLOBAL_SW(D_verbose_core2core)
- "-dverbose-stg" -> GLOBAL_SW(D_verbose_stg2stg)
-
- "-fuse-get-mentioned-vars" -> GLOBAL_SW(UseGetMentionedVars)
-
- "-fhaskell-1.3" -> GLOBAL_SW(Haskell_1_3)
- "-dcore-lint" -> GLOBAL_SW(DoCoreLinting)
- "-fomit-interface-pragmas" -> GLOBAL_SW(OmitInterfacePragmas)
- "-fignore-strictness-pragmas" -> GLOBAL_SW(IgnoreStrictnessPragmas)
- "-firrefutable-tuples" -> GLOBAL_SW(IrrefutableTuples)
- "-firrefutable-everything" -> GLOBAL_SW(IrrefutableEverything)
- "-fall-strict" -> GLOBAL_SW(AllStrict)
- "-fall-demanded" -> GLOBAL_SW(AllDemanded)
-
- "-fsemi-tagging" -> GLOBAL_SW(DoSemiTagging)
-
- "-fsimplify" -> -- gather up SimplifierSwitches specially...
- simpl_sep opts [] glob_sw core_td stg_td
-
---UNUSED: "-farity-analysis" -> CORE_TD(CoreDoArityAnalysis)
- "-fcalc-inlinings1"-> CORE_TD(CoreDoCalcInlinings1)
- "-fcalc-inlinings2"-> CORE_TD(CoreDoCalcInlinings2)
- "-ffloat-inwards" -> CORE_TD(CoreDoFloatInwards)
- "-ffull-laziness" -> CORE_TD(CoreDoFullLaziness)
- "-fliberate-case" -> CORE_TD(CoreLiberateCase)
- "-fprint-core" -> CORE_TD(CoreDoPrintCore)
- "-fstatic-args" -> CORE_TD(CoreDoStaticArgs)
- "-fstrictness" -> CORE_TD(CoreDoStrictness)
- "-fspecialise" -> CORE_TD(CoreDoSpecialising)
- "-fdeforest" -> CORE_TD(CoreDoDeforest)
- "-fadd-auto-sccs" -> CORE_TD(CoreDoAutoCostCentres)
- "-ffoldr-build-worker-wrapper" -> CORE_TD(CoreDoFoldrBuildWorkerWrapper)
- "-ffoldr-build-ww-anal" -> CORE_TD(CoreDoFoldrBuildWWAnal)
---ANDY: "-fprint-haskell-core" -> CORE_TD(CoreDoHaskPrint)
--- "-fprint-haskell-letless-core" -> CORE_TD(CoreDoHaskLetlessPrint)
-
- "-fspecialise-overloaded" -> GLOBAL_SW(SpecialiseOverloaded)
- "-fspecialise-unboxed" -> GLOBAL_SW(SpecialiseUnboxed)
- "-fspecialise-all" -> GLOBAL_SW(SpecialiseAll)
- "-fspecialise-imports" -> GLOBAL_SW(SpecialiseImports)
- "-fshow-import-specs" -> GLOBAL_SW(ShowImportSpecs)
- "-ftrace-specialisation" -> GLOBAL_SW(SpecialiseTrace)
-
- "-freport-disallowed-unfoldings"
- -> GLOBAL_SW(ReportWhyUnfoldingsDisallowed)
-
- "-fomit-derived-read" -> GLOBAL_SW(OmitDerivedRead)
-
- "-ffoldr-build-on" -> GLOBAL_SW(FoldrBuildOn)
- "-ffoldr-build-trace" -> GLOBAL_SW(FoldrBuildTrace)
-
- "-fstg-static-args" -> STG_TD(StgDoStaticArgs)
- "-fupdate-analysis" -> STG_TD(StgDoUpdateAnalysis)
- "-dstg-stats" -> STG_TD(D_stg_stats)
- "-flambda-lift" -> STG_TD(StgDoLambdaLift)
- "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
-
- "-flet-no-escape" -> GLOBAL_SW(StgDoLetNoEscapes)
-
-#ifdef DPH
- "-fpodize-vector" -> POD_TD(PodizeNeeded 1)
- "-fpodize-matrix" -> POD_TD(PodizeNeeded 2)
- "-fpodize-cube" -> POD_TD(PodizeNeeded 3)
- "-fpodize-intelligent" -> GLOBAL_SW(PodizeIntelligent)
- "-fpodize-aggresive" -> GLOBAL_SW(PodizeAggresive)
- "-fpodize-very-aggresive" -> GLOBAL_SW(PodizeVeryAggresive)
- "-fpodize-extremely-aggresive" -> GLOBAL_SW(PodizeExtremelyAggresive)
-#endif {- Data Parallel Haskell -}
-
- "-v" -> GLOBAL_SW(Verbose)
-
- "-fglasgow-exts" -> GLOBAL_SW(GlasgowExts)
- "-prelude" -> GLOBAL_SW(CompilingPrelude)
-
- "-fscc-profiling" -> GLOBAL_SW(SccProfilingOn)
- "-fauto-sccs-on-exported-toplevs" -> GLOBAL_SW(AutoSccsOnExportedToplevs)
- "-fauto-sccs-on-all-toplevs" -> GLOBAL_SW(AutoSccsOnAllToplevs)
- "-fauto-sccs-on-individual-cafs" -> GLOBAL_SW(AutoSccsOnIndividualCafs)
---UNUSED: "-fauto-sccs-on-individual-dicts" -> GLOBAL_SW(AutoSccsOnIndividualDicts)
-
- "-fstg-reduction-counts" -> GLOBAL_SW(DoTickyProfiling)
-
- "-dppr-user" -> GLOBAL_SW(PprStyle_User)
- "-dppr-debug" -> GLOBAL_SW(PprStyle_Debug)
- "-dppr-all" -> GLOBAL_SW(PprStyle_All)
-
- "-fhide-builtin-names"-> GLOBAL_SW(HideBuiltinNames)
- "-fmin-builtin-names" -> GLOBAL_SW(HideMostBuiltinNames)
-
- "-fconcurrent" -> GLOBAL_SW(ForConcurrent)
-
- "-fomit-unspecialised-code" -> GLOBAL_SW(OmitUnspecialisedCode)
- "-fshow-pragma-name-errs" -> GLOBAL_SW(ShowPragmaNameErrs)
- "-fname-shadowing-not-ok" -> GLOBAL_SW(NameShadowingNotOK)
- "-fsignatures-required" -> GLOBAL_SW(SigsRequired)
- "-fomit-reexported-instances" -> GLOBAL_SW(OmitReexportedInstances)
- "-darity-checks" -> GLOBAL_SW(EmitArityChecks)
---UNUSED: "-dno-stk-chks" -> GLOBAL_SW(OmitStkChecks)
- "-dno-black-holing"-> GLOBAL_SW(OmitBlackHoling)
-
- _ | starts_with_fasm -> GLOBAL_SW(AsmTarget after_fasm)
- | starts_with_G -> GLOBAL_SW(SccGroup after_G) -- profiling "group"
- | starts_with_C -> GLOBAL_SW(ProduceC after_C) -- main C output
- | starts_with_S -> GLOBAL_SW(ProduceS after_S) -- main .s output
- | starts_with_hi -> GLOBAL_SW(ProduceHi after_hi) -- interface
---UNUSED: | starts_with_hu -> GLOBAL_SW(ProduceHu after_hu) -- usage info
-
- | starts_with_uut -> GLOBAL_SW(UnfoldingUseThreshold (read after_uut))
- | starts_with_uct -> GLOBAL_SW(UnfoldingCreationThreshold (read after_uct))
- | starts_with_uot -> GLOBAL_SW(UnfoldingOverrideThreshold (read after_uot))
-
- | starts_with_gtn -> GLOBAL_SW(EnsureSplittableC after_gtn)
-
- _ -> writeMn stderr ("*** WARNING: bad option: "++opt1++"\n") `thenMn` ( \ _ ->
- -- NB: the driver is really supposed to handle bad options
- IGNORE_ARG() )
-
- ----------------
-
- starts_with :: String -> String -> Maybe String
-
- starts_with [] str = Just str
- starts_with (c:cs) (s:ss)
- = if c /= s then Nothing else starts_with cs ss
-
- ----------------
-
- -- ToDo: DPH-ify "simpl_sep"!
-
- simpl_sep :: [String] -- cmd-line opts (input)
- -> [SimplifierSwitch] -- simplifier-switch accumulator
- -> [GlobalSwitch] -- switch accumulator
- -> [CoreToDo] -> [StgToDo] -- to_do accumulators
- -> MainIO CmdLineInfo -- result
+-- debugging opts
+opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
+opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
+opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
+
+-- warning opts
+opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports")
+opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing")
+opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns")
+opt_WarnMissingFields = lookUp SLIT("-fwarn-missing-fields")
+opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods")
+opt_WarnMissingSigs = lookUp SLIT("-fwarn-missing-signatures")
+opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing")
+opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns")
+opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns")
+opt_WarnTypeDefaults = lookUp SLIT("-fwarn-type-defaults")
+opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds")
+opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports")
+opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches")
+opt_WarnDeprecations = lookUp SLIT("-fwarn-deprecations")
+
+-- profiling opts
+opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs")
+opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs")
+opt_AutoSccsOnIndividualCafs = lookUp SLIT("-fauto-sccs-on-individual-cafs")
+opt_AutoSccsOnDicts = lookUp SLIT("-fauto-sccs-on-dicts")
+opt_SccProfilingOn = lookUp SLIT("-fscc-profiling")
+opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky")
+
+-- language opts
+opt_AllStrict = lookUp SLIT("-fall-strict")
+opt_DictsStrict = lookUp SLIT("-fdicts-strict")
+opt_Generics = lookUp SLIT("-fgenerics")
+opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples")
+opt_MaxContextReductionDepth = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
+opt_NumbersStrict = lookUp SLIT("-fnumbers-strict")
+opt_Parallel = lookUp SLIT("-fparallel")
+opt_SMP = lookUp SLIT("-fsmp")
+
+-- optimisation opts
+opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging")
+opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on")
+opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
+opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape")
+opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file")
+opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
+opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")