X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FGenerics.lhs;h=2c973649cfcf8c8836e9d8c8dd65b9cb0b700bd8;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=61b1a0f470772d06cae70c73d5f66a732ca43a45;hpb=6a4854eaa266d994ebd0d471614a52b43dd329d9;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index 61b1a0f..2c97364 100644
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -18,7 +18,7 @@ import DataCon          ( DataCon, dataConOrigArgTys, isVanillaDataCon,
 import TyCon            ( TyCon, tyConName, tyConDataCons, 
 			  isBoxedTupleTyCon
 			)
-import Name		( nameModuleName, nameOccName, getSrcLoc )
+import Name		( nameModule, nameOccName, getSrcLoc )
 import OccName		( mkGenOcc1, mkGenOcc2 )
 import RdrName		( RdrName, getRdrName, mkVarUnqual, mkOrig )
 import BasicTypes       ( EP(..), Boxity(..) )
@@ -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
@@ -392,7 +391,7 @@ mkGenericNames tycon
   where
     tc_name  = tyConName tycon
     tc_occ   = nameOccName tc_name
-    tc_mod   = nameModuleName tc_name
+    tc_mod   = nameModule tc_name
     from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
     to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
 \end{code}
@@ -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