[project @ 2001-09-26 15:12:33 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 33dacd7..eb9ea2d 100644 (file)
--- a/ghc/compiler/rename/RnBinds.lhs
+++ b/ghc/compiler/rename/RnBinds.lhs
@@ -18,13 +18,13 @@ 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,
@@ -217,8 +217,7 @@ 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 "a binding group") 
-                       mbinders_w_srclocs      $ \ new_mbinders ->
+    bindLocatedLocalsRn doc mbinders_w_srclocs $ \ new_mbinders ->
     let
        binder_set = mkNameSet new_mbinders
     in
@@ -246,6 +245,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}
 
 
@@ -327,7 +329,7 @@ flattenMonoBinds sigs (FunMonoBind name inf matches locn)
        names_bound_here = unitNameSet new_name
     in
     sigsForMe names_bound_here sigs                    `thenRn` \ sigs_for_me ->
-    mapFvRn rnMatch matches                            `thenRn` \ (new_matches, fvs) ->
+    mapFvRn (rnMatch (FunRhs name)) matches            `thenRn` \ (new_matches, fvs) ->
     mapRn_ (checkPrecMatch inf new_name) new_matches   `thenRn_`
     returnRn
       [(unitNameSet new_name,
@@ -387,12 +389,12 @@ rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
        -- Gruesome; bring into scope the correct members of the generic type variables
        -- See comments in RnSource.rnSourceDecl(ClassDecl)
     rn_match match@(Match _ (TypePatIn ty : _) _ _)
-       = extendTyVarEnvFVRn gen_tvs (rnMatch match)
+       = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
        where
          tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
          gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs] 
 
-    rn_match match = rnMatch match
+    rn_match match = rnMatch (FunRhs name) match
        
 
 -- Can't handle method pattern-bindings which bind multiple methods.
@@ -535,15 +537,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}