[project @ 2004-08-13 13:04:50 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
index 7a4799b..64ed4ad 100644 (file)
@@ -20,7 +20,6 @@ module CmdLineOpts (
 
        -- Manipulating DynFlags
        defaultDynFlags,                -- DynFlags
-       defaultHscLang,                 -- HscLang
        dopt,                           -- DynFlag -> DynFlags -> Bool
        dopt_set, dopt_unset,           -- DynFlags -> DynFlag -> DynFlags
        dopt_CoreToDo,                  -- DynFlags -> [CoreToDo]
@@ -42,13 +41,10 @@ module CmdLineOpts (
        restoreDynFlags,                -- IO DynFlags
 
        -- sets of warning opts
-       standardWarnings,
        minusWOpts,
        minusWallOpts,
 
        -- Output style options
-       opt_PprStyle_NoPrags,
-       opt_PprStyle_RawTypes,
        opt_PprUserLength,
        opt_PprStyle_Debug,
 
@@ -56,24 +52,21 @@ module CmdLineOpts (
        opt_AutoSccsOnAllToplevs,
        opt_AutoSccsOnExportedToplevs,
        opt_AutoSccsOnIndividualCafs,
-       opt_AutoSccsOnDicts,
        opt_SccProfilingOn,
        opt_DoTickyProfiling,
 
        -- language opts
-       opt_AllStrict,
        opt_DictsStrict,
         opt_MaxContextReductionDepth,
        opt_IrrefutableTuples,
-       opt_NumbersStrict,
        opt_Parallel,
        opt_SMP,
        opt_RuntimeTypes,
        opt_Flatten,
 
        -- optimisation opts
-       opt_NoMethodSharing,
-       opt_DoSemiTagging,
+       opt_NoMethodSharing, 
+       opt_NoStateHack,
        opt_LiberateCaseThreshold,
        opt_CprOff,
        opt_RulesOff,
@@ -87,19 +80,17 @@ module CmdLineOpts (
        opt_UF_FunAppDiscount,
        opt_UF_KeenessFactor,
        opt_UF_UpdateInPlace,
-       opt_UF_CheapOp,
        opt_UF_DearOp,
 
        -- misc opts
+       opt_ErrorSpans,
        opt_InPackage,
        opt_EmitCExternDecls,
        opt_EnsureSplittableC,
        opt_GranMacros,
        opt_HiVersion,
        opt_HistorySize,
-        opt_NoHiCheck,
        opt_OmitBlackHoling,
-       opt_NoPruneDecls,
        opt_Static,
        opt_Unregisterised,
        opt_EmitExternalCore
@@ -113,6 +104,7 @@ import FastString   ( FastString, mkFastString )
 import Config
 import Maybes          ( firstJust )
 
+import Panic           ( ghcError, GhcException(UsageError) )
 import GLAEXTS
 import DATA_IOREF      ( IORef, readIORef, writeIORef )
 import UNSAFE_IO       ( unsafePerformIO )
@@ -218,7 +210,7 @@ data FloatOutSwitches
 data DynFlag
 
    -- debugging flags
-   = Opt_D_dump_absC
+   = Opt_D_dump_cmm
    | Opt_D_dump_asm
    | Opt_D_dump_cpranal
    | Opt_D_dump_deriv
@@ -228,7 +220,6 @@ data DynFlag
    | Opt_D_dump_inlinings
    | Opt_D_dump_occur_anal
    | Opt_D_dump_parsed
-   | Opt_D_dump_realC
    | Opt_D_dump_rn
    | Opt_D_dump_simpl
    | Opt_D_dump_simpl_iterations
@@ -243,7 +234,7 @@ data DynFlag
    | Opt_D_dump_worker_wrapper
    | Opt_D_dump_rn_trace
    | Opt_D_dump_rn_stats
-   | Opt_D_dump_stix
+   | Opt_D_dump_opt_cmm
    | Opt_D_dump_simpl_stats
    | Opt_D_dump_tc_trace
    | Opt_D_dump_if_trace
@@ -258,6 +249,7 @@ data DynFlag
    | Opt_D_dump_minimal_imports
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
+   | Opt_DoCmmLinting
 
    | Opt_WarnIsError           -- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
@@ -274,7 +266,7 @@ data DynFlag
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnDeprecations
-   | Opt_WarnMisc
+   | Opt_WarnDodgyImports
 
    -- language opts
    | Opt_AllowOverlappingInstances
@@ -292,6 +284,7 @@ data DynFlag
 
    -- optimisation opts
    | Opt_Strictness
+   | Opt_FullLaziness
    | Opt_CSE
    | Opt_IgnoreInterfacePragmas
    | Opt_OmitInterfacePragmas
@@ -383,8 +376,9 @@ defaultDynFlags = DynFlags {
            Opt_Strictness,
                        -- strictness is on by default, but this only
                        -- applies to -O.
-           Opt_CSE,
-                       -- similarly for CSE.
+           Opt_CSE,            -- similarly for CSE.
+           Opt_FullLaziness,   -- ...and for full laziness
+
            Opt_DoLambdaEtaExpansion,
                        -- This one is important for a tiresome reason:
                        -- we want to make sure that the bindings for data 
@@ -395,7 +389,7 @@ defaultDynFlags = DynFlags {
            Opt_IgnoreInterfacePragmas,
            Opt_OmitInterfacePragmas
 
-           ] ++ standardWarnings,
+           ] ++ standardWarnings
   }
 
 {- 
@@ -488,11 +482,12 @@ opt_1_dopts = [
 buildCoreToDo :: DynFlags -> [CoreToDo]
 buildCoreToDo dflags = core_todo
   where
-    opt_level  = optLevel dflags
-    max_iter   = maxSimplIterations dflags
-    strictness = dopt Opt_Strictness dflags
-    cse        = dopt Opt_CSE dflags
-    rule_check = ruleCheck dflags
+    opt_level            = optLevel dflags
+    max_iter             = maxSimplIterations dflags
+    strictness    = dopt Opt_Strictness dflags
+    full_laziness = dopt Opt_FullLaziness dflags
+    cse           = dopt Opt_CSE dflags
+    rule_check    = ruleCheck dflags
 
     core_todo = 
      if opt_level == 0 then
@@ -526,7 +521,9 @@ buildCoreToDo dflags = core_todo
        -- so that overloaded functions have all their dictionary lambdas manifest
        CoreDoSpecialising,
 
-       CoreDoFloatOutwards (FloatOutSw False False),
+       if full_laziness then CoreDoFloatOutwards (FloatOutSw False False)
+                        else CoreDoNothing,
+
        CoreDoFloatInwards,
 
        CoreDoSimplify (SimplPhase 2) [
@@ -574,8 +571,10 @@ buildCoreToDo dflags = core_todo
           MaxSimplifierIterations max_iter
        ],
 
-       CoreDoFloatOutwards (FloatOutSw False   -- Not lambdas
-                                       True),  -- Float constants
+       if full_laziness then
+         CoreDoFloatOutwards (FloatOutSw False   -- Not lambdas
+                                         True)   -- Float constants
+       else CoreDoNothing,
                -- nofib/spectral/hartel/wang doubles in speed if you
                -- do full laziness late in the day.  It only happens
                -- after fusion and other stuff, so the early pass doesn't
@@ -676,7 +675,7 @@ minusWOpts
        Opt_WarnUnusedMatches,
        Opt_WarnUnusedImports,
        Opt_WarnIncompletePatterns,
-       Opt_WarnMisc
+       Opt_WarnDodgyImports
       ]
 
 minusWallOpts
@@ -710,19 +709,36 @@ packed_static_opts   = map mkFastString unpacked_static_opts
 
 lookUp     sw = sw `elem` packed_static_opts
        
-lookup_str sw = firstJust (map (startsWith sw) unpacked_static_opts)
+-- (lookup_str "foo") looks for the flag -foo=X or -fooX, 
+-- and returns the string X
+lookup_str sw 
+   = case firstJust (map (startsWith sw) unpacked_static_opts) of
+       Just ('=' : str) -> Just str
+       Just str         -> Just str
+       Nothing          -> Nothing     
 
 lookup_int sw = case (lookup_str sw) of
                  Nothing -> Nothing
-                 Just xx -> Just (read xx)
+                 Just xx -> Just (try_read sw xx)
 
 lookup_def_int sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
-                           Just xx -> read xx
+                           Just xx -> try_read sw xx
 
 lookup_def_float sw def = case (lookup_str sw) of
                            Nothing -> def              -- Use default
-                           Just xx -> read xx
+                           Just xx -> try_read sw xx
+
+
+try_read :: Read a => String -> String -> a
+-- (try_read sw str) tries to read s; if it fails, it
+-- bleats about flag sw
+try_read sw str
+  = case reads str of
+       ((x,_):_) -> x  -- Be forgiving: ignore trailing goop, and alternative parses
+       []        -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
+                       -- ToDo: hack alert. We should really parse the arugments
+                       --       and announce errors in a more civilised way.
 
 
 {-
@@ -750,16 +766,13 @@ unpacked_opts =
 
 \begin{code}
 -- debugging opts
-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  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")
 
@@ -768,14 +781,13 @@ 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  FSLIT("-fnumbers-strict")
 opt_Parallel                   = lookUp  FSLIT("-fparallel")
 opt_SMP                                = lookUp  FSLIT("-fsmp")
 opt_Flatten                    = lookUp  FSLIT("-fflatten")
 
 -- optimisation opts
+opt_NoStateHack                        = lookUp  FSLIT("-fno-state-hack")
 opt_NoMethodSharing            = lookUp  FSLIT("-fno-method-sharing")
-opt_DoSemiTagging              = lookUp  FSLIT("-fsemi-tagging")
 opt_CprOff                     = lookUp  FSLIT("-fcpr-off")
 opt_RulesOff                   = lookUp  FSLIT("-frules-off")
        -- Switch off CPR analysis in the new demand analyser
@@ -796,7 +808,6 @@ 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_NoHiCheck                   = lookUp  FSLIT("-fno-hi-version-check")
 opt_OmitBlackHoling            = lookUp  FSLIT("-dno-black-holing")
 opt_RuntimeTypes               = lookUp  FSLIT("-fruntime-types")
 
@@ -813,13 +824,14 @@ opt_UF_FunAppDiscount             = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -
 opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (1.5::Float)
 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  FSLIT("-fno-prune-decls")
 opt_Static                     = lookUp  FSLIT("-static")
 opt_Unregisterised             = lookUp  FSLIT("-funregisterised")
 opt_EmitExternalCore           = lookUp  FSLIT("-fext-core")
+
+-- Include full span info in error messages, instead of just the start position.
+opt_ErrorSpans                 = lookUp FSLIT("-ferror-spans")
 \end{code}
 
 %************************************************************************
@@ -840,7 +852,6 @@ isStaticHscFlag f =
        "fall-strict",
        "fdicts-strict",
        "firrefutable-tuples",
-       "fnumbers-strict",
        "fparallel",
        "fsmp",
        "fflatten",
@@ -852,17 +863,18 @@ isStaticHscFlag f =
        "fno-hi-version-check",
        "dno-black-holing",
        "fno-method-sharing",
+       "fno-state-hack",
        "fruntime-types",
        "fno-pre-inlining",
        "fexcess-precision",
        "funfolding-update-in-place",
-       "fno-prune-decls",
        "static",
        "funregisterised",
        "fext-core",
        "frule-check",
        "frules-off",
-       "fcpr-off"
+       "fcpr-off",
+       "ferror-spans"
        ]
   || any (flip prefixMatch f) [
        "fcontext-stack",