[project @ 2001-11-05 14:16:48 by simonpj]

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

diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
index aea97d3..5f8c88e 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -18,16 +18,16 @@ module RnBinds (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
 
 import HsSyn
 import HsBinds         ( eqHsSig, sigName, hsSigDoc )
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
+import RnTypes         ( rnHsSigType, rnHsType )
 import RnExpr          ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
 import RnEnv           ( bindLocatedLocalsRn, lookupBndrRn, 
-                         lookupGlobalOccRn, lookupSigOccRn,
+                         lookupGlobalOccRn, lookupSigOccRn, bindPatSigTyVars,
                          warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
                        )
 import CmdLineOpts     ( DynFlag(..) )
@@ -162,7 +162,8 @@ rnTopBinds (MonoBind bind sigs _)     = rnTopMonoBinds bind sigs
 
 
 rnTopMonoBinds mbinds sigs
- =  mapRn lookupBndrRn binder_rdr_names                `thenRn` \ binder_names ->
+ =  mapRn lookupBndrRn binder_rdr_names                         `thenRn` \ binder_names ->
+    bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $ 
     let
        bndr_name_set = mkNameSet binder_names
     in
@@ -217,8 +218,8 @@ rnMonoBinds mbinds sigs     thing_inside -- Non-empty monobinds
   =    -- Extract all the binders in this group,
        -- and extend current scope, inventing new names for the new binders
        -- This also checks that the names form a set
-    bindLocatedLocalsRn (text "In a binding group") 
-                       mbinders_w_srclocs      $ \ new_mbinders ->
+    bindLocatedLocalsRn doc mbinders_w_srclocs                 $ \ new_mbinders ->
+    bindPatSigTyVars (collectSigTysFromMonoBinds mbinds)       $ 
     let
        binder_set = mkNameSet new_mbinders
     in
@@ -246,6 +247,9 @@ rnMonoBinds mbinds sigs     thing_inside -- Non-empty monobinds
     returnRn (result, delListFromNameSet all_fvs new_mbinders)
   where
     mbinders_w_srclocs = collectLocatedMonoBinders mbinds
+    doc = text "In the binding group for" <+> pp_bndrs mbinders_w_srclocs
+    pp_bndrs [(b,_)] = quotes (ppr b)
+    pp_bndrs bs      = fsep (punctuate comma [ppr b | (b,_) <- bs])
 \end{code}
 
 
@@ -386,7 +390,7 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
   where
        -- Gruesome; bring into scope the correct members of the generic type variables
        -- See comments in RnSource.rnSourceDecl(ClassDecl)
-    rn_match match@(Match _ (TypePatIn ty : _) _ _)
+    rn_match match@(Match (TypePatIn ty : _) _ _)
        = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
        where
          tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
@@ -535,15 +539,10 @@ renameSig (FixSig (FixitySig v fix src_loc))
     lookupSigOccRn v           `thenRn` \ new_v ->
     returnRn (FixSig (FixitySig new_v fix src_loc))
 
-renameSig (InlineSig v p src_loc)
+renameSig (InlineSig b v p src_loc)
   = pushSrcLocRn src_loc $
     lookupSigOccRn v           `thenRn` \ new_v ->
-    returnRn (InlineSig new_v p src_loc)
-
-renameSig (NoInlineSig v p src_loc)
-  = pushSrcLocRn src_loc $
-    lookupSigOccRn v           `thenRn` \ new_v ->
-    returnRn (NoInlineSig new_v p src_loc)
+    returnRn (InlineSig b new_v p src_loc)
 \end{code}