Commit ddfba75f authored by Simon Peyton Jones's avatar Simon Peyton Jones

In instance declarations, the method names are *occurrences* not *binders*

A long standing bug. The patch fixes Trac #5410
parent 1064ab02
...@@ -301,20 +301,23 @@ repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD ...@@ -301,20 +301,23 @@ repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
-- --
repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ) repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
= do { i <- addTyVarBinds tvs $ \_ -> = do { dec <- addTyVarBinds tvs $ \_ ->
-- We must bring the type variables into scope, so their -- We must bring the type variables into scope, so their
-- occurrences don't fail, even though the binders don't -- occurrences don't fail, even though the binders don't
-- appear in the resulting data structure -- appear in the resulting data structure
do { cxt1 <- repContext cxt --
; inst_ty1 <- repPredTy (HsClassP cls tys) -- But we do NOT bring the binders of 'binds' into scope
; ss <- mkGenSyms (collectHsBindsBinders binds) -- becuase they are properly regarded as occurrences
; binds1 <- addBinds ss (rep_binds binds) -- For example, the method names should be bound to
; ats1 <- repLAssocFamInst ats -- the selector Ids, not to fresh names (Trac #5410)
; decls <- coreList decQTyConName (ats1 ++ binds1) --
; inst_decl <- repInst cxt1 inst_ty1 decls do { cxt1 <- repContext cxt
; wrapGenSyms ss inst_decl ; inst_ty1 <- repPredTy (HsClassP cls tys)
} ; binds1 <- rep_binds binds
; return (loc, i)} ; ats1 <- repLAssocFamInst ats
; decls <- coreList decQTyConName (ats1 ++ binds1)
; repInst cxt1 inst_ty1 decls }
; return (loc, dec) }
where where
(tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty) (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
...@@ -1146,20 +1149,6 @@ addBinds :: [GenSymBind] -> DsM a -> DsM a ...@@ -1146,20 +1149,6 @@ addBinds :: [GenSymBind] -> DsM a -> DsM a
-- by the desugarer monad) -- by the desugarer monad)
addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m 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 :: (Name, Name) -> DsM (Name, DsMetaVal)
dupBinder (new, old) dupBinder (new, old)
= do { mb_val <- dsLookupMetaEnv old = do { mb_val <- dsLookupMetaEnv old
...@@ -1167,6 +1156,18 @@ dupBinder (new, old) ...@@ -1167,6 +1156,18 @@ dupBinder (new, old)
Just val -> return (new, val) Just val -> return (new, val)
Nothing -> pprPanic "dupBinder" (ppr old) } 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 -- 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, -- * If it is a global name, generate the "original name" representation (ie,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment