X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcExpr.lhs;h=c5d9e36c24012b900af6bd1f236a24f98468037e;hb=ca5a4a480d10d61e5b7a52eb4d556e8b8c33e69d;hp=809e08f9ff0fa8fafcdcf19af89658994f00c7ea;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 809e08f..c5d9e36 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -24,7 +24,7 @@ import TcHsSyn		( TcExpr(..), TcQual(..), TcStmt(..),
 			  mkHsTyApp
 			)
 
-import TcMonad
+import TcMonad		hiding ( rnMtoTcM )
 import Inst		( Inst, InstOrigin(..), OverloadedLit(..),
 			  LIE(..), emptyLIE, plusLIE, plusLIEs, newOverloadedLit,
 			  newMethod, newMethodWithGivenTy, newDicts )
@@ -41,7 +41,7 @@ import TcType		( TcType(..), TcMaybe(..),
 			  newTyVarTy, zonkTcTyVars, zonkTcType )
 import TcKind		( TcKind )
 
-import Class		( Class(..), getClassSig )
+import Class		( Class(..), classSig )
 import FieldLabel	( fieldLabelName )
 import Id		( Id(..), GenId, idType, dataConFieldLabels, dataConSig )
 import Kind		( Kind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
@@ -166,6 +166,10 @@ tcExpr (HsLit lit@(HsString str))
 %************************************************************************
 
 \begin{code}
+tcExpr (HsPar expr) = tcExpr expr
+
+tcExpr (NegApp expr n) = tcExpr (HsApp (HsVar n) expr)
+
 tcExpr (HsLam match)
   = tcMatch match	`thenTc` \ (match',lie,ty) ->
     returnTc (HsLam match', lie, ty)
@@ -357,7 +361,7 @@ tcExpr (ExplicitTuple exprs)
 tcExpr (RecordCon (HsVar con) rbinds)
   = tcId con				`thenNF_Tc` \ (con_expr, con_lie, con_tau) ->
     let
-	(_, record_ty)       = splitFunTy con_tau
+	(_, record_ty) = splitFunTy con_tau
     in
 	-- Con is syntactically constrained to be a data constructor
     ASSERT( maybeToBool (maybeAppDataTyCon record_ty ) )
@@ -390,7 +394,7 @@ tcExpr (RecordUpd record_expr rbinds)
 	-- Check that the field names are plausible
     zonkTcType record_ty		`thenNF_Tc` \ record_ty' ->
     let
-	(tycon, inst_tys, data_cons) = getAppDataTyCon record_ty'
+	(tycon, inst_tys, data_cons) = _trace "getAppDataTyCon.TcExpr" $ getAppDataTyCon record_ty'
 	-- The record binds are non-empty (syntax); so at least one field
 	-- label will have been unified with record_ty by tcRecordBinds;
 	-- field labels must be of data type; hencd the getAppDataTyCon must succeed.
@@ -704,6 +708,12 @@ tcListComp expr (qual@(GeneratorQual pat rhs) : quals)
       tcAddErrCtxt (qualCtxt qual) (
         tcPat pat				`thenTc` \ (pat',  lie_pat,  pat_ty)  ->
         tcExpr rhs				`thenTc` \ (rhs', lie_rhs, rhs_ty) ->
+		-- NB: the environment has been extended with the new binders
+		-- which the rhs can't "see", but the renamer should have made
+		-- sure that everything is distinct by now, so there's no problem.
+		-- Putting the tcExpr before the newMonoIds messes up the nesting
+		-- of error contexts, so I didn't  bother
+
         unifyTauTy (mkListTy pat_ty) rhs_ty	`thenTc_`
 	returnTc (GeneratorQual pat' rhs', 
 		  lie_pat `plusLIE` lie_rhs)