Wibble to RnPat refactoring

diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 2f80afc..12432a3 100644 (file)
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -639,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
 

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index d3e1bdc..64e299e 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -12,7 +12,7 @@ module RnEnv (
        lookupGlobalOccRn, lookupGlobalOccRn_maybe,
        lookupLocalDataTcNames, lookupSigOccRn,
        lookupFixityRn, lookupTyFixityRn, 
-       lookupInstDeclBndr, lookupLocatedSubBndr, lookupConstructorFields,
+       lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
        lookupSyntaxName, lookupSyntaxTable, 
        lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
        getLookupOccRn, addUsedRdrNames,
@@ -215,7 +215,7 @@ lookupTopBndrRn_maybe rdr_name
              
 
 -----------------------------------------------
-lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
+lookupInstDeclBndr :: Name -> RdrName -> RnM Name
 -- This is called on the method name on the left-hand side of an 
 -- instance declaration binding. eg.  instance Functor T where
 --                                       fmap = ...
@@ -227,7 +227,13 @@ lookupInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
 -- name is only in scope qualified.  I.e. even if method op is
 -- in scope as M.op, we still allow plain 'op' on the LHS of
 -- an instance decl
-lookupInstDeclBndr cls rdr = lookupLocatedSubBndr (ParentIs cls) doc rdr
+lookupInstDeclBndr cls rdr
+  = do { when (isQual rdr)
+                     (addErr (badQualBndrErr rdr)) 
+               -- In an instance decl you aren't allowed
+               -- to use a qualified name for the method
+               -- (Although it'd make perfect sense.)
+       ; lookupSubBndr (ParentIs cls) doc rdr }
   where
     doc = ptext (sLit "method of class") <+> quotes (ppr cls)
 
@@ -264,15 +270,11 @@ lookupConstructorFields con_name
 -- unambiguous because there is only one field id 'fld' in scope.
 -- But currently it's rejected.
 
-lookupLocatedSubBndr :: Parent  -- NoParent   => just look it up as usual
-                                  -- ParentIs p => use p to disambiguate
-                       -> SDoc -> Located RdrName
-                       -> RnM (Located Name)
-lookupLocatedSubBndr parent doc rdr_name
-  = wrapLocM (lookup_sub_bndr parent doc) rdr_name
-
-lookup_sub_bndr :: Parent -> SDoc -> RdrName -> RnM Name
-lookup_sub_bndr parent doc rdr_name
+lookupSubBndr :: Parent  -- NoParent   => just look it up as usual
+                        -- ParentIs p => use p to disambiguate
+              -> SDoc -> RdrName 
+              -> RnM Name
+lookupSubBndr parent doc rdr_name
   | Just n <- isExact_maybe rdr_name   -- This happens in derived code
   = return n
 

diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index b094628..b49e1cd 100644 (file)
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -456,7 +456,7 @@ rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }
     rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
                                             , hsRecFieldArg = arg
                                             , hsRecPun = pun })
-      = do { fld' <- lookupLocatedSubBndr parent doc fld
+      = do { fld' <- wrapLocM (lookupSubBndr parent doc) fld
            ; arg' <- if pun 
                      then do { checkErr pun_ok (badPun fld)
                              ; return (name_to_arg fld') }