X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=299d70fa7835247134e1eb2aca43a19e16fa697c;hb=f670c47f9f93ffd6d06b331cd40554cd5e92484c;hp=7b88356cf2e2e3469b09f44a2e5cf1dca0592123;hpb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 7b88356..299d70f 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -13,7 +13,7 @@ module TcHsSyn (
 	mkHsConApp, mkHsDictLet, mkHsApp,
 	hsLitType, hsLPatType, hsPatType, 
 	mkHsAppTy, mkSimpleHsAlt,
-	nlHsIntLit, mkVanillaTuplePat, 
+	nlHsIntLit, 
 	shortCutLit, hsOverLitName,
 	
 	mkArbitraryType,	-- Put this elsewhere?
@@ -80,11 +80,6 @@ mappM = mapM
 Note: If @hsLPatType@ doesn't bear a strong resemblance to @exprType@,
 then something is wrong.
 \begin{code}
-mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
--- A vanilla tuple pattern simply gets its type from its sub-patterns
-mkVanillaTuplePat pats box 
-  = TuplePat pats box (mkTupleTy box (length pats) (map hsLPatType pats))
-
 hsLPatType :: OutPat Id -> Type
 hsLPatType (L _ pat) = hsPatType pat
 
@@ -490,6 +485,13 @@ zonkExpr env (SectionR op expr)
     zonkLExpr env expr		`thenM` \ new_expr ->
     returnM (SectionR new_op new_expr)
 
+zonkExpr env (ExplicitTuple tup_args boxed)
+  = do { new_tup_args <- mapM zonk_tup_arg tup_args
+       ; return (ExplicitTuple new_tup_args boxed) }
+  where
+    zonk_tup_arg (Present e) = do { e' <- zonkLExpr env e; return (Present e') }
+    zonk_tup_arg (Missing t) = do { t' <- zonkTcTypeToType env t; return (Missing t') }
+
 zonkExpr env (HsCase expr ms)
   = zonkLExpr env expr    	`thenM` \ new_expr ->
     zonkMatchGroup env ms	`thenM` \ new_ms ->
@@ -523,10 +525,6 @@ zonkExpr env (ExplicitPArr ty exprs)
     zonkLExprs env exprs	`thenM` \ new_exprs ->
     returnM (ExplicitPArr new_ty new_exprs)
 
-zonkExpr env (ExplicitTuple exprs boxed)
-  = zonkLExprs env exprs  	`thenM` \ new_exprs ->
-    returnM (ExplicitTuple new_exprs boxed)
-
 zonkExpr env (RecordCon data_con con_expr rbinds)
   = do	{ new_con_expr <- zonkExpr env con_expr
 	; new_rbinds   <- zonkRecFields env rbinds