[commit: ghc] master: Make -fno-flat-cache use a dynamic, rather than static, flag (0499eac)

[Ian Lynagh]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/0499eac95f907ed94ccaef1c9a9074965d9067cf

>---------------------------------------------------------------

commit 0499eac95f907ed94ccaef1c9a9074965d9067cf
Author: Ian Lynagh <ian at well-typed.com>
Date:   Fri May 10 16:24:59 2013 +0100

    Make -fno-flat-cache use a dynamic, rather than static, flag

>---------------------------------------------------------------

 compiler/main/DynFlags.hs       |  3 +++
 compiler/main/StaticFlags.hs    |  5 -----
 compiler/typecheck/TcSMonad.lhs | 14 ++++++++------
 3 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 905c0d8..61d64e4 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -349,6 +349,7 @@ data GeneralFlag
    | Opt_RPath
    | Opt_RelativeDynlibPaths
    | Opt_Hpc
+   | Opt_FlatCache
 
    -- PreInlining is on by default. The option is there just to see how
    -- bad things get if you turn it off!
@@ -2500,6 +2501,7 @@ fFlags = [
   ( "prof-cafs",                        Opt_AutoSccsOnIndividualCafs, nop ),
   ( "hpc",                              Opt_Hpc, nop ),
   ( "pre-inlining",                     Opt_SimplPreInlining, nop ),
+  ( "flat-cache",                       Opt_FlatCache, nop ),
   ( "use-rpaths",                       Opt_RPath, nop )
   ]
 
@@ -2690,6 +2692,7 @@ defaultFlags settings
       Opt_HelpfulErrors,
       Opt_ProfCountEntries,
       Opt_SimplPreInlining,
+      Opt_FlatCache,
       Opt_RPath
     ]
 
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index cbdfea6..a1104de 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -30,7 +30,6 @@ module StaticFlags (
         opt_NoStateHack,
         opt_CprOff,
         opt_NoOptCoercion,
-        opt_NoFlatCache,
 
         -- For the parser
         addOpt, removeOpt, v_opt_C_ready,
@@ -146,7 +145,6 @@ isStaticFlag f =
     "fdicts-strict",
     "fno-state-hack",
     "fno-opt-coercion",
-    "fno-flat-cache",
     "fcpr-off"
     ]
 
@@ -198,9 +196,6 @@ opt_CprOff         = lookUp  (fsLit "-fcpr-off")
 opt_NoOptCoercion  :: Bool
 opt_NoOptCoercion  = lookUp  (fsLit "-fno-opt-coercion")
 
-opt_NoFlatCache    :: Bool
-opt_NoFlatCache     = lookUp  (fsLit "-fno-flat-cache")
-
 
 -----------------------------------------------------------------------------
 -- Convert sizes like "3.5M" into integers
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index f6bb4b7..e03368d 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -135,7 +135,6 @@ import TcRnTypes
 import Unique 
 import UniqFM
 import Maybes ( orElse, catMaybes, firstJust )
-import StaticFlags( opt_NoFlatCache )
 
 import Control.Monad( unless, when, zipWithM )
 import Data.IORef
@@ -1382,8 +1381,9 @@ newFlattenSkolem Given fam_ty
        ; let rhs_ty = mkTyVarTy tv
              ctev = CtGiven { ctev_pred = mkTcEqPred fam_ty rhs_ty
                             , ctev_evtm = EvCoercion (mkTcReflCo fam_ty) }
+       ; dflags <- getDynFlags
        ; updInertTcS $ \ is@(IS { inert_fsks = fsks }) -> 
-            extendFlatCache fam_ty ctev rhs_ty
+            extendFlatCache dflags fam_ty ctev rhs_ty
             is { inert_fsks       = tv : fsks }
 
        ; return (ctev, rhs_ty) }
@@ -1393,12 +1393,14 @@ newFlattenSkolem _ fam_ty  -- Wanted or Derived: make new unification variable
        ; ctev <- newWantedEvVarNC (mkTcEqPred fam_ty rhs_ty)
                                    -- NC (no-cache) version because we've already
                                    -- looked in the solved goals an inerts (lookupFlatEqn)
-       ; updInertTcS $ extendFlatCache fam_ty ctev rhs_ty
+       ; dflags <- getDynFlags
+       ; updInertTcS $ extendFlatCache dflags fam_ty ctev rhs_ty
        ; return (ctev, rhs_ty) }
 
-extendFlatCache :: TcType -> CtEvidence -> TcType -> InertSet -> InertSet
-extendFlatCache 
-  | opt_NoFlatCache
+extendFlatCache :: DynFlags -> TcType -> CtEvidence -> TcType
+                -> InertSet -> InertSet
+extendFlatCache dflags
+  | not (gopt Opt_FlatCache dflags)
   = \ _ _ _ is -> is
   | otherwise
   = \ fam_ty ctev rhs_ty is@(IS { inert_flat_cache = fc }) ->