From 4ca8ef874f037bce9b201be5fde6261af8d3eaab Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon, 15 Aug 2011 08:41:02 +0100
Subject: [PATCH] In instance declarations, the method names are *occurrences*
 not *binders*

A long standing bug. The patch fixes Trac #5410
---
 compiler/deSugar/DsMeta.hs | 57 +++++++++++++++++++-------------------
 1 file changed, 29 insertions(+), 28 deletions(-)

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 22d4f52e8e70..164a8829b49b 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -301,20 +301,23 @@ repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
 --
 repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
 repInstD' (L loc (InstDecl ty binds _ ats))	-- Ignore user pragmas for now
-  = do { i <- addTyVarBinds tvs $ \_ ->
-		-- We must bring the type variables into scope, so their
-		-- occurrences don't fail, even though the binders don't 
-                -- appear in the resulting data structure
-		do { cxt1 <- repContext cxt
-		   ; inst_ty1 <- repPredTy (HsClassP cls tys)
-		   ; ss <- mkGenSyms (collectHsBindsBinders binds)
-		   ; binds1 <- addBinds ss (rep_binds binds)
-                   ; ats1   <- repLAssocFamInst ats
-		   ; decls <- coreList decQTyConName (ats1 ++ binds1)
-		   ; inst_decl <- repInst cxt1 inst_ty1 decls
-		   ; wrapGenSyms ss inst_decl
-                   }
-	; return (loc, i)}
+  = do { dec <- addTyVarBinds tvs $ \_ ->
+	    -- We must bring the type variables into scope, so their
+	    -- occurrences don't fail, even though the binders don't 
+            -- appear in the resulting data structure
+	    --
+	    -- But we do NOT bring the binders of 'binds' into scope
+	    -- becuase they are properly regarded as occurrences
+	    -- For example, the method names should be bound to
+	    -- the selector Ids, not to fresh names (Trac #5410)
+	    --
+            do { cxt1 <- repContext cxt
+               ; inst_ty1 <- repPredTy (HsClassP cls tys)
+               ; binds1 <- rep_binds binds
+               ; ats1 <- repLAssocFamInst ats
+               ; decls <- coreList decQTyConName (ats1 ++ binds1)
+               ; repInst cxt1 inst_ty1 decls }
+       ; return (loc, dec) }
  where
    (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
 
@@ -1145,20 +1148,6 @@ addBinds :: [GenSymBind] -> DsM a -> DsM a
 -- by the desugarer monad) 
 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
 
--- Look up a locally bound name
---
-lookupLBinder :: Located Name -> DsM (Core TH.Name)
-lookupLBinder (L _ n) = lookupBinder n
-
-lookupBinder :: Name -> DsM (Core TH.Name)
-lookupBinder n 
-  = do { mb_val <- dsLookupMetaEnv n;
-	 case mb_val of
-	    Just (Bound x) -> return (coreVar x)
-	    _              -> failWithDs msg }
-  where
-    msg = ptext (sLit "DsMeta: failed binder lookup when desugaring a TH bracket:") <+> ppr n
-
 dupBinder :: (Name, Name) -> DsM (Name, DsMetaVal)
 dupBinder (new, old) 
   = do { mb_val <- dsLookupMetaEnv old
@@ -1166,6 +1155,18 @@ dupBinder (new, old)
            Just val -> return (new, val)
            Nothing  -> pprPanic "dupBinder" (ppr old) }
 
+-- Look up a locally bound name
+--
+lookupLBinder :: Located Name -> DsM (Core TH.Name)
+lookupLBinder (L _ n) = lookupBinder n
+
+lookupBinder :: Name -> DsM (Core TH.Name)
+lookupBinder = lookupOcc
+  -- Binders are brought into scope before the pattern or what-not is
+  -- desugared.  Moreover, in instance declaration the binder of a method
+  -- will be the selector Id and hence a global; so we need the 
+  -- globalVar case of lookupOcc
+
 -- Look up a name that is either locally bound or a global name
 --
 --  * If it is a global name, generate the "original name" representation (ie,
-- 
GitLab