[project @ 2000-07-11 16:24:57 by simonmar]

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

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index f987c02..b2c4aa2 100644 (file)
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -11,7 +11,7 @@ module RnSource ( rnDecl, rnSourceDecls, rnHsType, rnHsSigType ) where
 import RnExpr
 import HsSyn
 import HsPragmas
-import HsTypes         ( getTyVarName )
+import HsTypes         ( getTyVarName, pprHsContext )
 import RdrName         ( RdrName, isRdrDataCon, rdrNameOcc, isRdrTyVar, mkRdrNameWkr )
 import RdrHsSyn                ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
                          extractRuleBndrsTyVars, extractHsTyRdrTyVars,
@@ -43,7 +43,6 @@ import Name           ( Name, OccName,
                        )
 import NameSet
 import OccName         ( mkDefaultMethodOcc )
-import BasicTypes      ( TopLevelFlag(..) )
 import FiniteMap       ( elemFM )
 import PrelInfo                ( derivableClassKeys, cCallishClassKeys,
                          deRefStablePtr_RDR, makeStablePtr_RDR, 
@@ -55,7 +54,6 @@ import Outputable
 import SrcLoc          ( SrcLoc )
 import CmdLineOpts     ( opt_GlasgowExts, opt_WarnUnusedMatches )      -- Warn of unused for-all'd tyvars
 import Unique          ( Uniquable(..) )
-import UniqFM          ( lookupUFM )
 import ErrUtils                ( Message )
 import CStrings                ( isCLabelString )
 import Maybes          ( maybeToBool, catMaybes )
@@ -566,21 +564,16 @@ rnHsType doc (HsForAllTy Nothing ctxt ty)
 
 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
        -- Explicit quantification.
-       -- Check that the forall'd tyvars are a subset of the
-       -- free tyvars in the tau-type part
-       -- That's only a warning... unless the tyvar is constrained by a 
-       -- context in which case it's an error
+       -- Check that the forall'd tyvars are actually 
+       -- mentioned in the type, and produce a warning if not
   = let
        mentioned_in_tau                = extractHsTyRdrTyVars tau
        mentioned_in_ctxt               = extractHsCtxtRdrTyVars ctxt
        mentioned                       = nub (mentioned_in_tau ++ mentioned_in_ctxt)
-       tys_of_pred (HsPClass clas tys) = tys
-       tys_of_pred (HsPIParam n ty)    = [ty]
        forall_tyvar_names              = map getTyVarName forall_tyvars
 
-       -- explicitly quantified but not mentioned in ctxt or tau
+       -- Explicitly quantified but not mentioned in ctxt or tau
        warn_guys                       = filter (`notElem` mentioned) forall_tyvar_names
-
     in
     mapRn_ (forAllWarn doc tau) warn_guys                      `thenRn_`
     rnForAll doc forall_tyvars ctxt tau
@@ -982,7 +975,7 @@ dupClassAssertWarn ctxt (assertion : dups)
   = sep [hsep [ptext SLIT("Duplicate class assertion"), 
               quotes (ppr assertion),
               ptext SLIT("in the context:")],
-        nest 4 (ppr ctxt <+> ptext SLIT("..."))]
+        nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
 
 naughtyCCallContextErr (HsPClass clas _)
   = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),