[project @ 2001-07-13 13:29:56 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcExpr.lhs

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 1216001..486976d 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -26,7 +26,7 @@ import Inst           ( InstOrigin(..),
 import TcBinds         ( tcBindsAndThen )
 import TcEnv           ( tcLookupClass, tcLookupGlobalId, tcLookupGlobal_maybe,
                          tcLookupTyCon, tcLookupDataCon, tcLookupId,
-                         tcExtendGlobalTyVars, tcLookupSyntaxName
+                         tcExtendGlobalTyVars
                        )
 import TcMatches       ( tcMatchesCase, tcMatchLambda, tcStmts )
 import TcMonoType      ( tcHsSigType, checkSigTyVars, sigCtxt )
@@ -195,9 +195,8 @@ tcMonoExpr (HsLit lit)     res_ty = tcLit lit res_ty
 tcMonoExpr (HsOverLit lit) res_ty = newOverloadedLit (LiteralOrigin lit) lit res_ty
 tcMonoExpr (HsPar expr)    res_ty = tcMonoExpr expr res_ty
 
-tcMonoExpr (NegApp expr) res_ty
-  = tcLookupSyntaxName negateName      `thenNF_Tc` \ neg ->
-    tcMonoExpr (HsApp (HsVar neg) expr) res_ty
+tcMonoExpr (NegApp expr neg_name) res_ty
+  = tcMonoExpr (HsApp (HsVar neg_name) expr) res_ty
 
 tcMonoExpr (HsLam match) res_ty
   = tcMatchLambda match res_ty                 `thenTc` \ (match',lie) ->
@@ -359,10 +358,10 @@ tcMonoExpr expr@(HsDo do_or_lc stmts src_loc) res_ty
 \end{code}
 
 \begin{code}
-tcMonoExpr in_expr@(ExplicitList exprs) res_ty -- Non-empty list
+tcMonoExpr in_expr@(ExplicitList _ exprs) res_ty       -- Non-empty list
   = unifyListTy res_ty                        `thenTc` \ elt_ty ->  
     mapAndUnzipTc (tc_elt elt_ty) exprs              `thenTc` \ (exprs', lies) ->
-    returnTc (ExplicitListOut elt_ty exprs', plusLIEs lies)
+    returnTc (ExplicitList elt_ty exprs', plusLIEs lies)
   where
     tc_elt elt_ty expr
       = tcAddErrCtxt (listCtxt expr) $
@@ -536,7 +535,7 @@ tcMonoExpr expr@(RecordUpd record_expr rbinds) res_ty
     newDicts RecordUpdOrigin theta'    `thenNF_Tc` \ dicts ->
 
        -- Phew!
-    returnTc (RecordUpdOut record_expr' result_record_ty (map instToId dicts) rbinds', 
+    returnTc (RecordUpdOut record_expr' record_ty result_record_ty (map instToId dicts) rbinds', 
              mkLIE dicts `plusLIE` record_lie `plusLIE` rbinds_lie)
 
 tcMonoExpr (ArithSeqIn seq@(From expr)) res_ty
@@ -776,7 +775,7 @@ tcDoStmts do_or_lc stmts src_loc res_ty
 
        _       -> newTyVarTy (mkArrowKind liftedTypeKind liftedTypeKind)       `thenNF_Tc` \ m_ty ->
                   newTyVarTy liftedTypeKind                                    `thenNF_Tc` \ elt_ty ->
-                  unifyTauTy res_ty (mkAppTy m_ty elt_ty)                              `thenTc_`
+                  unifyTauTy res_ty (mkAppTy m_ty elt_ty)                      `thenTc_`
                   returnNF_Tc (m_ty, (mkAppTy m_ty, elt_ty))
     )                                                  `thenNF_Tc` \ (tc_ty, m_ty) ->