X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=inline;f=ghc%2Fcompiler%2Fmain%2FCmdLineOpts.lhs;h=0e41ef371b61b39a8507ac83834726b3970044fd;hb=754f262e6f15785e6b718abdc2f041c4feddee37;hp=c52b97b1e13ca1a814ec24412ad0d39cf497bd34;hpb=003a62090be4ad204165cc09f7950fdde089b956;p=ghc-hetmet.git diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs index c52b97b..0e41ef3 100644 --- a/ghc/compiler/main/CmdLineOpts.lhs +++ b/ghc/compiler/main/CmdLineOpts.lhs @@ -1,11 +1,9 @@ % -% (c) The AQUA Project, Glasgow University, 1996 +% (c) The AQUA Project, Glasgow University, 1996-98 % \section[CmdLineOpts]{Things to do with command-line options} \begin{code} -#include "HsVersions.h" - module CmdLineOpts ( CoreToDo(..), SimplifierSwitch(..), @@ -18,6 +16,7 @@ module CmdLineOpts ( maybe_CompilingGhcInternals, opt_AllStrict, + opt_AllowOverlappingInstances, opt_AutoSccsOnAllToplevs, opt_AutoSccsOnExportedToplevs, opt_AutoSccsOnIndividualCafs, @@ -27,6 +26,7 @@ module CmdLineOpts ( opt_D_dump_deriv, opt_D_dump_ds, opt_D_dump_flatC, + opt_D_dump_foreign, opt_D_dump_occur_anal, opt_D_dump_rdr, opt_D_dump_realC, @@ -39,6 +39,7 @@ module CmdLineOpts ( opt_D_dump_tc, opt_D_show_passes, opt_D_show_rn_trace, + opt_D_show_rn_imports, opt_D_simplifier_stats, opt_D_source_stats, opt_D_verbose_core2core, @@ -48,15 +49,19 @@ module CmdLineOpts ( opt_DoSemiTagging, opt_DoEtaReduction, opt_DoTickyProfiling, + opt_EmitCExternDecls, opt_EnsureSplittableC, opt_FoldrBuildOn, opt_ForConcurrent, opt_GlasgowExts, opt_GranMacros, opt_HiMap, + opt_HiVersion, opt_IgnoreIfacePragmas, opt_IrrefutableTuples, opt_LiberateCaseThreshold, + opt_MultiParamClasses, + opt_NoHiCheck, opt_NoImplicitPrelude, opt_NumbersStrict, opt_OmitBlackHoling, @@ -68,8 +73,11 @@ module CmdLineOpts ( opt_ProduceC, opt_ProduceHi, opt_ProduceS, + opt_ProduceExportCStubs, + opt_ProduceExportHStubs, opt_ReportWhyUnfoldingsDisallowed, opt_ReturnInRegsThreshold, + opt_ReportCompile, opt_SccGroup, opt_SccProfilingOn, opt_ShowImportSpecs, @@ -83,6 +91,7 @@ module CmdLineOpts ( opt_StgDoLetNoEscapes, opt_InterfaceUnfoldThreshold, + opt_UnfoldCasms, opt_UnfoldingCreationThreshold, opt_UnfoldingConDiscount, opt_UnfoldingUseThreshold, @@ -90,37 +99,34 @@ module CmdLineOpts ( opt_Verbose, opt_WarnNameShadowing, - opt_WarnUnusedNames, - opt_WarnIncompletePatterns, opt_WarnOverlappedPatterns, + opt_WarnUnusedMatches, + opt_WarnUnusedBinds, + opt_WarnUnusedImports, + opt_WarnIncompletePatterns, + opt_WarnOverlappingPatterns, + opt_WarnSimplePatterns, opt_WarnMissingMethods, + opt_WarnDuplicateExports, + opt_WarnHiShadows, opt_PruneTyDecls, opt_PruneInstDecls, - opt_D_show_unused_imports, - opt_D_show_rn_stats, - - all_toplev_ids_visible + opt_D_show_rn_stats ) where -IMPORT_1_3(Array(array, (//))) -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201 -import PreludeGlaST -- bad bad bad boy, Will (_Array internals) -#else -import GlaExts -import ArrBase -#if __GLASGOW_HASKELL__ >= 209 -import Addr -#endif --- 2.04 and later exports Lift from GlaExts -#if __GLASGOW_HASKELL__ < 204 -import PrelBase (Lift(..)) -#endif -#endif - -CHK_Ubiq() -- debugging consistency check +#include "HsVersions.h" +import Array ( array, (//) ) +import GlaExts import Argv import Constants -- Default values for some flags + import Maybes ( assocMaybe, firstJust, maybeToBool ) -import Util ( startsWith, panic, panic#, assertPanic ) +import Util ( startsWith, panic, panic# ) + +#if __GLASGOW_HASKELL__ < 301 +import ArrBase ( Array(..) ) +#else +import PrelArr ( Array(..) ) +#endif \end{code} A command-line {\em switch} is (generally) either on or off; e.g., the @@ -213,9 +219,6 @@ data SimplifierSwitch | MaxSimplifierIterations Int - | KeepSpecPragmaIds -- We normally *toss* Ids we can do without - | KeepUnusedBindings - | SimplNoLetFromCase -- used when turning off floating entirely | SimplNoLetFromApp -- (for experimentation only) WDP 95/10 | SimplNoLetFromStrictLet @@ -236,6 +239,12 @@ data SimplifierSwitch -- the scrutinee of a case expression, so we should -- apply the scrutinee discount when considering inlinings. -- See SimplVar.lhs + + | SimplCloneBinds -- This flag controls whether the simplifier should + -- always clone binder ids when creating expression + -- copies. The default is NO, but it needs to be turned on + -- prior to floating binders outwards. + -- (see comment inside SimplVar.simplBinder) \end{code} %************************************************************************ @@ -269,10 +278,29 @@ lookup_def_float sw def = case (lookup_str sw) of assoc_opts = assocMaybe [ (a, True) | a <- argv ] unpacked_opts = map _UNPK_ argv + +{- + Putting the compiler options into temporary at-files + may turn out to be necessary later on if we turn hsc into + a pure Win32 application where I think there's a command-line + length limit of 255. unpacked_opts understands the @ option. + +assoc_opts = assocMaybe [ (_PK_ a, True) | a <- unpacked_opts ] + +unpacked_opts :: [String] +unpacked_opts = + concat $ + map (expandAts) $ + map _UNPK_ argv + where + expandAts ('@':fname) = words (unsafePerformIO (readFile fname)) + expandAts l = [l] +-} \end{code} \begin{code} opt_AllStrict = lookUp SLIT("-fall-strict") +opt_AllowOverlappingInstances = lookUp SLIT("-fallow-overlapping-instances") 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") @@ -283,6 +311,7 @@ opt_D_dump_asm = lookUp SLIT("-ddump-asm") opt_D_dump_deriv = lookUp SLIT("-ddump-deriv") opt_D_dump_ds = lookUp SLIT("-ddump-ds") opt_D_dump_flatC = lookUp SLIT("-ddump-flatC") +opt_D_dump_foreign = lookUp SLIT("-ddump-foreign-stubs") opt_D_dump_occur_anal = lookUp SLIT("-ddump-occur-anal") opt_D_dump_rdr = lookUp SLIT("-ddump-rdr") opt_D_dump_realC = lookUp SLIT("-ddump-realC") @@ -295,25 +324,29 @@ opt_D_dump_stranal = lookUp SLIT("-ddump-stranal") opt_D_dump_tc = lookUp SLIT("-ddump-tc") opt_D_show_passes = lookUp SLIT("-dshow-passes") opt_D_show_rn_trace = lookUp SLIT("-dshow-rn-trace") +opt_D_show_rn_imports = lookUp SLIT("-dshow-rn-imports") opt_D_simplifier_stats = lookUp SLIT("-dsimplifier-stats") opt_D_source_stats = lookUp SLIT("-dsource-stats") opt_D_verbose_core2core = lookUp SLIT("-dverbose-simpl") opt_D_verbose_stg2stg = lookUp SLIT("-dverbose-stg") opt_DoCoreLinting = lookUp SLIT("-dcore-lint") opt_DoStgLinting = lookUp SLIT("-dstg-lint") +opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction") opt_DoSemiTagging = lookUp SLIT("-fsemi-tagging") opt_DoTickyProfiling = lookUp SLIT("-fticky-ticky") -opt_DoEtaReduction = lookUp SLIT("-fdo-eta-reduction") +opt_EmitCExternDecls = lookUp SLIT("-femit-extern-decls") opt_EnsureSplittableC = lookUp SLIT("-fglobalise-toplev-names") opt_FoldrBuildOn = lookUp SLIT("-ffoldr-build-on") opt_ForConcurrent = lookUp SLIT("-fconcurrent") opt_GranMacros = lookUp SLIT("-fgransim") opt_GlasgowExts = lookUp SLIT("-fglasgow-exts") ---UNUSED:opt_Haskell_1_3 = lookUp SLIT("-fhaskell-1.3") -opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files +opt_HiMap = lookup_str "-himap=" -- file saying where to look for .hi files +opt_HiVersion = lookup_def_int "-fhi-version=" 0 -- what version we're compiling. opt_IgnoreIfacePragmas = lookUp SLIT("-fignore-interface-pragmas") opt_IrrefutableTuples = lookUp SLIT("-firrefutable-tuples") +opt_MultiParamClasses = opt_GlasgowExts opt_NoImplicitPrelude = lookUp SLIT("-fno-implicit-prelude") +opt_NoHiCheck = lookUp SLIT("-fno-hi-version-check") opt_NumbersStrict = lookUp SLIT("-fnumbers-strict") opt_OmitBlackHoling = lookUp SLIT("-dno-black-holing") opt_OmitInterfacePragmas = lookUp SLIT("-fomit-interface-pragmas") @@ -323,8 +356,12 @@ opt_PprStyle_User = lookUp SLIT("-dppr-user") opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name opt_ProduceC = lookup_str "-C=" opt_ProduceS = lookup_str "-S=" +opt_ProduceExportCStubs = lookup_str "-F=" +opt_ProduceExportHStubs = lookup_str "-FH=" opt_ProduceHi = lookup_str "-hifile=" -- the one to produce this time opt_ReportWhyUnfoldingsDisallowed= lookUp SLIT("-freport-disallowed-unfoldings") +opt_ReportCompile = lookUp SLIT("-freport-compile") +opt_ReturnInRegsThreshold = lookup_int "-freturn-in-regs-threshold" opt_SccProfilingOn = lookUp SLIT("-fscc-profiling") opt_ShowImportSpecs = lookUp SLIT("-fshow-import-specs") opt_SigsRequired = lookUp SLIT("-fsignatures-required") @@ -335,10 +372,10 @@ opt_SpecialiseOverloaded = lookUp SLIT("-fspecialise-overloaded") opt_SpecialiseTrace = lookUp SLIT("-ftrace-specialisation") opt_SpecialiseUnboxed = lookUp SLIT("-fspecialise-unboxed") opt_StgDoLetNoEscapes = lookUp SLIT("-flet-no-escape") -opt_ReturnInRegsThreshold = lookup_int "-freturn-in-regs-threshold" opt_SccGroup = lookup_str "-G=" opt_Verbose = lookUp SLIT("-v") +opt_UnfoldCasms = lookUp SLIT("-funfold-casms-in-hi-file") opt_InterfaceUnfoldThreshold = lookup_def_int "-funfolding-interface-threshold" iNTERFACE_UNFOLD_THRESHOLD opt_UnfoldingCreationThreshold = lookup_def_int "-funfolding-creation-threshold" uNFOLDING_CREATION_THRESHOLD opt_UnfoldingUseThreshold = lookup_def_int "-funfolding-use-threshold" uNFOLDING_USE_THRESHOLD @@ -347,40 +384,29 @@ opt_UnfoldingConDiscount = lookup_def_int "-funfolding-con-discount" uNFOLDIN opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" lIBERATE_CASE_THRESHOLD opt_UnfoldingKeenessFactor = lookup_def_float "-funfolding-keeness-factor" uNFOLDING_KEENESS_FACTOR opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing") +opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing") opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns") -opt_WarnOverlappedPatterns = lookUp SLIT("-fwarn-overlapped-patterns") -opt_WarnUnusedNames = lookUp SLIT("-fwarn-unused-names") +opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns") +opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns") +opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches") +opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds") +opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports") opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods") +opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports") opt_PruneTyDecls = not (lookUp SLIT("-fno-prune-tydecls")) opt_PruneInstDecls = not (lookUp SLIT("-fno-prune-instdecls")) -opt_D_show_unused_imports = lookUp SLIT("-dshow-unused-imports") opt_D_show_rn_stats = lookUp SLIT("-dshow-rn-stats") -- opt_UnfoldingOverrideThreshold = lookup_int "-funfolding-override-threshold" \end{code} - -\begin{code} -all_toplev_ids_visible :: Bool -all_toplev_ids_visible = - not opt_OmitInterfacePragmas || -- Pragmas can make them visible - opt_EnsureSplittableC || -- Splitting requires visiblilty - opt_AutoSccsOnAllToplevs -- ditto for profiling - -- (ToDo: fix up the auto-annotation - -- pass in the desugarer to avoid having - -- to do this) - -\end{code} - - - \begin{code} classifyOpts :: ([CoreToDo], -- Core-to-Core processing spec [StgToDo]) -- STG-to-STG processing spec classifyOpts = sep argv [] [] -- accumulators... where - sep :: [FAST_STRING] -- cmd-line opts (input) + sep :: [FAST_STRING] -- cmd-line opts (input) -> [CoreToDo] -> [StgToDo] -- to_do accumulators -> ([CoreToDo], [StgToDo]) -- result @@ -389,13 +415,10 @@ classifyOpts = sep argv [] [] -- accumulators... # define CORE_TD(to_do) sep opts (to_do:core_td) stg_td # define STG_TD(to_do) sep opts core_td (to_do:stg_td) -# define IGNORE_ARG() sep opts core_td stg_td sep (opt1:opts) core_td stg_td - = - case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end... - - ',' : _ -> IGNORE_ARG() -- it is for the parser + = case (_UNPK_ opt1) of -- the non-"just match a string" options are at the end... + ',' : _ -> sep opts core_td stg_td -- it is for the parser "-fsimplify" -> -- gather up SimplifierSwitches specially... simpl_sep opts defaultSimplSwitches core_td stg_td @@ -419,14 +442,14 @@ classifyOpts = sep argv [] [] -- accumulators... "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling) _ -> -- NB: the driver is really supposed to handle bad options - IGNORE_ARG() + sep opts core_td stg_td ---------------- - simpl_sep :: [FAST_STRING] -- cmd-line opts (input) - -> [SimplifierSwitch] -- simplifier-switch accumulator - -> [CoreToDo] -> [StgToDo] -- to_do accumulators - -> ([CoreToDo], [StgToDo]) -- result + simpl_sep :: [FAST_STRING] -- cmd-line opts (input) + -> [SimplifierSwitch] -- simplifier-switch accumulator + -> [CoreToDo] -> [StgToDo] -- to_do accumulators + -> ([CoreToDo], [StgToDo]) -- result -- "simpl_sep" tailcalls "sep" once it's seen one set -- of SimplifierSwitches for a CoreDoSimplify. @@ -465,14 +488,13 @@ classifyOpts = sep argv [] [] -- accumulators... "-fcase-merge" -> SIMPL_SW(SimplCaseMerge) "-flet-to-case" -> SIMPL_SW(SimplLetToCase) "-fpedantic-bottoms" -> SIMPL_SW(SimplPedanticBottoms) - "-fkeep-spec-pragma-ids" -> SIMPL_SW(KeepSpecPragmaIds) - "-fkeep-unused-bindings" -> SIMPL_SW(KeepUnusedBindings) "-fmay-delete-conjurable-ids" -> SIMPL_SW(SimplMayDeleteConjurableIds) "-fessential-unfoldings-only" -> SIMPL_SW(EssentialUnfoldingsOnly) "-fignore-inline-pragma" -> SIMPL_SW(IgnoreINLINEPragma) "-fno-let-from-case" -> SIMPL_SW(SimplNoLetFromCase) "-fno-let-from-app" -> SIMPL_SW(SimplNoLetFromApp) "-fno-let-from-strict-let" -> SIMPL_SW(SimplNoLetFromStrictLet) + "-fclone-binds" -> SIMPL_SW(SimplCloneBinds) o | starts_with_msi -> SIMPL_SW(MaxSimplifierIterations (read after_msi)) where @@ -519,20 +541,19 @@ tagOf_SimplSwitch SimplDoLambdaEtaExpansion = ILIT(16) tagOf_SimplSwitch EssentialUnfoldingsOnly = ILIT(19) tagOf_SimplSwitch ShowSimplifierProgress = ILIT(20) tagOf_SimplSwitch (MaxSimplifierIterations _) = ILIT(21) -tagOf_SimplSwitch KeepSpecPragmaIds = ILIT(25) -tagOf_SimplSwitch KeepUnusedBindings = ILIT(26) tagOf_SimplSwitch SimplNoLetFromCase = ILIT(27) tagOf_SimplSwitch SimplNoLetFromApp = ILIT(28) tagOf_SimplSwitch SimplNoLetFromStrictLet = ILIT(29) tagOf_SimplSwitch SimplDontFoldBackAppend = ILIT(30) tagOf_SimplSwitch SimplCaseMerge = ILIT(31) tagOf_SimplSwitch SimplCaseScrutinee = ILIT(32) +tagOf_SimplSwitch SimplCloneBinds = ILIT(33) -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too! tagOf_SimplSwitch _ = panic# "tagOf_SimplSwitch" -lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplCaseScrutinee) +lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplCloneBinds) \end{code} %************************************************************************ @@ -542,22 +563,6 @@ lAST_SIMPL_SWITCH_TAG = IBOX(tagOf_SimplSwitch SimplCaseScrutinee) %************************************************************************ \begin{code} -#if __GLASGOW_HASKELL__ == 201 -# define ARRAY Array -# define LIFT GHCbase.Lift -# define SET_TO =: -(=:) a b = (a,b) -#elif __GLASGOW_HASKELL__ >= 202 -# define ARRAY Array -# define LIFT Lift -# define SET_TO =: -(=:) a b = (a,b) -#else -# define ARRAY _Array -# define LIFT _Lift -# define SET_TO := -#endif - isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult isAmongSimpl on_switches -- Switches mentioned later occur *earlier* @@ -573,20 +578,20 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* all_undefined) // defined_elems - all_undefined = [ i SET_TO SwBool False | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ] + all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ] defined_elems = map mk_assoc_elem tidied_on_switches in -- (avoid some unboxing, bounds checking, and other horrible things:) - case sw_tbl of { ARRAY bounds_who_needs_'em stuff -> + case sw_tbl of { Array bounds_who_needs_'em stuff -> \ switch -> case (indexArray# stuff (tagOf_SimplSwitch switch)) of - LIFT v -> v + Lift v -> v } where - mk_assoc_elem k@(MaxSimplifierIterations lvl) = IBOX(tagOf_SimplSwitch k) SET_TO SwInt lvl + mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl) - mk_assoc_elem k = IBOX(tagOf_SimplSwitch k) SET_TO SwBool True -- I'm here, Mom! + mk_assoc_elem k = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom! -- cannot have duplicates if we are going to use the array thing rm_dups switches_so_far switch @@ -621,15 +626,6 @@ switchIsOn lookup_fn switch SwBool False -> False _ -> True -stringSwitchSet :: (switch -> SwitchResult) - -> (FAST_STRING -> switch) - -> Maybe FAST_STRING - -stringSwitchSet lookup_fn switch - = case (lookup_fn (switch (panic "stringSwitchSet"))) of - SwString str -> Just str - _ -> Nothing - intSwitchSet :: (switch -> SwitchResult) -> (Int -> switch) -> Maybe Int