[project @ 2003-12-30 16:29:17 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnTypes.lhs

diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index e41c775..7ec84e0 100644 (file)
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -7,7 +7,7 @@
 module RnTypes ( rnHsType, rnLHsType, rnContext,
                 rnHsSigType, rnHsTypeFVs,
                 rnLPat, rnPat, rnPatsAndThen,          -- Here because it's not part 
-                rnOverLit, litFVs,             -- of any mutual recursion      
+                rnLit, rnOverLit,                      -- of any mutual recursion      
                 precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize
   ) where
 
@@ -16,7 +16,7 @@ import CmdLineOpts    ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
 import HsSyn
 import RdrHsSyn                ( extractHsRhoRdrTyVars )
 import RnHsSyn         ( extractHsTyNames, parrTyCon_name, tupleTyCon_name, 
-                         listTyCon_name, charTyCon_name
+                         listTyCon_name
                        )
 import RnEnv           ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
                          lookupLocatedOccRn, lookupLocatedBndrRn,
@@ -25,15 +25,12 @@ import RnEnv                ( lookupOccRn, lookupBndrRn, lookupSyntaxName,
                          newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
 import TcRnMonad
 import RdrName         ( RdrName, elemLocalRdrEnv )
-import PrelNames       ( eqStringName, eqClassName, integralClassName, 
+import PrelNames       ( eqClassName, integralClassName, 
                          negateName, minusName, lengthPName, indexPName,
                          plusIntegerName, fromIntegerName, timesIntegerName,
                          ratioDataConName, fromRationalName )
 import Constants       ( mAX_TUPLE_SIZE )
-import TysWiredIn      ( intTyCon )
-import TysPrim         ( charPrimTyCon, addrPrimTyCon, intPrimTyCon, 
-                         floatPrimTyCon, doublePrimTyCon )
-import Name            ( Name, NamedThing(..) )
+import Name            ( Name )
 import SrcLoc          ( Located(..), unLoc )
 import NameSet
 
@@ -338,12 +335,9 @@ rnPat (SigPatIn pat ty)
   where
     doc = text "In a pattern type-signature"
     
-rnPat (LitPat s@(HsString _)) 
-  = returnM (LitPat s, unitFV eqStringName)
-
 rnPat (LitPat lit) 
-  = litFVs lit         `thenM` \ fvs ->
-    returnM (LitPat lit, fvs) 
+  = rnLit lit  `thenM_` 
+    returnM (LitPat lit, emptyFVs) 
 
 rnPat (NPatIn lit mb_neg) 
   = rnOverLit lit                      `thenM` \ (lit', fvs1) ->
@@ -484,22 +478,9 @@ that the types and classes they involve
 are made available.
 
 \begin{code}
-litFVs (HsChar c)
-   = checkErr (inCharRange c) (bogusCharError c) `thenM_`
-     returnM (unitFV charTyCon_name)
-
-litFVs (HsCharPrim c)         = returnM (unitFV (getName charPrimTyCon))
-litFVs (HsString s)           = returnM (mkFVs [listTyCon_name, charTyCon_name])
-litFVs (HsStringPrim s)       = returnM (unitFV (getName addrPrimTyCon))
-litFVs (HsInt i)             = returnM (unitFV (getName intTyCon))
-litFVs (HsIntPrim i)          = returnM (unitFV (getName intPrimTyCon))
-litFVs (HsFloatPrim f)        = returnM (unitFV (getName floatPrimTyCon))
-litFVs (HsDoublePrim d)       = returnM (unitFV (getName doublePrimTyCon))
-litFVs lit                   = pprPanic "RnExpr.litFVs" (ppr lit)
-                                       -- HsInteger and HsRat only appear 
-                                       -- in post-typechecker translations
-bogusCharError c
-  = ptext SLIT("character literal out of range: '\\") <> char c <> char '\''
+rnLit :: HsLit -> RnM ()
+rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
+rnLit other     = returnM ()
 
 rnOverLit (HsIntegral i _)
   = lookupSyntaxName fromIntegerName   `thenM` \ (from_integer_name, fvs) ->
@@ -557,6 +538,9 @@ forAllWarn doc ty (L loc tyvar)
                   doc
                 )
 
+bogusCharError c
+  = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
+
 precParseErr op1 op2 
   = hang (ptext SLIT("precedence parsing error"))
       4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),