X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FBuildTyCl.lhs;h=d1118c01286375ae1cca62c81235d0ee599cd1c8;hb=0b86bc9b022a5965d2b35f143ff4b919f784e676;hp=9eda9073dd6e90dde8d9e1f956ec2ffb32ce422f;hpb=44ba24dc84d271ca9bd5ab5060cb63ed87f585e3;p=ghc-hetmet.git diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs index 9eda907..d1118c0 100644 --- a/compiler/iface/BuildTyCl.lhs +++ b/compiler/iface/BuildTyCl.lhs @@ -82,15 +82,24 @@ mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs -- because the latter is part of a knot, whereas the former is not. mkNewTyConRhs tycon_name tycon con = do { co_tycon_name <- newImplicitBinder tycon_name mkNewTyCoOcc - ; let co_tycon = mkNewTypeCoercion co_tycon_name tycon tvs rhs_ty + ; let co_tycon = mkNewTypeCoercion co_tycon_name tycon tvs rhs_ty + cocon_maybe + | all_coercions || isRecursiveTyCon tycon + = Just co_tycon + | otherwise + = Nothing ; return (NewTyCon { data_con = con, - nt_co = Just co_tycon, + nt_co = cocon_maybe, -- Coreview looks through newtypes with a Nothing -- for nt_co, or uses explicit coercions otherwise nt_rhs = rhs_ty, nt_etad_rhs = eta_reduce tvs rhs_ty, nt_rep = mkNewTyConRep tycon rhs_ty }) } where + -- if all_coercions is True then we use coercions for all newtypes + -- otherwise we use coercions for recursive newtypes and look through + -- non-recursive newtypes + all_coercions = True tvs = tyConTyVars tycon rhs_ty = head (dataConInstOrigArgTys con (mkTyVarTys tvs)) -- Instantiate the data con with the