X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcExpr.lhs;h=48c62a049c35e66433cf52999a33a416c32c69e3;hb=2a74e354528a397235b42af49a99844c1712e8c4;hp=7b53c42f89aedccb02913cf1d645d57237d75ccf;hpb=96781381830a18e7e807a56d2a24c32afa233c83;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 7b53c42..48c62a0 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -44,13 +44,12 @@ import TcType		( SYN_IE(TcType), TcMaybe(..),
 			  newTyVarTy, newTyVarTys, zonkTcTyVars, zonkTcType )
 import TcKind		( TcKind )
 
-import Class		( SYN_IE(Class), classSig )
-import FieldLabel	( fieldLabelName, fieldLabelType )
+import Class		( SYN_IE(Class) )
+import FieldLabel	( FieldLabel, fieldLabelName, fieldLabelType )
 import Id		( idType, dataConFieldLabels, dataConSig, recordSelectorFieldLabel,
 			  isRecordSelector,
 			  SYN_IE(Id), GenId
 			)
-import FieldLabel	( FieldLabel )
 import Kind		( Kind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
 import Name		( Name{-instance Eq-} )
 import Type		( mkFunTy, mkAppTy, mkTyVarTy, mkTyVarTys, mkRhoTy,
@@ -296,7 +295,7 @@ tcExpr (HsLet binds expr)
   where
     tc_expr expr = tcExpr expr `thenTc` \ (expr', lie, ty) ->
 	   	   returnTc ((expr',ty), lie)
-    combiner bind (expr, ty) = (HsLet bind expr, ty)
+    combiner is_rec bind (expr, ty) = (HsLet (MonoBind bind [] is_rec) expr, ty)
 
 tcExpr in_expr@(HsCase expr matches src_loc)
   = tcAddSrcLoc src_loc	$
@@ -332,16 +331,16 @@ tcExpr expr@(HsDo do_or_lc stmts src_loc)
 \end{code}
 
 \begin{code}
-tcExpr (ExplicitList [])
-  = newTyVarTy mkBoxedTypeKind		`thenNF_Tc` \ tyvar_ty ->
-    returnTc (ExplicitListOut tyvar_ty [], emptyLIE, mkListTy tyvar_ty)
-
-
 tcExpr in_expr@(ExplicitList exprs)	-- Non-empty list
-  = tcExprs exprs			`thenTc` \ (exprs', lie, tys@(elt_ty:_)) ->
-    tcAddErrCtxt (listCtxt in_expr) $
-    unifyTauTyList tys 			`thenTc_`
-    returnTc (ExplicitListOut elt_ty exprs', lie, mkListTy elt_ty)
+  = newTyVarTy mkBoxedTypeKind		`thenNF_Tc` \ elt_ty ->
+    mapAndUnzipTc (tc_elt elt_ty) exprs	`thenTc` \ (exprs', lies) ->
+    returnTc (ExplicitListOut elt_ty exprs', plusLIEs lies, mkListTy elt_ty)
+  where
+    tc_elt elt_ty expr
+      = tcAddErrCtxt (listCtxt expr) $
+	tcExpr expr			`thenTc` \ (expr', lie, expr_ty) ->
+	unifyTauTy elt_ty expr_ty	`thenTc_`
+	returnTc (expr', lie)
 
 tcExpr (ExplicitTuple exprs)
   = tcExprs exprs			`thenTc` \ (exprs', lie, tys) ->
@@ -422,7 +421,6 @@ tcExpr (RecordUpd record_expr rbinds)
 	-- Check for bad fields
     checkTc (any (null . badFields rbinds) data_cons)
 	    (badFieldsUpd rbinds)		`thenTc_`
-
 	-- STEP 3
 	-- Typecheck the update bindings.
 	-- (Do this after checking for bad fields in case there's a field that
@@ -887,7 +885,7 @@ tcStmt tc_expr do_or_lc m combine (LetStmt binds) do_next
   	binds
   	do_next
      where
-      	combine' binds' thing' = combine (LetStmt binds') Nothing thing'
+      	combine' is_rec binds' thing' = combine (LetStmt (MonoBind binds' [] is_rec)) Nothing thing'
 \end{code}
 
 %************************************************************************
@@ -995,28 +993,28 @@ branchCtxt b1 b2 sty
 	   pp_nest_hang "`else' branch:" (ppr sty b2)]
 
 caseCtxt expr sty
-  = hang (ptext SLIT("In a case expression:")) 4 (ppr sty expr)
+  = hang (ptext SLIT("In the case expression")) 4 (ppr sty expr)
 
 exprSigCtxt expr sty
   = hang (ptext SLIT("In an expression with a type signature:"))
 	 4 (ppr sty expr)
 
 listCtxt expr sty
-  = hang (ptext SLIT("In a list expression:")) 4 (ppr sty expr)
+  = hang (ptext SLIT("In the list element")) 4 (ppr sty expr)
 
 predCtxt expr sty
-  = hang (ptext SLIT("In a predicate expression:")) 4 (ppr sty expr)
+  = hang (ptext SLIT("In the predicate expression")) 4 (ppr sty expr)
 
 sectionRAppCtxt expr sty
-  = hang (ptext SLIT("In a right section:")) 4 (ppr sty expr)
+  = hang (ptext SLIT("In the right section")) 4 (ppr sty expr)
 
 sectionLAppCtxt expr sty
-  = hang (ptext SLIT("In a left section:")) 4 (ppr sty expr)
+  = hang (ptext SLIT("In the left section")) 4 (ppr sty expr)
 
 funAppCtxt fun arg_no arg sty
   = hang (hsep [ ptext SLIT("In the"), speakNth arg_no, ptext SLIT("argument of"), 
 		    ppr sty fun <> text ", namely"])
-	 4 (pprParendExpr sty arg)
+	 4 (ppr sty arg)
 
 stmtCtxt ListComp stmt sty
   = hang (ptext SLIT("In a list-comprehension qualifer:"))