X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FGenerics.lhs;h=8afbc4b3708e0bd14b868296b821cdf1b2ec4f51;hb=ebc48d8caba74acef3c0e11229000d6c014ada2d;hp=e8d26d51849c278deff404a033654baa9658cc48;hpb=13386b66f4fcc1fbf2f7df13e8687510e857c848;p=ghc-hetmet.git

diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
index e8d26d5..8afbc4b 100644
--- a/ghc/compiler/types/Generics.lhs
+++ b/ghc/compiler/types/Generics.lhs
@@ -21,6 +21,7 @@ import TyCon            ( TyCon, tyConTyVars, tyConDataConsIfAvailable,
 import Name		( Name, mkSysLocalName )
 import CoreSyn          ( mkLams, Expr(..), CoreExpr, AltCon(..), 
 			  mkConApp, Alt, mkTyApps, mkVarApps )
+import CoreUtils	( exprArity )
 import BasicTypes       ( EP(..), Boxity(..) )
 import Var              ( TyVar )
 import VarSet		( varSetElems )
@@ -31,7 +32,7 @@ import TysWiredIn       ( genericTyCons,
 			  genUnitTyCon, genUnitDataCon, plusTyCon, inrDataCon,
 			  inlDataCon, crossTyCon, crossDataCon
 			)
-import IdInfo           ( noCafNoTyGenIdInfo, setUnfoldingInfo )
+import IdInfo           ( noCafNoTyGenIdInfo, setUnfoldingInfo, setArityInfo )
 import CoreUnfold       ( mkTopUnfolding ) 
 
 import SrcLoc		( builtinSrcLoc )
@@ -259,7 +260,12 @@ mkTyConGenInfo tycon [from_name, to_name]
     tyvar_tys    = mkTyVarTys tyvars
 
     from_id_info = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
+				      `setArityInfo`     exprArity from_fn
     to_id_info   = noCafNoTyGenIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
+				      `setArityInfo`     exprArity to_fn
+	-- It's important to set the arity info, so that
+	-- the calling convention (gotten from arity) 
+	-- matches reality.
 
     from_ty = mkForAllTys tyvars (mkFunTy tycon_ty rep_ty)
     to_ty   = mkForAllTys tyvars (mkFunTy rep_ty tycon_ty)