[project @ 2003-10-09 11:58:39 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 133db82..8f68404 100644 (file)
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ b/ghc/compiler/typecheck/TcPat.lhs
@@ -30,13 +30,13 @@ import TcType               ( TcType, TcTyVar, TcSigmaType,
                          mkClassPred, liftedTypeKind )
 import TcUnify         ( tcSubOff, Expected(..), readExpectedType, zapExpectedType, 
                          unifyTauTy, zapToListTy, zapToPArrTy, zapToTupleTy )  
-import TcMonoType      ( tcHsSigType, UserTypeCtxt(..) )
+import TcHsType                ( tcHsSigType, UserTypeCtxt(..) )
 
 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_` 
@@ -280,8 +271,8 @@ tcPat tc_bndr pat@(NPatIn over_lit mb_neg) pat_ty
        -- But in NPat, the literal is used to find identical patterns
        --      so we must negate the literal when necessary!
        lit' = case (over_lit, mb_neg) of
-                (HsIntegral i _,   Nothing) -> HsInteger i
-                (HsIntegral i _,   Just _)  -> HsInteger (-i)
+                (HsIntegral i _,   Nothing) -> HsInteger i pat_ty'
+                (HsIntegral i _,   Just _)  -> HsInteger (-i) pat_ty'
                 (HsFractional f _, Nothing) -> HsRat f pat_ty'
                 (HsFractional f _, Just _)  -> HsRat (-f) pat_ty'
     in