diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 23 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 26 |
2 files changed, 29 insertions, 20 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 69c8fdefd0..3af5d1a9d9 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1737,10 +1737,11 @@ unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) } -- A ctype is a for-all type ctype :: { LHsType GhcPs } : 'forall' tv_bndrs '.' ctype {% hintExplicitForall (getLoc $1) >> - ams (sLL $1 $> $ - HsForAllTy { hst_bndrs = $2 - , hst_body = $4 }) - [mu AnnForall $1, mj AnnDot $3] } + let { L l tvs = sLL $1 $3 $ $2 } + in do { ams (L l ()) [mu AnnForall $1, mj AnnDot $3] + ; return (sLL $1 $> $ + HsForAllTy { hst_bndrs = L l tvs + , hst_body = $4 }) } } | context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 @@ -1762,10 +1763,11 @@ ctype :: { LHsType GhcPs } ctypedoc :: { LHsType GhcPs } : 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >> - ams (sLL $1 $> $ - HsForAllTy { hst_bndrs = $2 - , hst_body = $4 }) - [mu AnnForall $1,mj AnnDot $3] } + let { L l tvs = sLL $1 $3 $ $2 } + in do { ams (L l ()) [mu AnnForall $1, mj AnnDot $3] + ; return (sLL $1 $> $ + HsForAllTy { hst_bndrs = L l tvs + , hst_body = $4 }) } } | context '=>' ctypedoc {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) >> return (sLL $1 $> $ HsQualTy { hst_ctxt = $1 @@ -2064,8 +2066,9 @@ gadt_constr :: { LConDecl GhcPs } -- see Note [Difference in parsing GADT and data constructors] -- Returns a list because of: C,D :: ty : con_list '::' sigtype - {% ams (sLL $1 $> (mkGadtDecl (unLoc $1) $3)) - [mu AnnDcolon $2] } + {% let { (anns,gadt) = mkGadtDecl (unLoc $1) $3 } + in ams (sLL $1 $> gadt) + ((mu AnnDcolon $2):anns) } {- Note [Difference in parsing GADT and data constructors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 1c03344eb2..534330a003 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -567,19 +567,21 @@ mkConDeclH98 name mb_forall cxt args mkGadtDecl :: [Located RdrName] -> LHsType GhcPs -- Always a HsForAllTy - -> ConDecl GhcPs + -> ([AddAnn],ConDecl GhcPs) mkGadtDecl names ty - = ConDeclGADT { con_names = names - , con_forall = isLHsForAllTy ty - , con_qvars = mkHsQTvs tvs - , con_mb_cxt = mcxt - , con_args = args - , con_res_ty = res_ty - , con_doc = Nothing } + = (anns, ConDeclGADT { con_names = names + , con_forall = isLHsForAllTy ty + , con_qvars = L tvloc $ mkHsQTvs tvs + , con_mb_cxt = mcxt + , con_args = args + , con_res_ty = res_ty + , con_doc = Nothing }) where - (tvs, rho) = splitLHsForAllTy ty + (L tvloc tvs, rho) = splitLHsForAllTy ty (mcxt, tau) = split_rho rho + anns = getHsParTyAsAnns ty ++ getHsParTyAsAnns rho ++ getHsParTyAsAnns tau + split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) = (Just cxt, tau) split_rho (L _ (HsParTy ty)) = split_rho ty @@ -592,6 +594,10 @@ mkGadtDecl names ty split_tau (L _ (HsParTy ty)) = split_tau ty split_tau tau = (PrefixCon [], tau) +getHsParTyAsAnns :: LHsType GhcPs -> [AddAnn] +getHsParTyAsAnns (L l (HsParTy ty)) = mkParensApiAnn l ++ getHsParTyAsAnns ty +getHsParTyAsAnns _ = [] + setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. -- When parsing: @@ -713,7 +719,7 @@ checkTyVars :: SDoc -> SDoc -> Located RdrName -> [LHsType GhcPs] -- Convert.hs checkTyVars pp_what equals_or_where tc tparms = do { tvs <- mapM chk tparms - ; return (mkHsQTvs tvs) } + ; return (noLoc $ mkHsQTvs tvs) } where chk (L _ (HsParTy ty)) = chk ty |