[project @ 2000-07-23 10:53:11 by panne]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index cad5b77..49f35e0 100644 (file)
@@ -38,11 +38,14 @@ module CmdLineOpts (
        opt_D_dump_stg,
        opt_D_dump_stranal,
        opt_D_dump_tc,
+       opt_D_dump_types,
         opt_D_dump_usagesp,
        opt_D_dump_worker_wrapper,
        opt_D_show_passes,
        opt_D_dump_rn_trace,
        opt_D_dump_rn_stats,
+        opt_D_dump_stix,
+       opt_D_dump_minimal_imports,
        opt_D_source_stats,
        opt_D_verbose_core2core,
        opt_D_verbose_stg2stg,
@@ -57,6 +60,7 @@ module CmdLineOpts (
        opt_WarnDuplicateExports,
        opt_WarnHiShadows,
        opt_WarnIncompletePatterns,
+       opt_WarnMissingFields,
        opt_WarnMissingMethods,
        opt_WarnMissingSigs,
        opt_WarnNameShadowing,
@@ -66,13 +70,13 @@ module CmdLineOpts (
        opt_WarnUnusedBinds,
        opt_WarnUnusedImports,
        opt_WarnUnusedMatches,
+       opt_WarnDeprecations,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
        opt_AutoSccsOnExportedToplevs,
        opt_AutoSccsOnIndividualCafs,
        opt_AutoSccsOnDicts,
-       opt_SccGroup,
        opt_SccProfilingOn,
        opt_DoTickyProfiling,
 
@@ -86,13 +90,13 @@ module CmdLineOpts (
        opt_IrrefutableTuples,
        opt_NumbersStrict,
        opt_Parallel,
+       opt_SMP,
 
        -- optimisation opts
        opt_DoEtaReduction,
        opt_DoSemiTagging,
        opt_FoldrBuildOn,
        opt_LiberateCaseThreshold,
-       opt_NoPreInlining,
        opt_StgDoLetNoEscapes,
        opt_UnfoldCasms,
         opt_UsageSPOn,
@@ -102,8 +106,8 @@ module CmdLineOpts (
        opt_SimplDoLambdaEtaExpansion,
        opt_SimplCaseOfCase,
        opt_SimplCaseMerge,
-       opt_SimplLetToCase,
        opt_SimplPedanticBottoms,
+       opt_SimplExcessPrecision,
 
        -- Unfolding control
        opt_UF_HiFileThreshold,
@@ -115,14 +119,14 @@ module CmdLineOpts (
        opt_UF_KeenessFactor,
        opt_UF_CheapOp,
        opt_UF_DearOp,
-       opt_UF_NoRepLit,
 
        -- misc opts
-       opt_CompilingPrelude,
+       opt_InPackage,
        opt_EmitCExternDecls,
        opt_EnsureSplittableC,
        opt_GranMacros,
        opt_HiMap,
+       opt_HiMapSep,
        opt_HiVersion,
        opt_HistorySize,
        opt_IgnoreAsserts,
@@ -131,11 +135,12 @@ module CmdLineOpts (
        opt_NoImplicitPrelude,
        opt_OmitBlackHoling,
        opt_OmitInterfacePragmas,
-       opt_ProduceC,
        opt_ProduceExportCStubs,
        opt_ProduceExportHStubs,
-       opt_ProduceHi,
-       opt_ProduceS,
+       opt_HiFile,
+       opt_HiDir,
+       opt_HiSuf,
+       opt_NoPruneTyDecls,
        opt_NoPruneDecls,
        opt_ReportCompile,
        opt_SourceUnchanged,
@@ -143,6 +148,9 @@ module CmdLineOpts (
        opt_Unregisterised,
        opt_Verbose,
 
+       opt_OutputLanguage,
+       opt_OutputFile,
+
        -- Code generation
        opt_UseVanillaRegs,
        opt_UseFloatRegs,
@@ -169,8 +177,7 @@ import PrelArr  ( Array(..) )
 \end{code}
 
 A command-line {\em switch} is (generally) either on or off; e.g., the
-``verbose'' (-v) switch is either on or off.  (The \tr{-G<group>}
-switch is an exception; it's set to a string, or nothing.)
+``verbose'' (-v) switch is either on or off.
 
 A list of {\em ToDo}s is things to be done in a particular part of
 processing.  A (fictitious) example for the Core-to-Core simplifier
@@ -206,7 +213,7 @@ data CoreToDo               -- These are diff core-to-core passes,
                        -- Each run of the simplifier can take a different
                        -- set of simplifier-specific flags.
   | CoreDoFloatInwards
-  | CoreDoFullLaziness
+  | CoreDoFloatOutwards Bool   -- True <=> float lambdas to top level
   | CoreLiberateCase
   | CoreDoPrintCore
   | CoreDoStaticArgs
@@ -221,7 +228,6 @@ data CoreToDo               -- These are diff core-to-core passes,
 \begin{code}
 data StgToDo
   = StgDoStaticArgs
-  | StgDoUpdateAnalysis
   | StgDoLambdaLift
   | StgDoMassageForProfiling  -- should be (next to) last
   -- There's also setStgVarInfo, but its absolute "lastness"
@@ -233,6 +239,9 @@ data StgToDo
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | SimplInlinePhase Int
+  | DontApplyRules
+  | NoCaseOfCase
+  | SimplLetToCase
 \end{code}
 
 %************************************************************************
@@ -260,6 +269,10 @@ lookup_def_int sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> read xx
 
+lookup_def_char sw def = case (lookup_str sw) of
+                           Just (xx:_) -> xx
+                           _           -> def          -- Use default
+
 lookup_def_float sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
                            Just xx -> read xx
@@ -295,39 +308,42 @@ src_filename = case argv of
 
 \begin{code}
 -- debugging opts
-opt_D_dump_absC                        = lookUp  SLIT("-ddump-absC")
-opt_D_dump_asm                 = lookUp  SLIT("-ddump-asm")
--- Make the option agree with the doc! dump-cpranal is preferred over
--- dump-cpranalyse because of consistency with dump-stranal (and
--- we don't have to worry about british vs american english).
-opt_D_dump_cpranal             = lookUp  SLIT("-ddump-cpranal") ||
-                                 lookUp  SLIT("-ddump-cpranalyse")
-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_inlinings           = lookUp  SLIT("-ddump-inlinings")
-opt_D_dump_occur_anal          = lookUp  SLIT("-ddump-occur-anal")
-opt_D_dump_parsed              = lookUp  SLIT("-ddump-parsed")
-opt_D_dump_realC               = lookUp  SLIT("-ddump-realC")
-opt_D_dump_rn                  = lookUp  SLIT("-ddump-rn")
-opt_D_dump_simpl               = lookUp  SLIT("-ddump-simpl")
-opt_D_dump_simpl_iterations    = lookUp  SLIT("-ddump-simpl-iterations")
-opt_D_dump_spec                        = lookUp  SLIT("-ddump-spec")
-opt_D_dump_stg                 = lookUp  SLIT("-ddump-stg")
-opt_D_dump_stranal             = lookUp  SLIT("-ddump-stranal")
-opt_D_dump_tc                  = lookUp  SLIT("-ddump-tc")
-opt_D_dump_rules               = lookUp  SLIT("-ddump-rules")
-opt_D_dump_usagesp              = lookUp  SLIT("-ddump-usagesp")
-opt_D_dump_cse                         = lookUp  SLIT("-ddump-cse")
-opt_D_dump_worker_wrapper      = lookUp  SLIT("-ddump-workwrap")
-opt_D_show_passes              = lookUp  SLIT("-dshow-passes")
-opt_D_dump_rn_trace            = lookUp  SLIT("-ddump-rn-trace")
-opt_D_dump_rn_stats            = lookUp  SLIT("-ddump-rn-stats")
-opt_D_dump_simpl_stats         = lookUp  SLIT("-ddump-simpl-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_D_dump_all   {- do not -}   = lookUp  SLIT("-ddump-all")
+opt_D_dump_most  {- export -}   = opt_D_dump_all  || lookUp  SLIT("-ddump-most")
+
+opt_D_dump_absC                        = opt_D_dump_all  || lookUp  SLIT("-ddump-absC")
+opt_D_dump_asm                 = opt_D_dump_all  || lookUp  SLIT("-ddump-asm")
+opt_D_dump_cpranal             = opt_D_dump_most || lookUp  SLIT("-ddump-cpranal")
+opt_D_dump_deriv               = opt_D_dump_most || lookUp  SLIT("-ddump-deriv")
+opt_D_dump_ds                  = opt_D_dump_most || lookUp  SLIT("-ddump-ds")
+opt_D_dump_flatC               = opt_D_dump_all  || lookUp  SLIT("-ddump-flatC")
+opt_D_dump_foreign             = opt_D_dump_most || lookUp  SLIT("-ddump-foreign-stubs")
+opt_D_dump_inlinings           = opt_D_dump_all  || lookUp  SLIT("-ddump-inlinings")
+opt_D_dump_occur_anal          = opt_D_dump_all  || lookUp  SLIT("-ddump-occur-anal")
+opt_D_dump_parsed              = opt_D_dump_most || lookUp  SLIT("-ddump-parsed")
+opt_D_dump_realC               = opt_D_dump_all  || lookUp  SLIT("-ddump-realC")
+opt_D_dump_rn                  = opt_D_dump_most || lookUp  SLIT("-ddump-rn")
+opt_D_dump_simpl               = opt_D_dump_most || lookUp  SLIT("-ddump-simpl")
+opt_D_dump_simpl_iterations    = opt_D_dump_all  || lookUp  SLIT("-ddump-simpl-iterations")
+opt_D_dump_spec                        = opt_D_dump_most || lookUp  SLIT("-ddump-spec")
+opt_D_dump_stg                 = opt_D_dump_most || lookUp  SLIT("-ddump-stg")
+opt_D_dump_stranal             = opt_D_dump_most || lookUp  SLIT("-ddump-stranal")
+opt_D_dump_tc                  = opt_D_dump_most || lookUp  SLIT("-ddump-tc")
+opt_D_dump_types               = opt_D_dump_most || lookUp  SLIT("-ddump-types")
+opt_D_dump_rules               = opt_D_dump_most || lookUp  SLIT("-ddump-rules")
+opt_D_dump_usagesp              = opt_D_dump_most || lookUp  SLIT("-ddump-usagesp")
+opt_D_dump_cse                         = opt_D_dump_most || lookUp  SLIT("-ddump-cse")
+opt_D_dump_worker_wrapper      = opt_D_dump_most || lookUp  SLIT("-ddump-workwrap")
+opt_D_show_passes              = opt_D_dump_most || lookUp  SLIT("-dshow-passes")
+opt_D_dump_rn_trace            = opt_D_dump_all  || lookUp  SLIT("-ddump-rn-trace")
+opt_D_dump_rn_stats            = opt_D_dump_most || lookUp  SLIT("-ddump-rn-stats")
+opt_D_dump_stix                = opt_D_dump_all  || lookUp  SLIT("-ddump-stix")
+opt_D_dump_simpl_stats         = opt_D_dump_most || lookUp  SLIT("-ddump-simpl-stats")
+opt_D_source_stats             = opt_D_dump_most || lookUp  SLIT("-dsource-stats")
+opt_D_verbose_core2core                = opt_D_dump_all  || lookUp  SLIT("-dverbose-simpl")
+opt_D_verbose_stg2stg          = opt_D_dump_all  || lookUp  SLIT("-dverbose-stg")
+opt_D_dump_minimal_imports     = lookUp  SLIT("-ddump-minimal-imports")
+
 opt_DoCoreLinting              = lookUp  SLIT("-dcore-lint")
 opt_DoStgLinting               = lookUp  SLIT("-dstg-lint")
 opt_DoUSPLinting               = lookUp  SLIT("-dusagesp-lint")
@@ -339,6 +355,7 @@ opt_PprUserLength           = lookup_def_int "-dppr-user-length" 5 --ToDo: give th
 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")
@@ -348,13 +365,13 @@ 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_SccGroup                   = lookup_str "-G="
 opt_SccProfilingOn             = lookUp  SLIT("-fscc-profiling")
 opt_DoTickyProfiling           = lookUp  SLIT("-fticky-ticky")
 
@@ -368,30 +385,32 @@ 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_DoEtaReduction             = lookUp  SLIT("-fdo-eta-reduction")
 opt_DoSemiTagging              = lookUp  SLIT("-fsemi-tagging")
 opt_FoldrBuildOn               = lookUp  SLIT("-ffoldr-build-on")
 opt_LiberateCaseThreshold      = lookup_def_int "-fliberate-case-threshold" (10::Int)
-opt_NoPreInlining              = lookUp  SLIT("-fno-pre-inlining")
 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")
 
-  {-
-   It's a bit unfortunate to have to re-introduce this chap, but on Win32
-   platforms we do need a way of distinguishing between the case when we're
-   compiling a static version of the Prelude and one that's going to be
-   put into a DLL. Why? Because the compiler's wired in modules need to
-   be attributed as either coming from a DLL or not.
-  -}
-opt_CompilingPrelude           = lookUp  SLIT("-fcompiling-prelude")
+{-
+   The optional '-inpackage=P' flag tells what package 
+   we are compiling this module for.
+   The Prelude, for example is compiled with '-package prelude'
+-}
+opt_InPackage                  = case lookup_str "-inpackage=" of
+                                   Just p  -> _PK_ p
+                                   Nothing -> SLIT("Main")     -- The package name if none is specified
+
 opt_EmitCExternDecls           = lookUp  SLIT("-femit-extern-decls")
 opt_EnsureSplittableC          = lookUp  SLIT("-fglobalise-toplev-names")
 opt_GranMacros                 = lookUp  SLIT("-fgransim")
 opt_HiMap                      = lookup_str "-himap="       -- file saying where to look for .hi files
+opt_HiMapSep                    = lookup_def_char "-himap-sep=" ':'
 opt_HiVersion                  = lookup_def_int "-fhi-version=" 0 -- what version we're compiling.
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
@@ -400,10 +419,23 @@ opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
 opt_NoImplicitPrelude          = lookUp  SLIT("-fno-implicit-prelude")
 opt_OmitBlackHoling            = lookUp  SLIT("-dno-black-holing")
 opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
-opt_ProduceC                   = lookup_str "-C="
 opt_ProduceExportCStubs                = lookup_str "-F="
 opt_ProduceExportHStubs                = lookup_str "-FH="
-opt_ProduceHi                  = lookup_str "-hifile=" -- the one to produce this time 
+
+-- where to generate the .hi file
+opt_HiFile                     = lookup_str "-hifile="
+opt_HiDir                      = lookup_str "-hidir="
+opt_HiSuf                      = lookup_str "-hisuf="
+
+-- Language for output: "C", "asm", "java", maybe more
+-- Nothing => don't output anything
+opt_OutputLanguage :: Maybe String
+opt_OutputLanguage = lookup_str "-olang="
+
+opt_OutputFile :: String
+opt_OutputFile            = case lookup_str "-ofile=" of
+                       Nothing -> panic "No output file specified (-ofile=xxx)"
+                       Just f  -> f
 
 -- Simplifier switches
 opt_SimplNoPreInlining         = lookUp SLIT("-fno-pre-inlining")
@@ -413,25 +445,24 @@ opt_SimplDoEtaReduction           = lookUp SLIT("-fdo-eta-reduction")
 opt_SimplDoLambdaEtaExpansion  = lookUp SLIT("-fdo-lambda-eta-expansion")
 opt_SimplCaseOfCase            = lookUp SLIT("-fcase-of-case")
 opt_SimplCaseMerge             = lookUp SLIT("-fcase-merge")
-opt_SimplLetToCase             = lookUp SLIT("-flet-to-case")
 opt_SimplPedanticBottoms       = lookUp SLIT("-fpedantic-bottoms")
+opt_SimplExcessPrecision       = lookUp SLIT("-fexcess-precision")
 
 -- Unfolding control
-opt_UF_HiFileThreshold         = lookup_def_int "-funfolding-interface-threshold" (30::Int)
-opt_UF_CreationThreshold       = lookup_def_int "-funfolding-creation-threshold"  (30::Int)
+opt_UF_HiFileThreshold         = lookup_def_int "-funfolding-interface-threshold" (45::Int)
+opt_UF_CreationThreshold       = lookup_def_int "-funfolding-creation-threshold"  (45::Int)
 opt_UF_UseThreshold            = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
-opt_UF_ScrutConDiscount                = lookup_def_int "-funfolding-con-discount"        (3::Int)
+opt_UF_ScrutConDiscount                = lookup_def_int "-funfolding-con-discount"        (2::Int)
 opt_UF_FunAppDiscount          = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 opt_UF_PrimArgDiscount         = lookup_def_int "-funfolding-prim-discount"       (1::Int)
-opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (2.0::Float)
+opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 
-opt_UF_CheapOp  = ( 0 :: Int)  -- Only one instruction; and the args are charged for
+opt_UF_CheapOp  = ( 1 :: Int)  -- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
-opt_UF_NoRepLit = ( 20 :: Int) -- Strings can be pretty big
                        
-opt_ProduceS                   = lookup_str "-S="
 opt_ReportCompile               = lookUp SLIT("-freport-compile")
 opt_NoPruneDecls               = lookUp SLIT("-fno-prune-decls")
+opt_NoPruneTyDecls             = lookUp SLIT("-fno-prune-tydecls")
 opt_SourceUnchanged            = lookUp SLIT("-fsource-unchanged")
 opt_Static                     = lookUp SLIT("-static")
 opt_Unregisterised             = lookUp SLIT("-funregisterised")
@@ -471,7 +502,8 @@ classifyOpts = sep argv [] [] -- accumulators...
                           simpl_sep opts defaultSimplSwitches core_td stg_td
 
          "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
-         "-ffull-laziness"  -> CORE_TD(CoreDoFullLaziness)
+         "-ffloat-outwards"      -> CORE_TD(CoreDoFloatOutwards False)
+         "-ffloat-outwards-full" -> CORE_TD(CoreDoFloatOutwards True)
          "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
          "-fcse"            -> CORE_TD(CoreCSE)
          "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
@@ -483,7 +515,6 @@ classifyOpts = sep argv [] [] -- accumulators...
          "-fcpr-analyse"    -> CORE_TD(CoreDoCPResult)
 
          "-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)
@@ -523,6 +554,9 @@ classifyOpts = sep argv [] [] -- accumulators...
 matchSimplSw opt
   = firstJust  [ matchSwInt  opt "-fmax-simplifier-iterations"         MaxSimplifierIterations
                , matchSwInt  opt "-finline-phase"                      SimplInlinePhase
+               , matchSwBool opt "-fno-rules"                          DontApplyRules
+               , matchSwBool opt "-fno-case-of-case"                   NoCaseOfCase
+               , matchSwBool opt "-flet-to-case"                       SimplLetToCase
                ]
 
 matchSwBool :: String -> String -> a -> Maybe a
@@ -541,8 +575,8 @@ matchSwInt opt str sw = case startsWith str opt of
 %*                                                                     *
 %************************************************************************
 
-In spite of the @Produce*@ and @SccGroup@ constructors, these things
-behave just like enumeration types.
+In spite of the @Produce*@ constructor, these things behave just like
+enumeration types.
 
 \begin{code}
 instance Eq SimplifierSwitch where
@@ -555,10 +589,13 @@ instance Ord SimplifierSwitch where
 
 tagOf_SimplSwitch (SimplInlinePhase _)         = ILIT(1)
 tagOf_SimplSwitch (MaxSimplifierIterations _)  = ILIT(2)
+tagOf_SimplSwitch DontApplyRules               = ILIT(3)
+tagOf_SimplSwitch SimplLetToCase               = ILIT(4)
+tagOf_SimplSwitch NoCaseOfCase                 = ILIT(5)
 
 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 
-lAST_SIMPL_SWITCH_TAG = 2
+lAST_SIMPL_SWITCH_TAG = 5
 \end{code}
 
 %************************************************************************
@@ -587,7 +624,11 @@ isAmongSimpl on_switches           -- Switches mentioned later occur *earlier*
        defined_elems = map mk_assoc_elem tidied_on_switches
     in
     -- (avoid some unboxing, bounds checking, and other horrible things:)
+#if __GLASGOW_HASKELL__ < 405
     case sw_tbl of { Array bounds_who_needs_'em stuff ->
+#else
+    case sw_tbl of { Array _ _ stuff ->
+#endif
     \ switch ->
        case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 #if __GLASGOW_HASKELL__ < 400