X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsArrows.lhs;fp=compiler%2FdeSugar%2FDsArrows.lhs;h=cead3dd541c119609bbc3ffbc1e0e83f90ad4cbc;hp=76117b347461d2aedfc5a30fb9c04d15612bce88;hb=58521c72cec262496dabf5fffb057d25ab17a0f7;hpb=4b8dfb01980b44bc3284c87aadeada130f94f85f

diff --git a/compiler/deSugar/DsArrows.lhs b/compiler/deSugar/DsArrows.lhs
index 76117b3..cead3dd 100644
--- a/compiler/deSugar/DsArrows.lhs
+++ b/compiler/deSugar/DsArrows.lhs
@@ -217,16 +217,11 @@ matchVarStack env_id (stack_id:stack_ids) body = do
 \end{code}
 
 \begin{code}
-mkHsTupleExpr :: [HsExpr Id] -> HsExpr Id
-mkHsTupleExpr [e] = e
-mkHsTupleExpr es = ExplicitTuple (map noLoc es) Boxed
-
-mkHsPairExpr :: HsExpr Id -> HsExpr Id -> HsExpr Id
-mkHsPairExpr e1 e2 = mkHsTupleExpr [e1, e2]
-
-mkHsEnvStackExpr :: [Id] -> [Id] -> HsExpr Id
+mkHsEnvStackExpr :: [Id] -> [Id] -> LHsExpr Id
 mkHsEnvStackExpr env_ids stack_ids
-  = foldl mkHsPairExpr (mkHsTupleExpr (map HsVar env_ids)) (map HsVar stack_ids)
+  = foldl (\a b -> mkLHsTupleExpr [a,b]) 
+	  (mkLHsVarTuple env_ids) 
+	  (map nlHsVar stack_ids)
 \end{code}
 
 Translation of arrow abstraction
@@ -479,7 +474,7 @@ dsCmd ids local_vars env_ids stack res_ty (HsCase exp (MatchGroup matches match_
             (core_leaf, fvs, leaf_ids) <-
                   dsfixCmd ids (local_vars `unionVarSet` bound_vars) stack res_ty leaf
             return (fvs `minusVarSet` bound_vars,
-                    [noLoc $ mkHsEnvStackExpr leaf_ids stack_ids],
+                    [mkHsEnvStackExpr leaf_ids stack_ids],
                     envStackType leaf_ids stack,
                     core_leaf)