diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 10 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 18 |
2 files changed, 15 insertions, 13 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index ed6f5ad4c8..5a862a8058 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1606,14 +1606,14 @@ ctypedoc :: { LHsType RdrName } -- Thus for some reason we allow f :: a~b => blah -- but not f :: ?x::Int => blah context :: { LHsContext RdrName } - : btype '~' btype {% amms (checkContext - (sLL $1 $> $ HsEqTy $1 $3)) - [mj AnnTilde $2] } - | btype {% do { ctx <- checkContext $1 + : btype '~' btype {% do { (anns,ctx) <- checkContext + (sLL $1 $> $ HsEqTy $1 $3) + ; ams ctx (mj AnnTilde $2:anns) } } + | btype {% do { (anns,ctx) <- checkContext $1 ; if null (unLoc ctx) then addAnnotation (gl $1) AnnUnit (gl $1) else return () - ; return ctx + ; ams ctx anns } } type :: { LHsType RdrName } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 5e2fa131cf..14476407fc 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -864,18 +864,20 @@ checkTyClHdr is_cls ty = parseErrorSDoc l (text "Malformed head of type or class declaration:" <+> ppr ty) -checkContext :: LHsType RdrName -> P (LHsContext RdrName) +checkContext :: LHsType RdrName -> P ([AddAnn],LHsContext RdrName) checkContext (L l orig_t) - = check orig_t + = check [] (L l orig_t) where - check (HsTupleTy _ ts) -- (Eq a, Ord b) shows up as a tuple type - = return (L l ts) -- Ditto () + check anns (L lp (HsTupleTy _ ts)) -- (Eq a, Ord b) shows up as a tuple type + = return (anns ++ mkParensApiAnn lp,L l ts) -- Ditto () - check (HsParTy ty) -- to be sure HsParTy doesn't get into the way - = check (unLoc ty) + check anns (L lp1 (HsParTy ty))-- to be sure HsParTy doesn't get into the way + = check anns' ty + where anns' = if l == lp1 then anns + else (anns ++ mkParensApiAnn lp1) - check _ - = return (L l [L l orig_t]) + check _anns _ + = return ([],L l [L l orig_t]) -- no need for anns, returning original -- ------------------------------------------------------------------------- -- Checking Patterns. |