Commit d876992c authored by simonpj's avatar simonpj
Browse files

[project @ 2003-11-05 14:51:53 by simonpj]

Fixes to derivable type classes; should work now
parent 6959a665
...@@ -19,7 +19,7 @@ import CmdLineOpts ( DynFlag(..) ) ...@@ -19,7 +19,7 @@ import CmdLineOpts ( DynFlag(..) )
import Generics ( mkTyConGenericBinds ) import Generics ( mkTyConGenericBinds )
import TcRnMonad import TcRnMonad
import TcEnv ( newDFunName, import TcEnv ( newDFunName,
InstInfo(..), pprInstInfo, InstBindings(..), InstInfo(..), InstBindings(..),
pprInstInfoDetails, tcLookupTyCon, tcExtendTyVarEnv pprInstInfoDetails, tcLookupTyCon, tcExtendTyVarEnv
) )
import TcGenDeriv -- Deriv stuff import TcGenDeriv -- Deriv stuff
...@@ -215,8 +215,10 @@ tcDeriving tycl_decls ...@@ -215,8 +215,10 @@ tcDeriving tycl_decls
; let inst_info = newtype_inst_info ++ ordinary_inst_info ; let inst_info = newtype_inst_info ++ ordinary_inst_info
-- Rename these extra bindings, discarding warnings about unused bindings etc -- 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) ; (rn_binds, gen_bndrs)
<- discardWarnings $ do <- discardWarnings $ setOptM Opt_GlasgowExts $ do
{ (rn_deriv, _dus1) <- rnTopMonoBinds deriv_binds [] { (rn_deriv, _dus1) <- rnTopMonoBinds deriv_binds []
; (rn_gen, dus_gen) <- rnTopMonoBinds gen_binds [] ; (rn_gen, dus_gen) <- rnTopMonoBinds gen_binds []
; return (rn_deriv `ThenBinds` rn_gen, duDefs dus_gen) } ; return (rn_deriv `ThenBinds` rn_gen, duDefs dus_gen) }
......
...@@ -38,7 +38,7 @@ import Bag ( emptyBag ) ...@@ -38,7 +38,7 @@ import Bag ( emptyBag )
import Outputable import Outputable
import UniqSupply ( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply ) import UniqSupply ( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply )
import Unique ( Unique ) 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 Bag ( snocBag, unionBags )
import Panic ( showException ) import Panic ( showException )
...@@ -226,6 +226,10 @@ getDOpts = do { env <- getTopEnv; return (hsc_dflags env) } ...@@ -226,6 +226,10 @@ getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
doptM :: DynFlag -> TcRnIf gbl lcl Bool doptM :: DynFlag -> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) } 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 :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -- Do it flag is true
ifOptM flag thing_inside = do { b <- doptM flag; ifOptM flag thing_inside = do { b <- doptM flag;
if b then thing_inside else return () } if b then thing_inside else return () }
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment