X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsExpr.lhs;h=11fddf57af96ab769a95d37faad8e6243e42f94b;hp=94009fd1fabea7045989325577350377d75a8f0d;hb=fb6d198f498d4e325a540f28aaa6e1d1530839c3;hpb=cf4d037c05371455b7ae68c2b61215bd691e137a

diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs
index 94009fd..11fddf5 100644
--- a/compiler/deSugar/DsExpr.lhs
+++ b/compiler/deSugar/DsExpr.lhs
@@ -749,8 +749,7 @@ dsDo stmts body result_ty
         body       = noLoc $ HsDo DoExpr rec_stmts return_app body_ty
         return_app = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets)
 	body_ty    = mkAppTy m_ty tup_ty
-        tup_ty     = mkCoreTupTy (map idType tup_ids)
-                  -- mkCoreTupTy deals with singleton case
+        tup_ty     = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case
 
     -- In a do expression, pattern-match failure just calls
     -- the monadic 'fail' rather than throwing an exception
@@ -848,8 +847,7 @@ dsMDo tbl stmts body result_ty
 	mfix_pat = noLoc $ LazyPat $ mk_tup_pat rec_tup_pats
 	body     = noLoc $ HsDo ctxt rec_stmts return_app body_ty
 	body_ty = mkAppTy m_ty tup_ty
-	tup_ty  = mkCoreTupTy (map idType (later_ids' ++ rec_ids))
-		  -- mkCoreTupTy deals with singleton case
+	tup_ty  = mkBoxedTupleTy (map idType (later_ids' ++ rec_ids))  -- Deals with singleton case
 
 	return_app  = nlHsApp (nlHsTyApp return_id [tup_ty]) 
 			      (mkLHsTupleExpr rets)