diff options
Diffstat (limited to 'compiler/GHC/Tc/Deriv/Generics.hs')
| -rw-r--r-- | compiler/GHC/Tc/Deriv/Generics.hs | 7 |
1 files changed, 4 insertions, 3 deletions
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs index ced6f4b690..ea9862d305 100644 --- a/compiler/GHC/Tc/Deriv/Generics.hs +++ b/compiler/GHC/Tc/Deriv/Generics.hs @@ -29,6 +29,7 @@ import GHC.Tc.Deriv.Functor import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom ) +import GHC.Core.Multiplicity import GHC.Tc.Instance.Family import GHC.Unit.Module ( moduleName, moduleNameFS , moduleUnit, unitFS, getModule ) @@ -168,7 +169,7 @@ canDoGenerics tc -- then we can't build the embedding-projection pair, because -- it relies on instantiating *polymorphic* sum and product types -- at the argument types of the constructors - bad_con dc = if (any bad_arg_type (dataConOrigArgTys dc)) + bad_con dc = if (any bad_arg_type (map scaledThing $ dataConOrigArgTys dc)) then (NotValid (ppr dc <+> text "must not have exotic unlifted or polymorphic arguments")) else (if (not (isVanillaDataCon dc)) @@ -575,7 +576,7 @@ tc_mkRepTy gk_ tycon k = mkD a = mkTyConApp d1 [ k, metaDataTy, sumP (tyConDataCons a) ] mkC a = mkTyConApp c1 [ k , metaConsTy a - , prod (dataConInstOrigArgTys a + , prod (map scaledThing . dataConInstOrigArgTys a . mkTyVarTys . tyConTyVars $ tycon) (dataConSrcBangs a) (dataConImplBangs a) @@ -741,7 +742,7 @@ mk1Sum gk_ us i n datacon = (from_alt, to_alt) argTys = dataConOrigArgTys datacon n_args = dataConSourceArity datacon - datacon_varTys = zip (map mkGenericLocal [us .. us+n_args-1]) argTys + datacon_varTys = zip (map mkGenericLocal [us .. us+n_args-1]) (map scaledThing argTys) datacon_vars = map fst datacon_varTys datacon_rdr = getRdrName datacon |