[project @ 2003-06-24 07:58:18 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index 0f204ff..ed8e99b 100644 (file)
@@ -8,7 +8,7 @@
 module CmdLineOpts (
        CoreToDo(..), StgToDo(..),
        SimplifierSwitch(..), 
-       SimplifierMode(..),
+       SimplifierMode(..), FloatOutSwitches(..),
 
        HscLang(..),
        DynFlag(..),    -- needed non-abstractly by DriverFlags
@@ -20,12 +20,16 @@ module CmdLineOpts (
 
        -- Manipulating DynFlags
        defaultDynFlags,                -- DynFlags
+       defaultHscLang,                 -- HscLang
        dopt,                           -- DynFlag -> DynFlags -> Bool
        dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
        dopt_CoreToDo,                  -- DynFlags -> [CoreToDo]
        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,8 +67,8 @@ module CmdLineOpts (
        opt_NumbersStrict,
        opt_Parallel,
        opt_SMP,
-       opt_NoMonomorphismRestriction,
        opt_RuntimeTypes,
+       opt_Flatten,
 
        -- optimisation opts
        opt_NoMethodSharing,
@@ -73,7 +77,7 @@ module CmdLineOpts (
        opt_LiberateCaseThreshold,
        opt_StgDoLetNoEscapes,
        opt_UnfoldCasms,
-        opt_UsageSPOn,
+       opt_CprOff,
        opt_UnboxStrictFields,
        opt_SimplNoPreInlining,
        opt_SimplDoEtaReduction,
@@ -112,14 +116,15 @@ module CmdLineOpts (
 
 #include "HsVersions.h"
 
-import GlaExts
-import IOExts  ( IORef, readIORef, writeIORef )
 import Constants       -- Default values for some flags
 import Util
-import FastTypes
+import FastString      ( FastString, mkFastString )
 import Config
-
 import Maybes          ( firstJust )
+
+import GLAEXTS
+import DATA_IOREF      ( IORef, readIORef, writeIORef )
+import UNSAFE_IO       ( unsafePerformIO )
 \end{code}
 
 %************************************************************************
@@ -172,7 +177,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
@@ -180,8 +185,7 @@ data CoreToDo               -- These are diff core-to-core passes,
   | CoreDoWorkerWrapper
   | CoreDoSpecialising
   | CoreDoSpecConstr
-  | CoreDoUSPInf
-  | CoreDoCPResult
+  | CoreDoOldStrictness
   | CoreDoGlomBinds
   | CoreCSE
   | CoreDoRuleCheck Int{-CompilerPhase-} String        -- Check for non-application of rules 
@@ -206,6 +210,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,13 +242,12 @@ 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
    | Opt_D_dump_types
    | Opt_D_dump_rules
-   | Opt_D_dump_usagesp
    | Opt_D_dump_cse
    | Opt_D_dump_worker_wrapper
    | Opt_D_dump_rn_trace
@@ -247,7 +255,9 @@ data DynFlag
    | Opt_D_dump_stix
    | Opt_D_dump_simpl_stats
    | Opt_D_dump_tc_trace
+   | Opt_D_dump_splices
    | Opt_D_dump_BCOs
+   | Opt_D_dump_vect
    | Opt_D_source_stats
    | Opt_D_verbose_core2core
    | Opt_D_verbose_stg2stg
@@ -256,8 +266,8 @@ data DynFlag
    | Opt_D_dump_minimal_imports
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
-   | Opt_DoUSPLinting
 
+   | Opt_WarnIsError           -- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
    | Opt_WarnHiShadows
    | Opt_WarnIncompletePatterns
@@ -277,7 +287,13 @@ data DynFlag
    -- language opts
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
+   | Opt_AllowIncoherentInstances
+   | Opt_NoMonomorphismRestriction
    | Opt_GlasgowExts
+   | Opt_FFI
+   | Opt_PArr                         -- syntactic support for parallel arrays
+   | Opt_With                         -- deprecated keyword for implicit parms
+   | Opt_Arrows                               -- Arrow-notation syntax
    | Opt_Generics
    | Opt_NoImplicitPrelude 
 
@@ -293,12 +309,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],
@@ -320,18 +338,27 @@ data HscLang
   | HscNothing
     deriving (Eq, Show)
 
+defaultHscLang
+  | cGhcWithNativeCodeGen == "YES" && 
+       (prefixMatch "i386" cTARGETPLATFORM ||
+        prefixMatch "sparc" cTARGETPLATFORM ||
+        prefixMatch "powerpc" cTARGETPLATFORM)   =  HscAsm
+  | otherwise                                  =  HscC
+
 defaultDynFlags = DynFlags {
   coreToDo = [], stgToDo = [], 
-  hscLang = HscC, 
+  hscLang = defaultHscLang, 
   hscOutName = "", 
   hscStubHOutName = "", hscStubCOutName = "",
   extCoreName = "",
   verbosity = 0, 
   cppFlag              = False,
+  ppFlag                = False,
   stolen_x86_regs      = 4,
   cmdlineHcIncludes    = [],
   opt_L                        = [],
   opt_P                        = [],
+  opt_F                 = [],
   opt_c                        = [],
   opt_a                        = [],
   opt_m                        = [],
@@ -339,7 +366,9 @@ defaultDynFlags = DynFlags {
   opt_I                 = [],
   opt_i                 = [],
 #endif
-  flags = standardWarnings,
+  flags = [Opt_Generics] ++ standardWarnings,
+       -- Generating the helper-functions for
+       -- generics is now on by default
   }
 
 {- 
@@ -373,6 +402,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}
 
 -----------------------------------------------------------------------------
@@ -464,14 +509,14 @@ minusWallOpts
 -- main/DriverState.
 GLOBAL_VAR(v_Static_hsc_opts, [], [String])
 
-lookUp          :: FAST_STRING -> Bool
+lookUp          :: FastString -> Bool
 lookup_int              :: String -> Maybe Int
 lookup_def_int   :: String -> Int -> Int
 lookup_def_float :: String -> Float -> Float
 lookup_str       :: String -> Maybe String
 
 unpacked_static_opts = unsafePerformIO (readIORef v_Static_hsc_opts)
-packed_static_opts   = map _PK_ unpacked_static_opts
+packed_static_opts   = map mkFastString unpacked_static_opts
 
 lookUp     sw = sw `elem` packed_static_opts
        
@@ -500,7 +545,7 @@ unpacked_opts :: [String]
 unpacked_opts =
   concat $
   map (expandAts) $
-  map _UNPK_ argv  -- NOT ARGV any more: v_Static_hsc_opts
+  map unpackFS argv  -- NOT ARGV any more: v_Static_hsc_opts
   where
    expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
    expandAts l = [l]
@@ -515,38 +560,39 @@ unpacked_opts =
 
 \begin{code}
 -- debugging opts
-opt_PprStyle_NoPrags           = lookUp  SLIT("-dppr-noprags")
-opt_PprStyle_Debug             = lookUp  SLIT("-dppr-debug")
-opt_PprStyle_RawTypes          = lookUp  SLIT("-dppr-rawtypes")
+opt_PprStyle_NoPrags           = lookUp  FSLIT("-dppr-noprags")
+opt_PprStyle_Debug             = lookUp  FSLIT("-dppr-debug")
+opt_PprStyle_RawTypes          = lookUp  FSLIT("-dppr-rawtypes")
 opt_PprUserLength              = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
 
 -- 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_SccProfilingOn             = lookUp  SLIT("-fscc-profiling")
-opt_DoTickyProfiling           = lookUp  SLIT("-fticky-ticky")
+opt_AutoSccsOnAllToplevs       = lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
+opt_AutoSccsOnExportedToplevs  = lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
+opt_AutoSccsOnIndividualCafs   = lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
+opt_AutoSccsOnDicts            = lookUp  FSLIT("-fauto-sccs-on-dicts")
+opt_SccProfilingOn             = lookUp  FSLIT("-fscc-profiling")
+opt_DoTickyProfiling           = lookUp  FSLIT("-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_AllStrict                  = lookUp  FSLIT("-fall-strict")
+opt_DictsStrict                        = lookUp  FSLIT("-fdicts-strict")
+opt_IrrefutableTuples          = lookUp  FSLIT("-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")
+opt_NumbersStrict              = lookUp  FSLIT("-fnumbers-strict")
+opt_Parallel                   = lookUp  FSLIT("-fparallel")
+opt_SMP                                = lookUp  FSLIT("-fsmp")
+opt_Flatten                    = lookUp  FSLIT("-fflatten")
 
 -- optimisation opts
-opt_NoMethodSharing            = lookUp  SLIT("-fno-method-sharing")
-opt_DoSemiTagging              = lookUp  SLIT("-fsemi-tagging")
-opt_FoldrBuildOn               = lookUp  SLIT("-ffoldr-build-on")
+opt_NoMethodSharing            = lookUp  FSLIT("-fno-method-sharing")
+opt_DoSemiTagging              = lookUp  FSLIT("-fsemi-tagging")
+opt_FoldrBuildOn               = lookUp  FSLIT("-ffoldr-build-on")
+opt_CprOff                     = lookUp  FSLIT("-fcpr-off")
+       -- Switch off CPR analysis in the new demand analyser
 opt_LiberateCaseThreshold      = lookup_def_int "-fliberate-case-threshold" (10::Int)
-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")
+opt_StgDoLetNoEscapes          = lookUp  FSLIT("-flet-no-escape")
+opt_UnfoldCasms                        = lookUp  FSLIT("-funfold-casms-in-hi-file")
+opt_UnboxStrictFields          = lookUp  FSLIT("-funbox-strict-fields")
 opt_MaxWorkerArgs              = lookup_def_int "-fmax-worker-args" (10::Int)
 
 {-
@@ -555,45 +601,45 @@ opt_MaxWorkerArgs         = lookup_def_int "-fmax-worker-args" (10::Int)
    The Prelude, for example is compiled with '-inpackage std'
 -}
 opt_InPackage                  = case lookup_str "-inpackage=" of
-                                   Just p  -> _PK_ p
-                                   Nothing -> SLIT("Main")     -- The package name if none is specified
+                                   Just p  -> mkFastString p
+                                   Nothing -> FSLIT("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_HiVersion                  = read cProjectVersionInt :: Int
+opt_EmitCExternDecls           = lookUp  FSLIT("-femit-extern-decls")
+opt_EnsureSplittableC          = lookUp  FSLIT("-fglobalise-toplev-names")
+opt_GranMacros                 = lookUp  FSLIT("-fgransim")
+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")
-opt_NoHiCheck                   = lookUp  SLIT("-fno-hi-version-check")
-opt_OmitBlackHoling            = lookUp  SLIT("-dno-black-holing")
-opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
-opt_RuntimeTypes               = lookUp  SLIT("-fruntime-types")
+opt_IgnoreAsserts               = lookUp  FSLIT("-fignore-asserts")
+opt_IgnoreIfacePragmas         = lookUp  FSLIT("-fignore-interface-pragmas")
+opt_NoHiCheck                   = lookUp  FSLIT("-fno-hi-version-check")
+opt_OmitBlackHoling            = lookUp  FSLIT("-dno-black-holing")
+opt_OmitInterfacePragmas       = lookUp  FSLIT("-fomit-interface-pragmas")
+opt_RuntimeTypes               = lookUp  FSLIT("-fruntime-types")
 
 -- Simplifier switches
-opt_SimplNoPreInlining         = lookUp  SLIT("-fno-pre-inlining")
+opt_SimplNoPreInlining         = lookUp  FSLIT("-fno-pre-inlining")
        -- NoPreInlining is there just to see how bad things
        -- get if you don't do it!
-opt_SimplDoEtaReduction                = lookUp  SLIT("-fdo-eta-reduction")
-opt_SimplDoLambdaEtaExpansion  = lookUp  SLIT("-fdo-lambda-eta-expansion")
-opt_SimplCaseMerge             = lookUp  SLIT("-fcase-merge")
-opt_SimplExcessPrecision       = lookUp  SLIT("-fexcess-precision")
+opt_SimplDoEtaReduction                = lookUp  FSLIT("-fdo-eta-reduction")
+opt_SimplDoLambdaEtaExpansion  = lookUp  FSLIT("-fdo-lambda-eta-expansion")
+opt_SimplCaseMerge             = lookUp  FSLIT("-fcase-merge")
+opt_SimplExcessPrecision       = lookUp  FSLIT("-fexcess-precision")
 
 -- Unfolding control
 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_FunAppDiscount          = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
-opt_UF_UpdateInPlace           = lookUp  SLIT("-funfolding-update-in-place")
+opt_UF_UpdateInPlace           = lookUp  FSLIT("-funfolding-update-in-place")
 
 opt_UF_CheapOp  = ( 1 :: Int)  -- Only one instruction; and the args are charged for
 opt_UF_DearOp   = ( 4 :: Int)
                        
-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_EmitExternalCore           = lookUp  SLIT("-fext-core")
+opt_NoPruneDecls               = lookUp  FSLIT("-fno-prune-decls")
+opt_NoPruneTyDecls             = lookUp  FSLIT("-fno-prune-tydecls")
+opt_Static                     = lookUp  FSLIT("-static")
+opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
+opt_EmitExternalCore           = lookUp  FSLIT("-fext-core")
 \end{code}
 
 %************************************************************************
@@ -617,11 +663,11 @@ isStaticHscFlag f =
        "fnumbers-strict",
        "fparallel",
        "fsmp",
+       "fflatten",
        "fsemi-tagging",
        "ffoldr-build-on",
        "flet-no-escape",
        "funfold-casms-in-hi-file",
-       "fusagesp-on",
        "funbox-strict-fields",
        "femit-extern-decls",
        "fglobalise-toplev-names",
@@ -631,7 +677,6 @@ isStaticHscFlag f =
        "fno-hi-version-check",
        "dno-black-holing",
        "fno-method-sharing",
-        "fno-monomorphism-restriction",
        "fomit-interface-pragmas",
        "fruntime-types",
        "fno-pre-inlining",
@@ -645,7 +690,8 @@ isStaticHscFlag f =
        "static",
        "funregisterised",
        "fext-core",
-       "frule-check"
+       "frule-check",
+       "fcpr-off"
        ]
   || any (flip prefixMatch f) [
        "fcontext-stack",