[project @ 2001-10-19 14:22:11 by simonpj]

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

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index d5f39f0..d3f7510 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -11,7 +11,7 @@ module RnEnv where            -- Export everything
 import {-# SOURCE #-} RnHiFiles
 
 import HsSyn
-import RdrHsSyn                ( RdrNameIE )
+import RdrHsSyn                ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
                          mkRdrUnqual, mkRdrQual, lookupRdrEnv, foldRdrEnv, rdrEnvToList,
                          unqualifyRdrName
@@ -54,7 +54,6 @@ import ListSetOps     ( removeDups, equivClasses )
 import Util            ( sortLt )
 import List            ( nub )
 import UniqFM          ( lookupWithDefaultUFM )
-import Maybes          ( orElse )
 import CmdLineOpts
 import FastString      ( FastString )
 \end{code}
@@ -80,7 +79,7 @@ newTopBinder mod rdr_name loc
        -- There should never be a qualified name in a binding position (except in instance decls)
        -- The parser doesn't check this because the same parser parses instance decls
     (if isQual rdr_name then
-       qualNameErr (text "its declaration") (rdr_name,loc)
+       qualNameErr (text "In its declaration") (rdr_name,loc)
      else
        returnRn ()
     )                          `thenRn_`
@@ -607,15 +606,28 @@ bindTyVarsFV2Rn doc_str rdr_names enclosed_scope
     enclosed_scope names tyvars                `thenRn` \ (thing, fvs) ->
     returnRn (thing, delListFromNameSet fvs names)
 
-bindNakedTyVarsFVRn :: SDoc -> [RdrName]
-                   -> ([Name] -> RnMS (a, FreeVars))
-                   -> RnMS (a, FreeVars)
-bindNakedTyVarsFVRn doc_str tyvar_names enclosed_scope
-  = getSrcLocRn                                        `thenRn` \ loc ->
+bindPatSigTyVars :: [RdrNameHsType]
+                -> ([Name] -> RnMS (a, FreeVars))
+                -> RnMS (a, FreeVars)
+  -- Find the type variables in the pattern type 
+  -- signatures that must be brought into scope
+
+bindPatSigTyVars tys enclosed_scope
+  = getLocalNameEnv                    `thenRn` \ name_env ->
+    getSrcLocRn                                `thenRn` \ loc ->
     let
-       located_tyvars = [(tv, loc) | tv <- tyvar_names] 
+       forall_tyvars  = nub [ tv | ty <- tys,
+                                   tv <- extractHsTyRdrTyVars ty, 
+                                   not (tv `elemFM` name_env)
+                        ]
+               -- The 'nub' is important.  For example:
+               --      f (x :: t) (y :: t) = ....
+               -- We don't want to complain about binding t twice!
+
+       located_tyvars = [(tv, loc) | tv <- forall_tyvars] 
+       doc_sig        = text "In a pattern type-signature"
     in
-    bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
+    bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
     enclosed_scope names                       `thenRn` \ (thing, fvs) ->
     returnRn (thing, delListFromNameSet fvs names)