[project @ 2003-09-23 15:10:23 by simonpj]

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

diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
index 63b7ac9..b0bb16b 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -36,7 +36,7 @@ import TysWiredIn     ( stringTy )
 import CmdLineOpts     ( opt_IrrefutableTuples )
 import DataCon         ( DataCon, dataConFieldLabels, dataConSourceArity )
 import PrelNames       ( eqStringName, eqName, geName, negateName, minusName, 
-                         integralClassName, cCallableClassName )
+                         integralClassName )
 import BasicTypes      ( isBoxed )
 import Bag
 import Outputable
@@ -242,15 +242,6 @@ tcPat tc_bndr pat_in@(ConPatIn con_name arg_pats) pat_ty
 %************************************************************************
 
 \begin{code}
-tcPat tc_bndr (LitPat lit@(HsLitLit s _)) pat_ty 
-       -- cf tcExpr on LitLits
-  = zapExpectedType pat_ty                             `thenM` \ pat_ty' ->
-    tcLookupClass cCallableClassName                   `thenM` \ cCallableClass ->
-    newDicts (LitLitOrigin (unpackFS s))
-            [mkClassPred cCallableClass [pat_ty']]     `thenM` \ dicts ->
-    extendLIEs dicts                                   `thenM_`
-    returnM (LitPat (HsLitLit s pat_ty'), emptyBag, emptyBag, [])
-
 tcPat tc_bndr pat@(LitPat lit@(HsString _)) pat_ty
   = zapExpectedType pat_ty             `thenM` \ pat_ty' ->
     unifyTauTy pat_ty' stringTy                `thenM_` 
@@ -271,8 +262,8 @@ tcPat tc_bndr pat@(NPatIn over_lit mb_neg) pat_ty
        Nothing  -> returnM pos_lit_expr        -- Positive literal
        Just neg ->     -- Negative literal
                        -- The 'negate' is re-mappable syntax
-                   tcSyntaxName origin pat_ty' negateName neg  `thenM` \ (neg_expr, _) ->
-                   returnM (HsApp neg_expr pos_lit_expr)
+           tcSyntaxName origin pat_ty' (negateName, HsVar neg) `thenM` \ (_, neg_expr) ->
+           returnM (HsApp neg_expr pos_lit_expr)
     )                                                          `thenM` \ lit_expr ->
 
     let
@@ -307,7 +298,7 @@ tcPat tc_bndr pat@(NPlusKPatIn name lit@(HsIntegral i _) minus_name) pat_ty
     newMethodFromName origin pat_ty' geName     `thenM` \ ge ->
 
        -- The '-' part is re-mappable syntax
-    tcSyntaxName origin pat_ty' minusName minus_name   `thenM` \ (minus_expr, _) ->
+    tcSyntaxName origin pat_ty' (minusName, HsVar minus_name)  `thenM` \ (_, minus_expr) ->
 
        -- The Report says that n+k patterns must be in Integral
        -- We may not want this when using re-mappable syntax, though (ToDo?)