[project @ 2000-10-11 15:26:18 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index ab552fa..7b68e68 100644 (file)
@@ -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}
 
@@ -7,14 +7,16 @@
 
 module CmdLineOpts (
        CoreToDo(..),
-       SimplifierSwitch(..),
+       SimplifierSwitch(..), isAmongSimpl,
        StgToDo(..),
        SwitchResult(..),
        HscLang(..),
-       classifyOpts,
+       DynFlag(..),    -- needed non-abstractly by DriverFlags
+       DynFlags(..),
 
        intSwitchSet,
        switchIsOn,
+       isStaticHscFlag,
 
        -- debugging opts
        dopt_D_dump_absC,
@@ -158,6 +160,7 @@ import Array        ( array, (//) )
 import GlaExts
 import Argv
 import Constants       -- Default values for some flags
+import Util
 
 import Maybes          ( firstJust )
 import Panic           ( panic )
@@ -184,14 +187,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.
 
-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:
 
@@ -239,6 +239,8 @@ data CoreToDo               -- These are diff core-to-core passes,
   | CoreDoCPResult 
   | CoreDoGlomBinds
   | CoreCSE
+
+  | CoreDoNothing       -- useful when building up lists of these things
 \end{code}
 
 \begin{code}
@@ -319,15 +321,11 @@ data DynFlags = DynFlags {
   coreToDo :: CoreToDo,
   stgToDo  :: StgToDo,
   hscLang  :: HscLang,
-  flags    :: [(DynFlag, SwitchResult)]
+  flags    :: [DynFlag]
  }
 
 boolOpt :: DynFlag -> DynFlags -> Bool
-boolOpt f dflags
-  = case lookup f (flags dflags) of
-       Nothing -> False
-       Just (SwBool b) -> b
-       _ -> panic "boolOpt"
+boolOpt f dflags  = f `elem` (flags dflags)
 
 dopt_D_dump_all              = boolOpt Opt_D_dump_all
 dopt_D_dump_most             = boolOpt Opt_D_dump_most
@@ -555,96 +553,82 @@ opt_UseLongRegs    | opt_Unregisterised = 0
                   | otherwise          = mAX_Real_Long_REG
 \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` [
+       "-fwarn-duplicate-exports",
+       "-fwarn-hi-shadowing",
+       "-fwarn-incomplete-patterns",
+       "-fwarn-missing-fields",
+       "-fwarn-missing-methods",
+       "-fwarn-missing-signatures",
+       "-fwarn-name-shadowing",
+       "-fwarn-overlapping-patterns",
+       "-fwarn-simple-patterns",
+       "-fwarn-type-defaults",
+       "-fwarn-unused-binds",
+       "-fwarn-unused-imports",
+       "-fwarn-unused-matches",
+       "-fwarn-deprecations",
+       "-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}
 
 %************************************************************************
@@ -653,8 +637,7 @@ 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
@@ -684,7 +667,6 @@ lAST_SIMPL_SWITCH_TAG = 5
 
 \begin{code}
 isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-
 isAmongSimpl on_switches               -- Switches mentioned later occur *earlier*
                                        -- in the list; defaults right at the end.
   = let