diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2015-05-11 09:34:27 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2015-05-11 09:34:27 +0200 |
| commit | 811b72adedcd12149783eac19ebccff1dd72bc1c (patch) | |
| tree | 2c9a959649ff7d927ea5602384ccdef6f325d21c /compiler/parser | |
| parent | 5c459eefcb17ff97beebdc08ccfca21bd8fa5201 (diff) | |
| download | haskell-811b72adedcd12149783eac19ebccff1dd72bc1c.tar.gz | |
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
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 32 |
1 files changed, 19 insertions, 13 deletions
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 |