[project @ 2002-08-01 14:13:10 by simonpj]

Another rebindable-syntax wibble; merge to stable branch

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 6475225..3d76629 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -172,6 +172,7 @@ tcMonoExpr (HsPar expr)    res_ty = tcMonoExpr expr res_ty
 
 tcMonoExpr (NegApp expr neg_name) res_ty
   = tcMonoExpr (HsApp (HsVar neg_name) expr) res_ty
+       -- ToDo: use tcSyntaxName
 
 tcMonoExpr (HsLam match) res_ty
   = tcMatchLambda match res_ty                 `thenTc` \ (match',lie) ->

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 0561b78..291d854 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -36,7 +36,7 @@ import TcMonoType     ( tcHsSigType, UserTypeCtxt(..) )
 import TysWiredIn      ( stringTy )
 import CmdLineOpts     ( opt_IrrefutableTuples )
 import DataCon         ( dataConFieldLabels, dataConSourceArity )
-import PrelNames       ( eqStringName, eqName, geName, minusName, cCallableClassName )
+import PrelNames       ( eqStringName, eqName, geName, negateName, minusName, cCallableClassName )
 import BasicTypes      ( isBoxed )
 import Bag
 import Outputable
@@ -314,9 +314,8 @@ tcPat tc_bndr pat@(NPatIn over_lit mb_neg) pat_ty
        Nothing  -> returnNF_Tc (pos_lit_expr, emptyLIE)        -- Positive literal
        Just neg ->     -- Negative literal
                        -- The 'negate' is re-mappable syntax
-                   tcLookupId neg                              `thenNF_Tc` \ neg_sel_id ->
-                   newMethod origin neg_sel_id [pat_ty]        `thenNF_Tc` \ neg ->
-                   returnNF_Tc (HsApp (HsVar (instToId neg)) pos_lit_expr, unitLIE neg)
+                   tcSyntaxName origin pat_ty negateName neg   `thenTc` \ (neg_expr, neg_lie, _) ->
+                   returnNF_Tc (HsApp neg_expr pos_lit_expr, neg_lie)
     )                                                          `thenNF_Tc` \ (lit_expr, lie2) ->
 
     returnTc (NPat lit' pat_ty (HsApp (HsVar (instToId eq)) lit_expr),