projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2000-10-24 15:58:02 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index cf3d9e1..348831a 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -1,5 +1,5 @@
 %
 %
-% (c) The AQUA Project, Glasgow University, 1996-98
+% (c) The University of Glasgow, 1996-2000
 %
 \section[CmdLineOpts]{Things to do with command-line options}
 
 %
 \section[CmdLineOpts]{Things to do with command-line options}
 
@@ -7,75 +7,28 @@
 
 module CmdLineOpts (
        CoreToDo(..),
 
 module CmdLineOpts (
        CoreToDo(..),
-       SimplifierSwitch(..),
+       SimplifierSwitch(..), isAmongSimpl,
        StgToDo(..),
        SwitchResult(..),
        StgToDo(..),
        SwitchResult(..),
-       classifyOpts,
+       HscLang(..),
+       DynFlag(..),    -- needed non-abstractly by DriverFlags
+       DynFlags(..),
 
        intSwitchSet,
        switchIsOn,
 
        intSwitchSet,
        switchIsOn,
-
-       -- debugging opts
-       dopt_D_dump_absC,
-       dopt_D_dump_asm,
-       dopt_D_dump_cpranal,
-       dopt_D_dump_cse,
-       dopt_D_dump_deriv,
-       dopt_D_dump_ds,
-       dopt_D_dump_flatC,
-       dopt_D_dump_foreign,
-       dopt_D_dump_hi_diffs,
-       dopt_D_dump_inlinings,
-       dopt_D_dump_occur_anal,
-       dopt_D_dump_parsed,
-       dopt_D_dump_realC,
-       dopt_D_dump_rn,
-       dopt_D_dump_rules,
-       dopt_D_dump_simpl,
-       dopt_D_dump_simpl_iterations,
-       dopt_D_dump_simpl_stats,
-       dopt_D_dump_spec,
-       dopt_D_dump_stg,
-       dopt_D_dump_stranal,
-       dopt_D_dump_tc,
-       dopt_D_dump_types,
-        dopt_D_dump_usagesp,
-       dopt_D_dump_worker_wrapper,
-       dopt_D_show_passes,
-       dopt_D_dump_rn_trace,
-       dopt_D_dump_rn_stats,
-        dopt_D_dump_stix,
-       dopt_D_dump_minimal_imports,
-       dopt_D_source_stats,
-       dopt_D_verbose_core2core,
-       dopt_D_verbose_stg2stg,
-       dopt_DoCoreLinting,
-       dopt_DoStgLinting,
-        dopt_DoUSPLinting,
+       isStaticHscFlag,
 
        opt_PprStyle_NoPrags,
        opt_PprUserLength,
        opt_PprStyle_Debug,
 
 
        opt_PprStyle_NoPrags,
        opt_PprUserLength,
        opt_PprStyle_Debug,
 
+       dopt,
+
        -- other dynamic flags
        dopt_CoreToDo,
        dopt_StgToDo,
        -- other dynamic flags
        dopt_CoreToDo,
        dopt_StgToDo,
-
-       -- warning opts
-       opt_WarnDuplicateExports,
-       opt_WarnHiShadows,
-       opt_WarnIncompletePatterns,
-       opt_WarnMissingFields,
-       opt_WarnMissingMethods,
-       opt_WarnMissingSigs,
-       opt_WarnNameShadowing,
-       opt_WarnOverlappingPatterns,
-       opt_WarnSimplePatterns,
-       opt_WarnTypeDefaults,
-       opt_WarnUnusedBinds,
-       opt_WarnUnusedImports,
-       opt_WarnUnusedMatches,
-       opt_WarnDeprecations,
+       dopt_HscLang,
+       dopt_OutName,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
 
        -- profiling opts
        opt_AutoSccsOnAllToplevs,
@@ -89,10 +42,6 @@ module CmdLineOpts (
        opt_AllStrict,
        opt_DictsStrict,
         opt_MaxContextReductionDepth,
        opt_AllStrict,
        opt_DictsStrict,
         opt_MaxContextReductionDepth,
-        dopt_AllowOverlappingInstances,
-       dopt_AllowUndecidableInstances,
-       dopt_GlasgowExts,
-       opt_Generics,
        opt_IrrefutableTuples,
        opt_NumbersStrict,
        opt_Parallel,
        opt_IrrefutableTuples,
        opt_NumbersStrict,
        opt_Parallel,
@@ -137,23 +86,11 @@ module CmdLineOpts (
        opt_NoImplicitPrelude,
        opt_OmitBlackHoling,
        opt_OmitInterfacePragmas,
        opt_NoImplicitPrelude,
        opt_OmitBlackHoling,
        opt_OmitInterfacePragmas,
-       opt_ProduceExportCStubs,
-       opt_ProduceExportHStubs,
        opt_NoPruneTyDecls,
        opt_NoPruneDecls,
        opt_NoPruneTyDecls,
        opt_NoPruneDecls,
-       opt_ReportCompile,
        opt_Static,
        opt_Unregisterised,
        opt_Static,
        opt_Unregisterised,
-       opt_Verbose,
-
-       opt_OutputLanguage,
-       opt_OutputFile,
-
-       -- Code generation
-       opt_UseVanillaRegs,
-       opt_UseFloatRegs,
-       opt_UseDoubleRegs,
-       opt_UseLongRegs
+       opt_Verbose
     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"
@@ -162,6 +99,8 @@ import Array ( array, (//) )
 import GlaExts
 import Argv
 import Constants       -- Default values for some flags
 import GlaExts
 import Argv
 import Constants       -- Default values for some flags
+import Util
+import FastTypes
 
 import Maybes          ( firstJust )
 import Panic           ( panic )
 
 import Maybes          ( firstJust )
 import Panic           ( panic )
@@ -188,14 +127,11 @@ Static flags are represented by top-level values of type Bool or Int,
 for example.  They therefore have the same value throughout the
 invocation of hsc.
 
 for example.  They therefore have the same value throughout the
 invocation of hsc.
 
-Dynamic flags are represented by a function:
-
-       checkDynFlag :: DynFlag -> SwitchResult
-
-which is passed into hsc by the compilation manager for every
-compilation.  Dynamic flags are those that change on a per-compilation
-basis, perhaps because they may be present in the OPTIONS pragma at
-the top of a module.
+Dynamic flags are represented by an abstract type, DynFlags, which is
+passed into hsc by the compilation manager for every compilation.
+Dynamic flags are those that change on a per-compilation basis,
+perhaps because they may be present in the OPTIONS pragma at the top
+of a module.
 
 Other flag-related blurb:
 
 
 Other flag-related blurb:
 
@@ -240,9 +176,11 @@ data CoreToDo              -- These are diff core-to-core passes,
   | CoreDoWorkerWrapper
   | CoreDoSpecialising
   | CoreDoUSPInf
   | CoreDoWorkerWrapper
   | CoreDoSpecialising
   | CoreDoUSPInf
-  | CoreDoCPResult 
+  | CoreDoCPResult
   | CoreDoGlomBinds
   | CoreCSE
   | CoreDoGlomBinds
   | CoreCSE
+
+  | CoreDoNothing       -- useful when building up lists of these things
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
@@ -313,69 +251,59 @@ data DynFlag
    | Opt_DoStgLinting
    | Opt_DoUSPLinting
 
    | Opt_DoStgLinting
    | Opt_DoUSPLinting
 
+   | Opt_WarnDuplicateExports
+   | Opt_WarnHiShadows
+   | Opt_WarnIncompletePatterns
+   | Opt_WarnMissingFields
+   | Opt_WarnMissingMethods
+   | Opt_WarnMissingSigs
+   | Opt_WarnNameShadowing
+   | Opt_WarnOverlappingPatterns
+   | Opt_WarnSimplePatterns
+   | Opt_WarnTypeDefaults
+   | Opt_WarnUnusedBinds
+   | Opt_WarnUnusedImports
+   | Opt_WarnUnusedMatches
+   | Opt_WarnDeprecations
+
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
    | Opt_GlasgowExts
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
    | Opt_GlasgowExts
+   | Opt_Generics
+
+   -- misc
+   | Opt_ReportCompile
    deriving (Eq)
 
    deriving (Eq)
 
-newtype DynFlags = DynFlags (CoreToDo, StgToDo, [(DynFlag, SwitchResult)])
-
-boolOpt :: DynFlag -> DynFlags -> Bool
-boolOpt f (DynFlags (_, _, dflags))
-  = case lookup f dflags of
-       Nothing -> False
-       Just (SwBool b) -> b
-       _ -> panic "boolOpt"
-
-dopt_D_dump_all              = boolOpt Opt_D_dump_all
-dopt_D_dump_most             = boolOpt Opt_D_dump_most
-dopt_D_dump_absC             = boolOpt Opt_D_dump_absC
-dopt_D_dump_asm              = boolOpt Opt_D_dump_asm
-dopt_D_dump_cpranal          = boolOpt Opt_D_dump_cpranal
-dopt_D_dump_deriv            = boolOpt Opt_D_dump_deriv
-dopt_D_dump_ds               = boolOpt Opt_D_dump_ds
-dopt_D_dump_flatC            = boolOpt Opt_D_dump_flatC
-dopt_D_dump_foreign          = boolOpt Opt_D_dump_foreign
-dopt_D_dump_inlinings        = boolOpt Opt_D_dump_inlinings
-dopt_D_dump_occur_anal       = boolOpt Opt_D_dump_occur_anal
-dopt_D_dump_parsed           = boolOpt Opt_D_dump_parsed
-dopt_D_dump_realC            = boolOpt Opt_D_dump_realC
-dopt_D_dump_rn               = boolOpt Opt_D_dump_rn
-dopt_D_dump_simpl            = boolOpt Opt_D_dump_simpl
-dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations
-dopt_D_dump_spec             = boolOpt Opt_D_dump_spec
-dopt_D_dump_stg              = boolOpt Opt_D_dump_stg
-dopt_D_dump_stranal          = boolOpt Opt_D_dump_stranal
-dopt_D_dump_tc               = boolOpt Opt_D_dump_tc
-dopt_D_dump_types            = boolOpt Opt_D_dump_types
-dopt_D_dump_rules            = boolOpt Opt_D_dump_rules
-dopt_D_dump_usagesp          = boolOpt Opt_D_dump_usagesp
-dopt_D_dump_cse              = boolOpt Opt_D_dump_cse
-dopt_D_dump_worker_wrapper   = boolOpt Opt_D_dump_worker_wrapper
-dopt_D_show_passes           = boolOpt Opt_D_show_passes
-dopt_D_dump_rn_trace         = boolOpt Opt_D_dump_rn_trace
-dopt_D_dump_rn_stats         = boolOpt Opt_D_dump_rn_stats
-dopt_D_dump_stix             = boolOpt Opt_D_dump_stix
-dopt_D_dump_simpl_stats      = boolOpt Opt_D_dump_simpl_stats
-dopt_D_source_stats          = boolOpt Opt_D_source_stats
-dopt_D_verbose_core2core     = boolOpt Opt_D_verbose_core2core
-dopt_D_verbose_stg2stg       = boolOpt Opt_D_verbose_stg2stg
-dopt_D_dump_hi_diffs         = boolOpt Opt_D_dump_hi_diffs
-dopt_D_dump_minimal_imports  = boolOpt Opt_D_dump_minimal_imports
-dopt_DoCoreLinting           = boolOpt Opt_DoCoreLinting
-dopt_DoStgLinting            = boolOpt Opt_DoStgLinting
-dopt_DoUSPLinting            = boolOpt Opt_DoUSPLinting
-
-dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances
-dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances
-dopt_GlasgowExts               = boolOpt Opt_GlasgowExts
+data DynFlags = DynFlags {
+  coreToDo   :: CoreToDo,
+  stgToDo    :: StgToDo,
+  hscLang    :: HscLang,
+  hscOutName :: String,  -- name of the file in which to place output
+  flags      :: [DynFlag]
+ }
+
+dopt :: DynFlag -> DynFlags -> Bool
+dopt f dflags  = f `elem` (flags dflags)
 
 dopt_CoreToDo :: DynFlags -> CoreToDo
 
 dopt_CoreToDo :: DynFlags -> CoreToDo
-dopt_CoreToDo (DynFlags (core_todo,_,_)) = core_todo
+dopt_CoreToDo = coreToDo
 
 dopt_StgToDo :: DynFlags -> StgToDo
 
 dopt_StgToDo :: DynFlags -> StgToDo
-dopt_StgToDo (DynFlags (_,stg_todo,_)) = stg_todo
+dopt_StgToDo = stgToDo
+
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
+
+data HscLang
+  = HscC
+  | HscAsm
+  | HscJava
+  | HscInterpreter
+
+dopt_HscLang :: DynFlags -> HscLang
+dopt_HscLang = hscLang
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -442,22 +370,6 @@ 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
 
 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")
 -- profiling opts
 opt_AutoSccsOnAllToplevs       = lookUp  SLIT("-fauto-sccs-on-all-toplevs")
 opt_AutoSccsOnExportedToplevs  = lookUp  SLIT("-fauto-sccs-on-exported-toplevs")
@@ -469,7 +381,6 @@ opt_DoTickyProfiling                = lookUp  SLIT("-fticky-ticky")
 -- language opts
 opt_AllStrict                  = lookUp  SLIT("-fall-strict")
 opt_DictsStrict                        = lookUp  SLIT("-fdicts-strict")
 -- 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_IrrefutableTuples          = lookUp  SLIT("-firrefutable-tuples")
 opt_MaxContextReductionDepth   = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
 opt_NumbersStrict              = lookUp  SLIT("-fnumbers-strict")
@@ -486,7 +397,7 @@ opt_UsageSPOn               = lookUp  SLIT("-fusagesp-on")
 opt_UnboxStrictFields          = lookUp  SLIT("-funbox-strict-fields")
 
 {-
 opt_UnboxStrictFields          = lookUp  SLIT("-funbox-strict-fields")
 
 {-
-   The optional '-inpackage=P' flag tells what package 
+   The optional '-inpackage=P' flag tells what package
    we are compiling this module for.
    The Prelude, for example is compiled with '-package prelude'
 -}
    we are compiling this module for.
    The Prelude, for example is compiled with '-package prelude'
 -}
@@ -505,18 +416,6 @@ 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_NoImplicitPrelude          = lookUp  SLIT("-fno-implicit-prelude")
 opt_OmitBlackHoling            = lookUp  SLIT("-dno-black-holing")
 opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
-opt_ProduceExportCStubs                = lookup_str "-F="
-opt_ProduceExportHStubs                = lookup_str "-FH="
-
--- 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")
 
 -- Simplifier switches
 opt_SimplNoPreInlining         = lookUp SLIT("-fno-pre-inlining")
@@ -540,113 +439,75 @@ opt_UF_UpdateInPlace             = lookUp  SLIT("-funfolding-update-in-place")
 opt_UF_CheapOp  = ( 1 :: Int)  -- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
                        
 opt_UF_CheapOp  = ( 1 :: Int)  -- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
                        
-opt_ReportCompile               = lookUp SLIT("-freport-compile")
 opt_NoPruneDecls               = lookUp SLIT("-fno-prune-decls")
 opt_NoPruneTyDecls             = lookUp SLIT("-fno-prune-tydecls")
 opt_Static                     = lookUp SLIT("-static")
 opt_Unregisterised             = lookUp SLIT("-funregisterised")
 opt_Verbose                    = lookUp SLIT("-v")
 opt_NoPruneDecls               = lookUp SLIT("-fno-prune-decls")
 opt_NoPruneTyDecls             = lookUp SLIT("-fno-prune-tydecls")
 opt_Static                     = lookUp SLIT("-static")
 opt_Unregisterised             = lookUp SLIT("-funregisterised")
 opt_Verbose                    = lookUp SLIT("-v")
-
-opt_UseVanillaRegs | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Vanilla_REG
-opt_UseFloatRegs   | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Float_REG
-opt_UseDoubleRegs  | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Double_REG
-opt_UseLongRegs    | opt_Unregisterised = 0
-                  | otherwise          = mAX_Real_Long_REG
 \end{code}
 
 \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)
-       -> [CoreToDo] -> [StgToDo]       -- to_do accumulators
-       -> ([CoreToDo], [StgToDo])       -- result
-
-    sep [] core_td stg_td -- all done!
-      = (reverse core_td, reverse stg_td)
-
-#      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)
-
-    sep (opt1:opts) core_td stg_td
-      = 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
-
-         "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
-         "-ffloat-outwards"      -> CORE_TD(CoreDoFloatOutwards False)
-         "-ffloat-outwards-full" -> CORE_TD(CoreDoFloatOutwards True)
-         "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
-         "-fcse"            -> CORE_TD(CoreCSE)
-         "-fglom-binds"     -> CORE_TD(CoreDoGlomBinds)
-         "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
-         "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
-         "-fstrictness"     -> CORE_TD(CoreDoStrictness)
-         "-fworker-wrapper" -> CORE_TD(CoreDoWorkerWrapper)
-         "-fspecialise"     -> CORE_TD(CoreDoSpecialising)
-         "-fusagesp"        -> CORE_TD(CoreDoUSPInf)
-         "-fcpr-analyse"    -> CORE_TD(CoreDoCPResult)
-
-         "-fstg-static-args" -> STG_TD(StgDoStaticArgs)
-         "-dstg-stats"       -> STG_TD(D_stg_stats)
-         "-flambda-lift"     -> STG_TD(StgDoLambdaLift)
-         "-fmassage-stg-for-profiling" -> STG_TD(StgDoMassageForProfiling)
-
-         _ -> -- NB: the driver is really supposed to handle bad options
-              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" tailcalls "sep" once it's seen one set
-       -- of SimplifierSwitches for a CoreDoSimplify.
-
-#ifdef DEBUG
-    simpl_sep input@[] simpl_sw core_td stg_td
-      = panic "simpl_sep []"
-#endif
+%************************************************************************
+%*                                                                     *
+\subsection{List of static hsc flags}
+%*                                                                     *
+%************************************************************************
 
 
-       -- 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
-                   this_simpl = CoreDoSimplify (isAmongSimpl simpl_sw)
-                in
-                sep opts (this_simpl : core_td) stg_td
-
-         opt -> case matchSimplSw opt of
-                       Just sw -> simpl_sep opts (sw:simpl_sw) core_td stg_td
-                       Nothing -> simpl_sep opts simpl_sw      core_td stg_td
-
-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
-matchSwBool opt str sw | opt == str = Just sw
-                      | otherwise  = Nothing
-
-matchSwInt :: String -> String -> (Int -> a) -> Maybe a
-matchSwInt opt str sw = case startsWith str opt of
-                           Just opt_left -> Just (sw (read opt_left))
-                           Nothing       -> Nothing
+\begin{code}
+isStaticHscFlag f =
+  f `elem` [
+       "-fauto-sccs-on-all-toplevs",
+       "-fauto-sccs-on-exported-toplevs",
+       "-fauto-sccs-on-individual-cafs",
+       "-fauto-sccs-on-dicts",
+       "-fscc-profiling",
+       "-fticky-ticky",
+       "-fall-strict",
+       "-fdicts-strict",
+       "-fgenerics",
+       "-firrefutable-tuples",
+       "-fnumbers-strict",
+       "-fparallel",
+       "-fsmp",
+       "-fsemi-tagging",
+       "-ffoldr-build-on",
+       "-flet-no-escape",
+       "-funfold-casms-in-hi-file",
+       "-fusagesp-on",
+       "-funbox-strict-fields",
+       "-femit-extern-decls",
+       "-fglobalise-toplev-names",
+       "-fgransim",
+       "-fignore-asserts",
+       "-fignore-interface-pragmas",
+       "-fno-hi-version-check",
+       "-fno-implicit-prelude",
+       "-dno-black-holing",
+       "-fomit-interface-pragmas",
+       "-fno-pre-inlining",
+       "-fdo-eta-reduction",
+       "-fdo-lambda-eta-expansion",
+       "-fcase-of-case",
+       "-fcase-merge",
+       "-fpedantic-bottoms",
+       "-fexcess-precision",
+       "-funfolding-update-in-place",
+       "-freport-compile",
+       "-fno-prune-decls",
+       "-fno-prune-tydecls",
+       "-static",
+       "-funregisterised",
+       "-v" ]
+  || any (flip prefixMatch f) [
+       "-fcontext-stack",
+       "-fliberate-case-threshold",
+       "-fhi-version=",
+       "-fhistory-size",
+       "-funfolding-interface-threshold",
+       "-funfolding-creation-threshold",
+       "-funfolding-use-threshold",
+       "-funfolding-fun-discount",
+       "-funfolding-keeness-factor"
+     ]
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -655,23 +516,22 @@ matchSwInt opt str sw = case startsWith str opt of
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-In spite of the @Produce*@ constructor, these things behave just like
-enumeration types.
+These things behave just like enumeration types.
 
 \begin{code}
 instance Eq SimplifierSwitch where
 
 \begin{code}
 instance Eq SimplifierSwitch where
-    a == b = tagOf_SimplSwitch a _EQ_ tagOf_SimplSwitch b
+    a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
 
 instance Ord SimplifierSwitch where
 
 instance Ord SimplifierSwitch where
-    a <  b  = tagOf_SimplSwitch a _LT_ tagOf_SimplSwitch b
-    a <= b  = tagOf_SimplSwitch a _LE_ tagOf_SimplSwitch b
+    a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
+    a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
 
 
 
 
-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)
+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!
 
 
 -- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
 
@@ -686,7 +546,6 @@ lAST_SIMPL_SWITCH_TAG = 5
 
 \begin{code}
 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
 
 \begin{code}
 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-
 isAmongSimpl on_switches               -- Switches mentioned later occur *earlier*
                                        -- in the list; defaults right at the end.
   = let
 isAmongSimpl on_switches               -- Switches mentioned later occur *earlier*
                                        -- in the list; defaults right at the end.
   = let
@@ -720,9 +579,12 @@ isAmongSimpl on_switches           -- Switches mentioned later occur *earlier*
 #endif
     }
   where
 #endif
     }
   where
-    mk_assoc_elem k@(MaxSimplifierIterations lvl) = (IBOX(tagOf_SimplSwitch k), SwInt lvl)
-    mk_assoc_elem k@(SimplInlinePhase n)          = (IBOX(tagOf_SimplSwitch k), SwInt n)
-    mk_assoc_elem k                              = (IBOX(tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
+    mk_assoc_elem k@(MaxSimplifierIterations lvl)
+       = (iBox (tagOf_SimplSwitch k), SwInt lvl)
+    mk_assoc_elem k@(SimplInlinePhase n)
+       = (iBox (tagOf_SimplSwitch k), SwInt n)
+    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
 
     -- cannot have duplicates if we are going to use the array thing
     rm_dups switches_so_far switch
@@ -731,7 +593,7 @@ isAmongSimpl on_switches            -- Switches mentioned later occur *earlier*
        else switch : switches_so_far
       where
        sw `is_elem` []     = False
        else switch : switches_so_far
       where
        sw `is_elem` []     = False
-       sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) _EQ_ (tagOf_SimplSwitch s)
+       sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
                            || sw `is_elem` ss
 \end{code}
 
                            || sw `is_elem` ss
 \end{code}
 
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)