From d876992cf9b9fb07cb913b0c297d9a42b746c29a Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 5 Nov 2003 14:51:54 +0000
Subject: [PATCH 1/1] [project @ 2003-11-05 14:51:53 by simonpj] Fixes to
 derivable type classes; should work now

---
 ghc/compiler/typecheck/TcDeriv.lhs   |    6 ++++--
 ghc/compiler/typecheck/TcRnMonad.lhs |    6 +++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index a9e1a83..1d23c7b 100644
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -19,7 +19,7 @@ import CmdLineOpts	( DynFlag(..) )
 import Generics		( mkTyConGenericBinds )
 import TcRnMonad
 import TcEnv		( newDFunName, 
-			  InstInfo(..), pprInstInfo, InstBindings(..),
+			  InstInfo(..), InstBindings(..),
 			  pprInstInfoDetails, tcLookupTyCon, tcExtendTyVarEnv
 			)
 import TcGenDeriv	-- Deriv stuff
@@ -215,8 +215,10 @@ tcDeriving tycl_decls
 	; let inst_info  = newtype_inst_info ++ ordinary_inst_info
 
 	-- Rename these extra bindings, discarding warnings about unused bindings etc
+	-- Set -fglasgow exts so that we can have type signatures in patterns,
+	-- which is used in the generic binds
 	; (rn_binds, gen_bndrs) 
-		<- discardWarnings $ do
+		<- discardWarnings $ setOptM Opt_GlasgowExts $ do
 			{ (rn_deriv, _dus1) <- rnTopMonoBinds deriv_binds []
 			; (rn_gen, dus_gen) <- rnTopMonoBinds gen_binds   []
 			; return (rn_deriv `ThenBinds` rn_gen, duDefs dus_gen) }
diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 47cd402..de3390c 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -38,7 +38,7 @@ import Bag		( emptyBag )
 import Outputable
 import UniqSupply	( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply )
 import Unique		( Unique )
-import CmdLineOpts	( DynFlags, DynFlag(..), dopt, opt_PprStyle_Debug )
+import CmdLineOpts	( DynFlags, DynFlag(..), dopt, opt_PprStyle_Debug, dopt_set )
 import Bag		( snocBag, unionBags )
 import Panic		( showException )
  
@@ -226,6 +226,10 @@ getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
 doptM :: DynFlag -> TcRnIf gbl lcl Bool
 doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
 
+setOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
+setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
+			 env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
+
 ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()	-- Do it flag is true
 ifOptM flag thing_inside = do { b <- doptM flag; 
 				if b then thing_inside else return () }
-- 
1.7.10.4