Simon's big boxy-type commit

[ghc-hetmet.git] / ghc / compiler / types / Generics.lhs

diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index 2465364..a9de7c9 100644 (file)
--- 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