Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/7750fc259bf4b638f77c30fd8ffcbd9a571d0713 >--------------------------------------------------------------- commit 7750fc259bf4b638f77c30fd8ffcbd9a571d0713 Author: David Terei <[email protected]> Date: Wed Jun 1 19:27:24 2011 -0700 SafeHaskell: Update for recent changes to TcDeriv >--------------------------------------------------------------- compiler/typecheck/TcDeriv.lhs | 11 +++++++---- 1 files changed, 7 insertions(+), 4 deletions(-) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 0881097..45d5412 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1641,7 +1641,8 @@ genGenericAll tc = -} genDtMeta :: (TyCon, MetaTyCons) -> TcM [(InstInfo RdrName, DerivAuxBinds)] genDtMeta (tc,metaDts) = - do dClas <- tcLookupClass datatypeClassName + do dflags <- getDOpts + dClas <- tcLookupClass datatypeClassName d_dfun_name <- new_dfun_name dClas tc cClas <- tcLookupClass constructorClassName c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ] @@ -1652,11 +1653,12 @@ genDtMeta (tc,metaDts) = fix_env <- getFixityEnv let + safeOverlap = safeLanguageOn dflags (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc -- Datatype d_metaTycon = metaD metaDts - d_inst = mkLocalInstance d_dfun NoOverlap + d_inst = mkLocalInstance d_dfun $ NoOverlap safeOverlap d_binds = VanillaInst dBinds [] False d_dfun = mkDictFunId d_dfun_name (tyConTyVars tc) [] dClas [ mkTyConTy d_metaTycon ] @@ -1664,7 +1666,7 @@ genDtMeta (tc,metaDts) = -- Constructor c_metaTycons = metaC metaDts - c_insts = [ mkLocalInstance (c_dfun c ds) NoOverlap + c_insts = [ mkLocalInstance (c_dfun c ds) $ NoOverlap safeOverlap | (c, ds) <- myZip1 c_metaTycons c_dfun_names ] c_binds = [ VanillaInst c [] False | c <- cBinds ] c_dfun c dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] cClas @@ -1674,7 +1676,8 @@ genDtMeta (tc,metaDts) = -- Selector s_metaTycons = metaS metaDts - s_insts = map (map (\(s,ds) -> mkLocalInstance (s_dfun s ds) NoOverlap)) + s_insts = map (map (\(s,ds) -> mkLocalInstance (s_dfun s ds) $ + NoOverlap safeOverlap)) (myZip2 s_metaTycons s_dfun_names) s_binds = [ [ VanillaInst s [] False | s <- ss ] | ss <- sBinds ] s_dfun s dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] sClas _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
