Commit 7750fc25 authored by dterei's avatar dterei

SafeHaskell: Update for recent changes to TcDeriv

parent 097a33f7
...@@ -1641,7 +1641,8 @@ genGenericAll tc = ...@@ -1641,7 +1641,8 @@ genGenericAll tc =
-} -}
genDtMeta :: (TyCon, MetaTyCons) -> TcM [(InstInfo RdrName, DerivAuxBinds)] genDtMeta :: (TyCon, MetaTyCons) -> TcM [(InstInfo RdrName, DerivAuxBinds)]
genDtMeta (tc,metaDts) = genDtMeta (tc,metaDts) =
do dClas <- tcLookupClass datatypeClassName do dflags <- getDOpts
dClas <- tcLookupClass datatypeClassName
d_dfun_name <- new_dfun_name dClas tc d_dfun_name <- new_dfun_name dClas tc
cClas <- tcLookupClass constructorClassName cClas <- tcLookupClass constructorClassName
c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ] c_dfun_names <- sequence [ new_dfun_name cClas tc | _ <- metaC metaDts ]
...@@ -1652,11 +1653,12 @@ genDtMeta (tc,metaDts) = ...@@ -1652,11 +1653,12 @@ genDtMeta (tc,metaDts) =
fix_env <- getFixityEnv fix_env <- getFixityEnv
let let
safeOverlap = safeLanguageOn dflags
(dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc (dBinds,cBinds,sBinds) = mkBindsMetaD fix_env tc
-- Datatype -- Datatype
d_metaTycon = metaD metaDts d_metaTycon = metaD metaDts
d_inst = mkLocalInstance d_dfun NoOverlap d_inst = mkLocalInstance d_dfun $ NoOverlap safeOverlap
d_binds = VanillaInst dBinds [] False d_binds = VanillaInst dBinds [] False
d_dfun = mkDictFunId d_dfun_name (tyConTyVars tc) [] dClas d_dfun = mkDictFunId d_dfun_name (tyConTyVars tc) [] dClas
[ mkTyConTy d_metaTycon ] [ mkTyConTy d_metaTycon ]
...@@ -1664,7 +1666,7 @@ genDtMeta (tc,metaDts) = ...@@ -1664,7 +1666,7 @@ genDtMeta (tc,metaDts) =
-- Constructor -- Constructor
c_metaTycons = metaC metaDts 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, ds) <- myZip1 c_metaTycons c_dfun_names ]
c_binds = [ VanillaInst c [] False | c <- cBinds ] c_binds = [ VanillaInst c [] False | c <- cBinds ]
c_dfun c dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] cClas c_dfun c dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] cClas
...@@ -1674,7 +1676,8 @@ genDtMeta (tc,metaDts) = ...@@ -1674,7 +1676,8 @@ genDtMeta (tc,metaDts) =
-- Selector -- Selector
s_metaTycons = metaS metaDts 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) (myZip2 s_metaTycons s_dfun_names)
s_binds = [ [ VanillaInst s [] False | s <- ss ] | ss <- sBinds ] s_binds = [ [ VanillaInst s [] False | s <- ss ] | ss <- sBinds ]
s_dfun s dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] sClas s_dfun s dfun_name = mkDictFunId dfun_name (tyConTyVars tc) [] sClas
......
Markdown is supported
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