[project @ 1998-05-12 15:08:57 by sof]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index 8fd3c64..499b7f7 100644 (file)
@@ -4,8 +4,6 @@
 \section[CmdLineOpts]{Things to do with command-line options}
 
 \begin{code}
-#include "HsVersions.h"
-
 module CmdLineOpts (
        CoreToDo(..),
        SimplifierSwitch(..),
@@ -17,15 +15,14 @@ module CmdLineOpts (
        switchIsOn,
 
        maybe_CompilingGhcInternals,
-       opt_AllDemanded,
        opt_AllStrict,
+        opt_AllowOverlappingInstances,
        opt_AutoSccsOnAllToplevs,
        opt_AutoSccsOnExportedToplevs,
        opt_AutoSccsOnIndividualCafs,
        opt_CompilingGhcInternals,
        opt_D_dump_absC,
        opt_D_dump_asm,
-       opt_D_dump_deforest,
        opt_D_dump_deriv,
        opt_D_dump_ds,
        opt_D_dump_flatC,
@@ -41,6 +38,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,
@@ -52,25 +50,21 @@ module CmdLineOpts (
        opt_DoTickyProfiling,
        opt_EnsureSplittableC,
        opt_FoldrBuildOn,
-       opt_FoldrBuildTrace,
        opt_ForConcurrent,
        opt_GlasgowExts,
        opt_GranMacros,
-       opt_Haskell_1_3,
        opt_HiMap,
        opt_IgnoreIfacePragmas,
-       opt_IgnoreStrictnessPragmas,
-       opt_IrrefutableEverything,
        opt_IrrefutableTuples,
        opt_LiberateCaseThreshold,
+       opt_MultiParamClasses,
        opt_NoImplicitPrelude,
        opt_NumbersStrict,
        opt_OmitBlackHoling,
-       opt_OmitDefaultInstanceMethods,
        opt_OmitInterfacePragmas,
        opt_PprStyle_All,
        opt_PprStyle_Debug,
-       opt_PprStyle_User,
+       opt_PprStyle_User,              -- ToDo: rm
        opt_PprUserLength,
        opt_ProduceC,
        opt_ProduceHi,
@@ -80,7 +74,6 @@ module CmdLineOpts (
        opt_SccGroup,
        opt_SccProfilingOn,
        opt_ShowImportSpecs,
-       opt_ShowPragmaNameErrs,
        opt_SigsRequired,
        opt_SourceUnchanged,
        opt_SpecialiseAll,
@@ -94,35 +87,38 @@ module CmdLineOpts (
        opt_UnfoldingCreationThreshold,
        opt_UnfoldingConDiscount,
        opt_UnfoldingUseThreshold,
+       opt_UnfoldingKeenessFactor,
 
        opt_Verbose,
        opt_WarnNameShadowing,
-       opt_WarnUnusedNames,
+       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
     ) where
 
-IMPORT_1_3(Array(array, (//)))
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
-import PreludeGlaST    -- bad bad bad boy, Will (_Array internals)
-#else
+#include "HsVersions.h"
+
+import Array   ( array, (//) )
 import GlaExts
-import ArrBase
--- 2.04 and later exports Lift from GlaExts
-#if __GLASGOW_HASKELL__ < 204
-import PrelBase (Lift(..))
-#endif
-#endif
 import Argv
-
-CHK_Ubiq() -- debugging consistency check
-
 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
@@ -170,7 +166,6 @@ data CoreToDo               -- These are diff core-to-core passes,
   | CoreDoStaticArgs
   | CoreDoStrictness
   | CoreDoSpecialising
-  | CoreDoDeforest
   | CoreDoFoldrBuildWorkerWrapper
   | CoreDoFoldrBuildWWAnal
 \end{code}
@@ -216,9 +211,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
@@ -239,6 +231,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}
 
 %************************************************************************
@@ -248,10 +246,11 @@ data SimplifierSwitch
 %************************************************************************
 
 \begin{code}
-lookUp        :: FAST_STRING -> Bool
-lookup_int     :: String -> Maybe Int
-lookup_def_int :: String -> Int -> Int
-lookup_str     :: String -> Maybe String
+lookUp          :: FAST_STRING -> Bool
+lookup_int              :: String -> Maybe Int
+lookup_def_int   :: String -> Int -> Int
+lookup_def_float :: String -> Float -> Float
+lookup_str       :: String -> Maybe String
 
 lookUp     sw = maybeToBool (assoc_opts sw)
        
@@ -265,13 +264,17 @@ lookup_def_int sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> read xx
 
+lookup_def_float sw def = case (lookup_str sw) of
+                           Nothing -> def              -- Use default
+                           Just xx -> read xx
+
 assoc_opts    = assocMaybe [ (a, True) | a <- argv ]
 unpacked_opts = map _UNPK_ argv
 \end{code}
 
 \begin{code}
-opt_AllDemanded                        = lookUp  SLIT("-fall-demanded")
 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")
@@ -279,7 +282,6 @@ opt_CompilingGhcInternals   = maybeToBool maybe_CompilingGhcInternals
 maybe_CompilingGhcInternals    = lookup_str "-fcompiling-ghc-internals="
 opt_D_dump_absC                        = lookUp  SLIT("-ddump-absC")
 opt_D_dump_asm                 = lookUp  SLIT("-ddump-asm")
-opt_D_dump_deforest            = lookUp  SLIT("-ddump-deforest")
 opt_D_dump_deriv               = lookUp  SLIT("-ddump-deriv")
 opt_D_dump_ds                  = lookUp  SLIT("-ddump-ds")
 opt_D_dump_flatC               = lookUp  SLIT("-ddump-flatC")
@@ -295,6 +297,7 @@ 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")
@@ -306,20 +309,17 @@ opt_DoTickyProfiling              = lookUp  SLIT("-fticky-ticky")
 opt_DoEtaReduction             = lookUp  SLIT("-fdo-eta-reduction")
 opt_EnsureSplittableC          = lookUp  SLIT("-fglobalise-toplev-names")
 opt_FoldrBuildOn               = lookUp  SLIT("-ffoldr-build-on")
-opt_FoldrBuildTrace            = lookUp  SLIT("-ffoldr-build-trace")
 opt_ForConcurrent              = lookUp  SLIT("-fconcurrent")
 opt_GranMacros                 = lookUp  SLIT("-fgransim")
 opt_GlasgowExts                        = lookUp  SLIT("-fglasgow-exts")
-opt_Haskell_1_3                        = lookUp  SLIT("-fhaskell-1.3")
 opt_HiMap                      = lookup_str "-himap="  -- file saying where to look for .hi files
 opt_IgnoreIfacePragmas         = lookUp  SLIT("-fignore-interface-pragmas")
-opt_IgnoreStrictnessPragmas    = lookUp  SLIT("-fignore-strictness-pragmas")
-opt_IrrefutableEverything      = lookUp  SLIT("-firrefutable-everything")
 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_OmitDefaultInstanceMethods = lookUp  SLIT("-fomit-default-instance-methods")
 opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
 opt_PprStyle_All               = lookUp  SLIT("-dppr-all")
 opt_PprStyle_Debug             = lookUp  SLIT("-dppr-debug")
@@ -331,7 +331,6 @@ opt_ProduceHi                       = lookup_str "-hifile=" -- the one to produce this time
 opt_ReportWhyUnfoldingsDisallowed= lookUp SLIT("-freport-disallowed-unfoldings")
 opt_SccProfilingOn             = lookUp  SLIT("-fscc-profiling")
 opt_ShowImportSpecs            = lookUp  SLIT("-fshow-import-specs")
-opt_ShowPragmaNameErrs         = lookUp  SLIT("-fshow-pragma-name-errs")
 opt_SigsRequired               = lookUp  SLIT("-fsignatures-required")
 opt_SourceUnchanged            = lookUp  SLIT("-fsource-unchanged")
 opt_SpecialiseAll              = lookUp  SLIT("-fspecialise-all")
@@ -350,12 +349,19 @@ opt_UnfoldingUseThreshold = lookup_def_int "-funfolding-use-threshold"       uNFOLD
 opt_UnfoldingConDiscount       = lookup_def_int "-funfolding-con-discount"        uNFOLDING_CON_DISCOUNT_WEIGHT
                        
 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_WarnIncompletePatterns     = not (lookUp  SLIT("-fno-warn-incomplete-patterns"))
-opt_WarnUnusedNames            = lookUp  SLIT("-fwarn-unused-names")
+opt_WarnHiShadows              = lookUp  SLIT("-fwarn-hi-shadowing")
+opt_WarnIncompletePatterns     = lookUp  SLIT("-fwarn-incomplete-patterns")
+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"
@@ -396,7 +402,6 @@ classifyOpts = sep argv [] [] -- accumulators...
          "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
          "-fstrictness"     -> CORE_TD(CoreDoStrictness)
          "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
-         "-fdeforest"       -> CORE_TD(CoreDoDeforest)
          "-ffoldr-build-worker-wrapper"  -> CORE_TD(CoreDoFoldrBuildWorkerWrapper)
          "-ffoldr-build-ww-anal"  -> CORE_TD(CoreDoFoldrBuildWWAnal)
 
@@ -424,12 +429,12 @@ classifyOpts = sep argv [] [] -- accumulators...
       = panic "simpl_sep []"
 #endif
 
-       -- The SimplifierSwitches should be delimited by "(" and ")".
+       -- The SimplifierSwitches should be delimited by "[" and "]".
 
     simpl_sep (opt1:opts) simpl_sw core_td stg_td
       = case (_UNPK_ opt1) of
-         "(" -> simpl_sep opts simpl_sw core_td stg_td
-         ")" -> let
+         "[" -> simpl_sep opts simpl_sw core_td stg_td
+         "]" -> let
                    this_simpl = CoreDoSimplify (isAmongSimpl simpl_sw)
                 in
                 sep opts (this_simpl : core_td) stg_td
@@ -453,14 +458,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
@@ -507,20 +511,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}
 
 %************************************************************************
@@ -530,21 +533,10 @@ 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
 
@@ -609,15 +601,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