diff options
| author | Ian Lynagh <igloo@earth.li> | 2011-07-14 20:15:11 +0100 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2011-07-14 20:15:11 +0100 |
| commit | 6a68c86904a76f9982b6d44a5d5e2b5bb6e3a20a (patch) | |
| tree | f0b020413b76f70d91f319f31f33b634fb16884d | |
| parent | 493ea4ab0bcdfdd99aa08ce3637ab383e1f8fc2d (diff) | |
| download | haskell-6a68c86904a76f9982b6d44a5d5e2b5bb6e3a20a.tar.gz | |
Just renaming a couple of functions
| -rw-r--r-- | compiler/deSugar/Desugar.lhs | 2 | ||||
| -rw-r--r-- | compiler/deSugar/DsMonad.lhs | 2 | ||||
| -rw-r--r-- | compiler/rename/RnSource.lhs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 14 |
5 files changed, 10 insertions, 12 deletions
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 6a11b9e4bd..5d045a80a9 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -346,7 +346,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) = putSrcSpanDs loc $ do { let bndrs' = [var | RuleBndr (L _ var) <- vars] - ; lhs' <- unsetOptM Opt_EnableRewriteRules $ + ; lhs' <- unsetDOptM Opt_EnableRewriteRules $ unsetWOptM Opt_WarnIdentities $ dsLExpr lhs -- Note [Desugaring RULE left hand sides] diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index 221621d742..1dd347be98 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -9,7 +9,7 @@ module DsMonad ( DsM, mapM, mapAndUnzipM, initDs, initDsTc, fixDs, - foldlM, foldrM, ifDOptM, unsetOptM, unsetWOptM, + foldlM, foldrM, ifDOptM, unsetDOptM, unsetWOptM, Applicative(..),(<$>), newLocalName, diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 12d4375606..18c2048b6a 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -169,7 +169,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else (rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ; - (rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $ + (rn_rule_decls, src_fvs3) <- setXOptM Opt_ScopedTypeVariables $ rnList rnHsRuleDecl rule_decls ; -- Inside RULES, scoped type variables are on (rn_vect_decls, src_fvs4) <- rnList rnHsVectDecl vect_decls ; diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 45d54123ef..d2c4c7da9e 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -374,7 +374,7 @@ renameDeriv is_boot gen_binds insts | otherwise = discardWarnings $ -- Discard warnings about unused bindings etc - do { (rn_gen, dus_gen) <- setOptM Opt_ScopedTypeVariables $ -- Type signatures in patterns + do { (rn_gen, dus_gen) <- setXOptM Opt_ScopedTypeVariables $ -- Type signatures in patterns -- are used in the generic binds rnTopBinds (ValBindsIn gen_binds []) ; keepAliveSetTc (duDefs dus_gen) -- Mark these guys to be kept alive diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index e14c6949c4..2b78ab3f79 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -251,15 +251,13 @@ doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) } woptM :: WarningFlag -> TcRnIf gbl lcl Bool woptM flag = do { dflags <- getDOpts; return (wopt flag dflags) } --- XXX setOptM and unsetOptM operate on different types. One should be renamed. +setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +setXOptM flag = updEnv (\ env@(Env { env_top = top }) -> + env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} ) -setOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a -setOptM flag = updEnv (\ env@(Env { env_top = top }) -> - env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} ) - -unsetOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a -unsetOptM flag = updEnv (\ env@(Env { env_top = top }) -> - env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} ) +unsetDOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +unsetDOptM flag = updEnv (\ env@(Env { env_top = top }) -> + env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} ) unsetWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetWOptM flag = updEnv (\ env@(Env { env_top = top }) -> |
