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