X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FGenerics.lhs;h=2c973649cfcf8c8836e9d8c8dd65b9cb0b700bd8;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=2465364c826c28c02e87e5e8357bf4561357c940;hpb=ef5b4b146aa172d8ac10f39b5eb3d7a0f948d8f1;p=ghc-hetmet.git diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs index 2465364..2c97364 100644 --- a/ghc/compiler/types/Generics.lhs +++ b/ghc/compiler/types/Generics.lhs @@ -255,13 +255,12 @@ type FromAlt = (LPat RdrName, LHsExpr RdrName) mkTyConGenericBinds :: TyCon -> LHsBinds RdrName mkTyConGenericBinds tycon - = unitBag (L loc (FunBind (L loc from_RDR) False {- Not infix -} - (mkMatchGroup [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts]))) - + = unitBag (L loc (mkFunBind (L loc from_RDR) from_matches)) `unionBags` - unitBag (L loc (FunBind (L loc to_RDR) False - (mkMatchGroup [mkSimpleHsAlt to_pat to_body]))) + unitBag (L loc (mkFunBind (L loc to_RDR) to_matches)) where + from_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts] + to_matches = [mkSimpleHsAlt to_pat to_body] loc = srcLocSpan (getSrcLoc tycon) datacons = tyConDataCons tycon (from_RDR, to_RDR) = mkGenericNames tycon @@ -457,7 +456,7 @@ By the time the type checker has done its stuff we'll get mkGenericRhs :: Id -> TyVar -> TyCon -> LHsExpr RdrName mkGenericRhs sel_id tyvar tycon = ASSERT( isSingleton ctxt ) -- Checks shape of selector-id context - pprTrace "mkGenericRhs" (vcat [ppr sel_id, ppr (idType sel_id), ppr tyvar, ppr tycon, ppr local_tvs, ppr final_ty]) $ +-- pprTrace "mkGenericRhs" (vcat [ppr sel_id, ppr (idType sel_id), ppr tyvar, ppr tycon, ppr local_tvs, ppr final_ty]) $ mkHsApp (toEP bimap) (nlHsVar (getRdrName sel_id)) where -- Initialising the "Environment" with the from/to functions @@ -524,7 +523,7 @@ bimapTuple eps toEP = mkHsLam [noLoc tuple_pat] (noLoc to_body) } where names = takeList eps gs_RDR - tuple_pat = TuplePat (map nlVarPat names) Boxed + tuple_pat = TuplePat (map nlVarPat names) Boxed placeHolderType eps_w_names = eps `zip` names to_body = ExplicitTuple [toEP ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed from_body = ExplicitTuple [fromEP ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed