[project @ 2002-02-01 15:18:18 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 0f204ff..e19c24a 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -8,7 +8,7 @@
 module CmdLineOpts (
        CoreToDo(..), StgToDo(..),
        SimplifierSwitch(..), 
-       SimplifierMode(..),
+       SimplifierMode(..), FloatOutSwitches(..),
 
        HscLang(..),
        DynFlag(..),    -- needed non-abstractly by DriverFlags
@@ -26,6 +26,9 @@ module CmdLineOpts (
        dopt_StgToDo,                   -- DynFlags -> [StgToDo]
        dopt_HscLang,                   -- DynFlags -> HscLang
        dopt_OutName,                   -- DynFlags -> String
+       getOpts,                        -- (DynFlags -> [a]) -> IO [a]
+       setLang,
+       getVerbFlag,
 
        -- Manipulating the DynFlags state
        getDynFlags,                    -- IO DynFlags
@@ -63,7 +66,6 @@ module CmdLineOpts (
        opt_NumbersStrict,
        opt_Parallel,
        opt_SMP,
-       opt_NoMonomorphismRestriction,
        opt_RuntimeTypes,
 
        -- optimisation opts
@@ -172,7 +174,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
-  | CoreDoFloatOutwards Bool   -- True <=> float lambdas to top level
+  | CoreDoFloatOutwards FloatOutSwitches
   | CoreLiberateCase
   | CoreDoPrintCore
   | CoreDoStaticArgs
@@ -206,6 +208,11 @@ data SimplifierMode                -- See comments in SimplMonad
 data SimplifierSwitch
   = MaxSimplifierIterations Int
   | NoCaseOfCase
+
+data FloatOutSwitches
+  = FloatOutSw  Bool   -- True <=> float lambdas to top level
+               Bool    -- True <=> float constants to top level,
+                       --          even if they do not escape a lambda
 \end{code}
 
 %************************************************************************
@@ -233,7 +240,7 @@ data DynFlag
    | Opt_D_dump_simpl
    | Opt_D_dump_simpl_iterations
    | Opt_D_dump_spec
-   | Opt_D_dump_sat
+   | Opt_D_dump_prep
    | Opt_D_dump_stg
    | Opt_D_dump_stranal
    | Opt_D_dump_tc
@@ -277,6 +284,8 @@ data DynFlag
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
+   | Opt_AllowIncoherentInstances
+   | Opt_NoMonomorphismRestriction
    | Opt_GlasgowExts
    | Opt_Generics
    | Opt_NoImplicitPrelude 
@@ -293,12 +302,14 @@ data DynFlags = DynFlags {
   extCoreName          :: String,      -- name of the .core output file
   verbosity            :: Int,         -- verbosity level
   cppFlag              :: Bool,        -- preprocess with cpp?
+  ppFlag                :: Bool,        -- preprocess with a Haskell Pp?
   stolen_x86_regs      :: Int,         
   cmdlineHcIncludes    :: [String],    -- -#includes
 
   -- options for particular phases
   opt_L                        :: [String],
   opt_P                        :: [String],
+  opt_F                        :: [String],
   opt_c                        :: [String],
   opt_a                        :: [String],
   opt_m                        :: [String],
@@ -328,10 +339,12 @@ defaultDynFlags = DynFlags {
   extCoreName = "",
   verbosity = 0, 
   cppFlag              = False,
+  ppFlag                = False,
   stolen_x86_regs      = 4,
   cmdlineHcIncludes    = [],
   opt_L                        = [],
   opt_P                        = [],
+  opt_F                 = [],
   opt_c                        = [],
   opt_a                        = [],
   opt_m                        = [],
@@ -373,6 +386,22 @@ dopt_set dfs f = dfs{ flags = f : flags dfs }
 
 dopt_unset :: DynFlags -> DynFlag -> DynFlags
 dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
+
+getOpts :: (DynFlags -> [a]) -> IO [a]
+       -- We add to the options from the front, so we need to reverse the list
+getOpts opts = dynFlag opts >>= return . reverse
+
+-- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
+-- (-fvia-C, -fasm, -filx respectively).
+setLang l = updDynFlags (\ dfs -> case hscLang dfs of
+                                       HscC   -> dfs{ hscLang = l }
+                                       HscAsm -> dfs{ hscLang = l }
+                                       HscILX -> dfs{ hscLang = l }
+                                       _      -> dfs)
+
+getVerbFlag = do
+   verb <- dynFlag verbosity
+   if verb >= 3  then return  "-v" else return ""
 \end{code}
 
 -----------------------------------------------------------------------------
@@ -530,7 +559,6 @@ opt_DoTickyProfiling                = lookUp  SLIT("-fticky-ticky")
 
 -- language opts
 opt_AllStrict                  = lookUp  SLIT("-fall-strict")
-opt_NoMonomorphismRestriction  = lookUp  SLIT("-fno-monomorphism-restriction")
 opt_DictsStrict                        = lookUp  SLIT("-fdicts-strict")
 opt_IrrefutableTuples          = lookUp  SLIT("-firrefutable-tuples")
 opt_MaxContextReductionDepth   = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
@@ -561,7 +589,7 @@ opt_InPackage                       = case lookup_str "-inpackage=" of
 opt_EmitCExternDecls           = lookUp  SLIT("-femit-extern-decls")
 opt_EnsureSplittableC          = lookUp  SLIT("-fglobalise-toplev-names")
 opt_GranMacros                 = lookUp  SLIT("-fgransim")
-opt_HiVersion                  = read cProjectVersionInt :: Int
+opt_HiVersion                  = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
 opt_HistorySize                        = lookup_def_int "-fhistory-size" 20
 opt_IgnoreAsserts               = lookUp  SLIT("-fignore-asserts")
 opt_IgnoreIfacePragmas         = lookUp  SLIT("-fignore-interface-pragmas")