Turning off case liberation when using the hpc option, for now

[ghc-hetmet.git] / compiler / main / DynFlags.hs

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f10d2f9..b3ee6fb 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -17,7 +17,7 @@ module DynFlags (
        -- Dynamic flags
        DynFlag(..),
        DynFlags(..),
-       HscTarget(..), isObjectTarget,
+       HscTarget(..), isObjectTarget, defaultObjectTarget,
        GhcMode(..), isOneShot,
        GhcLink(..), isNoLink,
        PackageFlag(..),
@@ -59,7 +59,7 @@ import PrelNames      ( mAIN )
 import StaticFlags     ( opt_Static )
 #endif
 import StaticFlags     ( opt_PIC, WayName(..), v_Ways, v_Build_tag,
-                         v_RTS_Build_tag )
+                         v_RTS_Build_tag, opt_Hpc )
 import {-# SOURCE #-} Packages (PackageState)
 import DriverPhases    ( Phase(..), phaseInputExt )
 import Config
@@ -85,10 +85,6 @@ import Util          ( split )
 import Data.Char       ( isUpper )
 import System.IO        ( hPutStrLn, stderr )
 
-#ifdef GHCI
-import Breakpoints      ( BkptHandler )
-import Module           ( ModuleName )
-#endif
 -- -----------------------------------------------------------------------------
 -- DynFlags
 
@@ -143,6 +139,7 @@ data DynFlag
    | Opt_WarnIsError           -- -Werror; makes warnings fatal
    | Opt_WarnDuplicateExports
    | Opt_WarnHiShadows
+   | Opt_WarnImplicitPrelude
    | Opt_WarnIncompletePatterns
    | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnMissingFields
@@ -152,6 +149,7 @@ data DynFlag
    | Opt_WarnOverlappingPatterns
    | Opt_WarnSimplePatterns
    | Opt_WarnTypeDefaults
+   | Opt_WarnMonomorphism
    | Opt_WarnUnusedBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
@@ -177,7 +175,7 @@ data DynFlag
    | Opt_ImplicitPrelude 
    | Opt_ScopedTypeVariables
    | Opt_BangPatterns
-   | Opt_IndexedTypes
+   | Opt_TypeFamilies
    | Opt_OverloadedStrings
 
    -- optimisation opts
@@ -195,8 +193,10 @@ data DynFlag
    | Opt_CaseMerge
    | Opt_UnboxStrictFields
    | Opt_DictsCheap
+   | Opt_RewriteRules
 
    -- misc opts
+   | Opt_ShortGhciBanner
    | Opt_Cpp
    | Opt_Pp
    | Opt_ForceRecomp
@@ -208,12 +208,10 @@ data DynFlag
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_HideAllPackages
-#if defined(GHCI) && defined(DEBUGGER)
-   | Opt_Debugging
-#endif
    | Opt_PrintBindResult
    | Opt_Haddock
    | Opt_Hpc_No_Auto
+   | Opt_BreakOnException
 
    -- keeping stuff
    | Opt_KeepHiDiffs
@@ -321,11 +319,6 @@ data DynFlags = DynFlags {
   
   -- message output
   log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
-
-#ifdef GHCI
-  -- breakpoint handling
- ,bkptHandler           :: Maybe (BkptHandler Module)
-#endif
  }
 
 data HscTarget
@@ -376,7 +369,11 @@ data PackageFlag
   | IgnorePackage  String
   deriving Eq
 
-defaultHscTarget
+defaultHscTarget = defaultObjectTarget
+
+-- | the 'HscTarget' value corresponding to the default way to create
+-- object files on the current platform.
+defaultObjectTarget
   | cGhcWithNativeCodeGen == "YES"     =  HscAsm
   | otherwise                          =  HscC
 
@@ -446,9 +443,6 @@ defaultDynFlags =
        packageFlags            = [],
         pkgDatabase             = Nothing,
         pkgState                = panic "no package state yet: call GHC.setSessionDynFlags",
-#ifdef GHCI
-        bkptHandler             = Nothing,
-#endif
        flags = [ 
            Opt_ReadUserPackageConf,
     
@@ -574,12 +568,16 @@ optLevelFlags :: [([Int], DynFlag)]
 optLevelFlags
   = [ ([0],    Opt_IgnoreInterfacePragmas)
     , ([0],     Opt_OmitInterfacePragmas)
+
     , ([1,2],  Opt_IgnoreAsserts)
+    , ([1,2],  Opt_RewriteRules)       -- Off for -O0; see Note [Scoping for Builtin rules]
+                                       --              in PrelRules
     , ([1,2],  Opt_DoEtaReduction)
     , ([1,2],  Opt_CaseMerge)
     , ([1,2],  Opt_Strictness)
     , ([1,2],  Opt_CSE)
     , ([1,2],  Opt_FullLaziness)
+
     , ([2],    Opt_LiberateCase)
     , ([2],    Opt_SpecConstr)
 
@@ -679,6 +677,7 @@ getCoreToDo dflags
     cse           = dopt Opt_CSE dflags
     spec_constr   = dopt Opt_SpecConstr dflags
     liberate_case = dopt Opt_LiberateCase dflags
+                 && not opt_Hpc 
     rule_check    = ruleCheck dflags
 
     core_todo = 
@@ -839,6 +838,8 @@ dynamic_flags = [
   ,  ( "F"             , NoArg  (setDynFlag Opt_Pp))
   ,  ( "#include"      , HasArg (addCmdlineHCInclude) )
   ,  ( "v"             , OptIntSuffix setVerbosity )
+  ,  ( "short-ghci-banner", NoArg (setDynFlag Opt_ShortGhciBanner) )
+  ,  ( "long-ghci-banner" , NoArg (unSetDynFlag Opt_ShortGhciBanner) )
 
         ------- Specific phases  --------------------------------------------
   ,  ( "pgmL"           , HasArg (upd . setPgmL) )  
@@ -1029,6 +1030,7 @@ dynamic_flags = [
 fFlags = [
   ( "warn-duplicate-exports",          Opt_WarnDuplicateExports ),
   ( "warn-hi-shadowing",               Opt_WarnHiShadows ),
+  ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude ),
   ( "warn-incomplete-patterns",        Opt_WarnIncompletePatterns ),
   ( "warn-incomplete-record-updates",          Opt_WarnIncompletePatternsRecUpd ),
   ( "warn-missing-fields",             Opt_WarnMissingFields ),
@@ -1038,6 +1040,7 @@ fFlags = [
   ( "warn-overlapping-patterns",       Opt_WarnOverlappingPatterns ),
   ( "warn-simple-patterns",            Opt_WarnSimplePatterns ),
   ( "warn-type-defaults",              Opt_WarnTypeDefaults ),
+  ( "warn-monomorphism-restriction",           Opt_WarnMonomorphism ),
   ( "warn-unused-binds",               Opt_WarnUnusedBinds ),
   ( "warn-unused-imports",             Opt_WarnUnusedImports ),
   ( "warn-unused-matches",             Opt_WarnUnusedMatches ),
@@ -1053,7 +1056,7 @@ fFlags = [
   ( "scoped-type-variables",           Opt_ScopedTypeVariables ),
   ( "bang-patterns",                   Opt_BangPatterns ),
   ( "overloaded-strings",              Opt_OverloadedStrings ),
-  ( "indexed-types",                   Opt_IndexedTypes ),
+  ( "type-families",                   Opt_TypeFamilies ),
   ( "monomorphism-restriction",                Opt_MonomorphismRestriction ),
   ( "mono-pat-binds",                  Opt_MonoPatBinds ),
   ( "extended-default-rules",          Opt_ExtendedDefaultRules ),
@@ -1079,11 +1082,10 @@ fFlags = [
   ( "excess-precision",                        Opt_ExcessPrecision ),
   ( "asm-mangling",                    Opt_DoAsmMangling ),
   ( "print-bind-result",               Opt_PrintBindResult ),
-#if defined(GHCI) && defined(DEBUGGER)
-  ( "debugging",                        Opt_Debugging),
-#endif
   ( "force-recomp",                    Opt_ForceRecomp ),
-  ( "hpc-no-auto",                     Opt_Hpc_No_Auto )
+  ( "hpc-no-auto",                     Opt_Hpc_No_Auto ),
+  ( "rewrite-rules",                   Opt_RewriteRules ),
+  ( "break-on-exception",               Opt_BreakOnException )
   ]
 
 
@@ -1092,7 +1094,7 @@ glasgowExtsFlags = [
   Opt_FFI, 
   Opt_ImplicitParams, 
   Opt_ScopedTypeVariables,
-  Opt_IndexedTypes ]
+  Opt_TypeFamilies ]
 
 isFFlag f = f `elem` (map fst fFlags)
 getFFlag f = fromJust (lookup f fFlags)