diff options
| author | David Terei <davidterei@gmail.com> | 2011-06-01 19:27:24 -0700 |
|---|---|---|
| committer | David Terei <davidterei@gmail.com> | 2011-06-17 20:40:33 -0700 |
| commit | 7750fc259bf4b638f77c30fd8ffcbd9a571d0713 (patch) | |
| tree | 7354b76a8cb4808f628ab5579a807ed99c7cd2a8 | |
| parent | 097a33f7eae35f8e9a70c4a6a6431ce17f3cc861 (diff) | |
| download | haskell-7750fc259bf4b638f77c30fd8ffcbd9a571d0713.tar.gz | |
SafeHaskell: Update for recent changes to TcDeriv
| -rw-r--r-- | 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 08810978e7..45d54123ef 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 |