X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnBinds.lhs;h=12432a3d099a904e757d36e0558a9a0eb162994d;hb=8ec978161d50e476e327b59bdf1a2d5e57705609;hp=e52e3f1cb54d3a82cacc20530a8aa074413f360a;hpb=5f8d93baa07271687825458e01c187081bcb1ddc;p=ghc-hetmet.git

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index e52e3f1..12432a3 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -23,7 +23,7 @@ import RdrHsSyn
 import RnHsSyn
 import TcRnMonad
 import RnTypes        ( rnHsSigType, rnLHsType, checkPrecMatch)
-import RnPat          (rnPatsAndThen_LocalRightwards, rnBindPat,
+import RnPat          (rnPats, rnBindPat,
                        NameMaker, localRecNameMaker, topRecNameMaker, applyNameMaker
                       )
                       
@@ -42,7 +42,7 @@ import Outputable
 import FastString
 import Data.List	( partition )
 import Maybes		( orElse )
-import Monad		( foldM, unless )
+import Control.Monad
 \end{code}
 
 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
@@ -157,8 +157,10 @@ it expects the global environment to contain bindings for the binders
 rnTopBindsLHS :: MiniFixityEnv
               -> HsValBinds RdrName 
               -> RnM (HsValBindsLR Name RdrName)
-rnTopBindsLHS fix_env binds = 
-    (uncurry $ rnValBindsLHSFromDoc (topRecNameMaker fix_env)) (bindersAndDoc binds) binds
+rnTopBindsLHS fix_env binds
+  = do { let (boundNames,doc) = bindersAndDoc binds 
+       ; mod <- getModule
+       ; rnValBindsLHSFromDoc (topRecNameMaker mod fix_env) boundNames doc binds }
 
 rnTopBindsRHS :: NameSet	-- Names bound by these binds
               -> HsValBindsLR Name RdrName 
@@ -461,8 +463,7 @@ rnBindLHS name_maker _ (L loc (FunBind { fun_id = name@(L nameLoc _),
                                          fun_tick = fun_tick
                                        }))
   = setSrcSpan loc $ 
-    do { (newname, _fvs) <- applyNameMaker name_maker name $ \ newname ->
-		 	    return (newname, emptyFVs) 
+    do { newname <- applyNameMaker name_maker name
        ; return (L loc (FunBind { fun_id = L nameLoc newname, 
                              	  fun_infix = inf, 
                              	  fun_matches = matches,
@@ -638,7 +639,7 @@ rnMethodBind :: Name
 rnMethodBind cls sig_fn gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf, 
 					             fun_matches = MatchGroup matches _ }))
   = setSrcSpan loc $ do
-    sel_name <- lookupInstDeclBndr cls name
+    sel_name <- wrapLocM (lookupInstDeclBndr cls) name
     let plain_name = unLoc sel_name
         -- We use the selector name as the binder
 
@@ -718,6 +719,8 @@ renameSigs mb_names ok_sig sigs
 
 renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name)
 -- FixitySig is renamed elsewhere.
+renameSig _ (IdSig x)
+  = return (IdSig x)	  -- Actually this never occurs
 renameSig mb_names sig@(TypeSig v ty)
   = do	{ new_v <- lookupSigOccRn mb_names sig v
 	; new_ty <- rnHsSigType (quotes (ppr v)) ty
@@ -767,7 +770,7 @@ rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
 
 	       -- Now the main event
 	       -- note that there are no local ficity decls for matches
-	; rnPatsAndThen_LocalRightwards ctxt pats	$ \ pats' -> do
+	; rnPats ctxt pats	$ \ pats' -> do
 	{ (grhss', grhss_fvs) <- rnGRHSs ctxt grhss
 
 	; return (Match pats' Nothing grhss', grhss_fvs) }}