From 811b72adedcd12149783eac19ebccff1dd72bc1c Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 11 May 2015 09:34:27 +0200 Subject: Api Annotations: RdrHsSyn.mkAtDefault causes annotations to be disconnected. Summary: The code for mkAtDefault is as follows. mkATDefault (L loc (TyFamInstDecl { tfid_eqn = L _ e })) | TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_rhs = rhs } <- e = do { tvs <- checkTyVars (ptext (sLit "default")) equalsDots tc (hswb_cts pats) ; return (L loc (TyFamEqn { tfe_tycon = tc , tfe_pats = tvs , tfe_rhs = rhs })) } An associated type in a class of the form type FoldableConstraint t x = () has an AnnEqual attached to the location in tfid_eqn. Since the location is discarded, this annotation is then disconnected from the AST. Test Plan: ./validate Reviewers: hvr, austin Reviewed By: austin Subscribers: bgamari, thomie, mpickering Differential Revision: https://phabricator.haskell.org/D842 GHC Trac Issues: #10307 --- compiler/parser/Parser.y | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) (limited to 'compiler/parser') diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index b000e69d78..1baf606173 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -962,8 +962,9 @@ inst_decl :: { LInstDecl RdrName } -- type instance declarations | 'type' 'instance' ty_fam_inst_eqn - {% amms (mkTyFamInst (comb2 $1 $3) $3) - [mj AnnType $1,mj AnnInstance $2] } + {% ams $3 (fst $ unLoc $3) + >> amms (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3)) + (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) } -- data/newtype instance declaration | data_or_newtype 'instance' capi_ctype tycl_hdr constrs deriving @@ -1013,19 +1014,21 @@ ty_fam_inst_eqn_list :: { Located ([AddAnn],Maybe [LTyFamInstEqn RdrName]) } ty_fam_inst_eqns :: { Located [LTyFamInstEqn RdrName] } : ty_fam_inst_eqns ';' ty_fam_inst_eqn - {% asl (unLoc $1) $2 $3 - >> return (sLL $1 $> ($3 : unLoc $1)) } + {% asl (unLoc $1) $2 (snd $ unLoc $3) + >> ams $3 (fst $ unLoc $3) + >> return (sLL $1 $> ((snd $ unLoc $3) : unLoc $1)) } | ty_fam_inst_eqns ';' {% addAnnotation (gl $1) AnnSemi (gl $2) >> return (sLL $1 $> (unLoc $1)) } - | ty_fam_inst_eqn { sLL $1 $> [$1] } + | ty_fam_inst_eqn {% ams $1 (fst $ unLoc $1) + >> return (sLL $1 $> [snd $ unLoc $1]) } | {- empty -} { noLoc [] } -ty_fam_inst_eqn :: { LTyFamInstEqn RdrName } +ty_fam_inst_eqn :: { Located ([AddAnn],LTyFamInstEqn RdrName) } : type '=' ctype -- Note the use of type for the head; this allows -- infix type constructors and type patterns {% do { (eqn,ann) <- mkTyFamInstEqn $1 $3 - ; ams (sLL $1 $> eqn) (mj AnnEqual $2:ann) } } + ; return (sLL $1 $> (mj AnnEqual $2:ann, sLL $1 $> eqn)) } } -- Associated type family declarations -- @@ -1056,11 +1059,13 @@ at_decl_cls :: { LHsDecl RdrName } -- default type instances, with optional 'instance' keyword | 'type' ty_fam_inst_eqn - {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) $2)) - [mj AnnType $1] } + {% ams $2 (fst $ unLoc $2) >> + amms (liftM mkInstD (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2))) + (mj AnnType $1:(fst $ unLoc $2)) } | 'type' 'instance' ty_fam_inst_eqn - {% amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) $3)) - [mj AnnType $1,mj AnnInstance $2] } + {% ams $3 (fst $ unLoc $3) >> + amms (liftM mkInstD (mkTyFamInst (comb2 $1 $3) (snd $ unLoc $3))) + (mj AnnType $1:mj AnnInstance $2:(fst $ unLoc $3)) } opt_family :: { [AddAnn] } : {- empty -} { [] } @@ -1073,8 +1078,9 @@ at_decl_inst :: { LInstDecl RdrName } : 'type' ty_fam_inst_eqn -- Note the use of type for the head; this allows -- infix type constructors and type patterns - {% amms (mkTyFamInst (comb2 $1 $2) $2) - [mj AnnType $1] } + {% ams $2 (fst $ unLoc $2) >> + amms (mkTyFamInst (comb2 $1 $2) (snd $ unLoc $2)) + (mj AnnType $1:(fst $ unLoc $2)) } -- data/newtype instance declaration | data_or_newtype capi_ctype tycl_hdr constrs deriving -- cgit v1.2.1