X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;h=48700f67730fe95d102574c72950973a8eb83880;hb=836b1e90821aacc9d1e09fe78085f911597274c8;hp=cead3dd541c119609bbc3ffbc1e0e83f90ad4cbc;hpb=58521c72cec262496dabf5fffb057d25ab17a0f7;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index cead3dd..48700f6 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -142,7 +142,7 @@ coreCasePair scrut_var var1 var2 body
 
 \begin{code}
 mkCorePairTy :: Type -> Type -> Type
-mkCorePairTy t1 t2 = mkCoreTupTy [t1, t2]
+mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
 
 mkCorePairExpr :: CoreExpr -> CoreExpr -> CoreExpr
 mkCorePairExpr e1 e2 = mkCoreTup [e1, e2]
@@ -779,7 +779,9 @@ dsCmdStmt ids local_vars env_ids out_ids (LetStmt binds) = do
 --			first (loop (arr (\((ys1),~(ys2)) -> (ys)) >>> ss)) >>>
 --			arr (\((xs1),(xs2)) -> (xs')) >>> ss'
 
-dsCmdStmt ids local_vars env_ids out_ids (RecStmt stmts later_ids rec_ids rhss _binds) = do
+dsCmdStmt ids local_vars env_ids out_ids 
+          (RecStmt { recS_stmts = stmts, recS_later_ids = later_ids, recS_rec_ids = rec_ids
+                   , recS_rec_rets = rhss, recS_dicts = _binds }) = do
     let         -- ToDo: ****** binds not desugared; ROSS PLEASE FIX ********
         env2_id_set = mkVarSet out_ids `minusVarSet` mkVarSet later_ids
         env2_ids = varSetElems env2_id_set