X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcHsSyn.lhs;h=299d70fa7835247134e1eb2aca43a19e16fa697c;hb=1e50fd4185479a62e02d987bdfcb1c62712859ca;hp=fa54a630defe4568537e3ea480c0d475351f9d62;hpb=5479f1a02fae9141c02a7873c57af80323b0fc0d;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index fa54a63..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?
@@ -48,7 +48,6 @@ import VarEnv
 import Literal
 import BasicTypes
 import Maybes
-import Unique
 import SrcLoc
 import Util
 import Bag
@@ -81,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
 
@@ -491,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 ->
@@ -524,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
@@ -822,7 +819,8 @@ zonk_pat env (AsPat (L loc v) pat)
 zonk_pat env (ViewPat expr pat ty)
   = do	{ expr' <- zonkLExpr env expr
 	; (env', pat') <- zonkPat env pat
- 	; return (env', ViewPat expr' pat' ty) }
+ 	; ty' <- zonkTcTypeToType env ty
+	; return (env', ViewPat expr' pat' ty') }
 
 zonk_pat env (ListPat pats ty)
   = do	{ ty' <- zonkTcTypeToType env ty
@@ -1070,7 +1068,7 @@ mkArbitraryType warn tv
   , isLiftedTypeKind res			--    Horrible hack to make less use 
   = return (mkTyConApp tup_tc [])		--    of mkAnyPrimTyCon
   | otherwise
-  = do	{ warn (getSrcSpan tv) msg
+  = do	{ _ <- warn (getSrcSpan tv) msg
 	; return (mkTyConApp (mkAnyPrimTyCon (getUnique tv) kind) []) }
 		-- Same name as the tyvar, apart from making it start with a colon (sigh)
 		-- I dread to think what will happen if this gets out into an