Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

#6612: attribute in type expressions bind less then product types; attributes come after constructor/field declarations. 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15897 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2015-03-11 14:57:20 +00:00
parent 11333d938c
commit 4c48d802cb
2 changed files with 40 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
parsing/parser.mly
View File

@ -1649,10 +1649,10 @@ constructor_declarations:
| constructor_declarations BAR constructor_declaration { $3 :: $1 } | constructor_declarations BAR constructor_declaration { $3 :: $1 }
; ;
constructor_declaration: constructor_declaration:
| constr_ident attributes generalized_constructor_arguments | constr_ident generalized_constructor_arguments attributes
{ {
let args,res = $3 in let args,res = $2 in
Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2 Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$3
} }
; ;
str_exception_declaration: str_exception_declaration:
@ -1677,14 +1677,14 @@ sig_exception_declaration:
generalized_constructor_arguments: generalized_constructor_arguments:
/*empty*/ { (Pcstr_tuple [],None) } /*empty*/ { (Pcstr_tuple [],None) }
| OF constructor_arguments { ($2,None) } | OF constructor_arguments { ($2,None) }
| COLON constructor_arguments MINUSGREATER simple_core_type | COLON constructor_arguments MINUSGREATER simple_core_type_no_attr
{ ($2,Some $4) } { ($2,Some $4) }
| COLON simple_core_type | COLON simple_core_type_no_attr
{ (Pcstr_tuple [],Some $2) } { (Pcstr_tuple [],Some $2) }
; ;
constructor_arguments: constructor_arguments:
| core_type_list { Pcstr_tuple (List.rev $1) } | core_type_list_no_attr { Pcstr_tuple (List.rev $1) }
| LBRACE label_declarations opt_semi RBRACE { Pcstr_record (List.rev $2) } | LBRACE label_declarations opt_semi RBRACE { Pcstr_record (List.rev $2) }
; ;
label_declarations: label_declarations:
@ -1692,9 +1692,9 @@ label_declarations:
| label_declarations SEMI label_declaration { $3 :: $1 } | label_declarations SEMI label_declaration { $3 :: $1 }
; ;
label_declaration: label_declaration:
mutable_flag label attributes COLON poly_type mutable_flag label COLON poly_type_no_attr attributes
{ {
Type.field (mkrhs $2 2) $5 ~mut:$1 ~attrs:$3 ~loc:(symbol_rloc()) Type.field (mkrhs $2 2) $4 ~mut:$1 ~attrs:$5 ~loc:(symbol_rloc())
} }
; ;
@ -1726,13 +1726,13 @@ sig_extension_constructors:
{ $3 :: $1 } { $3 :: $1 }
; ;
extension_constructor_declaration: extension_constructor_declaration:
| constr_ident attributes generalized_constructor_arguments | constr_ident generalized_constructor_arguments attributes
{ let args, res = $3 in { let args, res = $2 in
Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2 } Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$3 }
; ;
extension_constructor_rebind: extension_constructor_rebind:
| constr_ident attributes EQUAL constr_longident | constr_ident EQUAL constr_longident attributes
{ Te.rebind (mkrhs $1 1) (mkrhs $4 4) ~loc:(symbol_rloc()) ~attrs:$2 } { Te.rebind (mkrhs $1 1) (mkrhs $3 3) ~loc:(symbol_rloc()) ~attrs:$4 }
; ;
/* "with" constraints (additional type equations over signature components) */ /* "with" constraints (additional type equations over signature components) */
@ -1742,7 +1742,7 @@ with_constraints:
| with_constraints AND with_constraint { $3 :: $1 } | with_constraints AND with_constraint { $3 :: $1 }
; ;
with_constraint: with_constraint:
TYPE type_parameters label_longident with_type_binder core_type constraints TYPE type_parameters label_longident with_type_binder core_type_no_attr constraints
{ Pwith_type { Pwith_type
(mkrhs $3 3, (mkrhs $3 3,
(Type.mk (mkrhs (Longident.last $3) 3) (Type.mk (mkrhs (Longident.last $3) 3)
@ -1753,7 +1753,7 @@ with_constraint:
~loc:(symbol_rloc()))) } ~loc:(symbol_rloc()))) }
/* used label_longident instead of type_longident to disallow /* used label_longident instead of type_longident to disallow
functor applications in type path */ functor applications in type path */
| TYPE type_parameters label COLONEQUAL core_type | TYPE type_parameters label COLONEQUAL core_type_no_attr
{ Pwith_typesubst { Pwith_typesubst
(Type.mk (mkrhs $3 3) (Type.mk (mkrhs $3 3)
~params:$2 ~params:$2
@ -1781,10 +1781,22 @@ poly_type:
| typevar_list DOT core_type | typevar_list DOT core_type
{ mktyp(Ptyp_poly(List.rev $1, $3)) } { mktyp(Ptyp_poly(List.rev $1, $3)) }
; ;
poly_type_no_attr:
core_type_no_attr
{ $1 }
| typevar_list DOT core_type_no_attr
{ mktyp(Ptyp_poly(List.rev $1, $3)) }
;
/* Core types */ /* Core types */
core_type: core_type:
core_type_no_attr
{ $1 }
| core_type attribute
{ Typ.attr $1 $2 }
;
core_type_no_attr:
core_type2 core_type2
{ $1 } { $1 }
| core_type2 AS QUOTE ident | core_type2 AS QUOTE ident
@ -1808,8 +1820,6 @@ simple_core_type:
{ $1 } { $1 }
| LPAREN core_type_comma_list RPAREN %prec below_SHARP | LPAREN core_type_comma_list RPAREN %prec below_SHARP
{ match $2 with [sty] -> sty | _ -> raise Parse_error } { match $2 with [sty] -> sty | _ -> raise Parse_error }
| simple_core_type attribute
{ Typ.attr $1 $2 }
; ;
simple_core_type_no_attr: simple_core_type_no_attr:
@ -1883,8 +1893,8 @@ row_field:
| simple_core_type { Rinherit $1 } | simple_core_type { Rinherit $1 }
; ;
tag_field: tag_field:
name_tag attributes OF opt_ampersand amper_type_list name_tag OF opt_ampersand amper_type_list attributes
{ Rtag ($1, $2, $4, List.rev $5) } { Rtag ($1, $5, $3, List.rev $4) }
| name_tag attributes | name_tag attributes
{ Rtag ($1, $2, true, []) } { Rtag ($1, $2, true, []) }
; ;
@ -1893,8 +1903,8 @@ opt_ampersand:
| /* empty */ { false } | /* empty */ { false }
; ;
amper_type_list: amper_type_list:
core_type { [$1] } core_type_no_attr { [$1] }
| amper_type_list AMPERSAND core_type { $3 :: $1 } | amper_type_list AMPERSAND core_type_no_attr { $3 :: $1 }
; ;
name_tag_list: name_tag_list:
name_tag { [$1] } name_tag { [$1] }
@ -1929,7 +1939,7 @@ meth_list:
| DOTDOT { [], Open } | DOTDOT { [], Open }
; ;
field: field:
label attributes COLON poly_type { ($1, $2, $4) } label COLON poly_type_no_attr attributes { ($1, $4, $3) }
; ;
label: label:
LIDENT { $1 } LIDENT { $1 }

16
parsing/pprintast.ml
View File

@ -258,12 +258,12 @@ class printer ()= object(self:'self)
| Ptyp_variant (l, closed, low) -> | Ptyp_variant (l, closed, low) ->
let type_variant_helper f x = let type_variant_helper f x =
match x with match x with
| Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a%a@]" self#string_quot l | Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a@;%a@]" self#string_quot l
self#attributes attrs
(fun f l -> match l with (fun f l -> match l with
|[] -> () |[] -> ()
| _ -> pp f "@;of@;%a" | _ -> pp f "@;of@;%a"
(self#list self#core_type ~sep:"&") ctl) ctl (self#list self#core_type ~sep:"&") ctl) ctl
self#attributes attrs
| Rinherit ct -> self#core_type f ct in | Rinherit ct -> self#core_type f ct in
pp f "@[<2>[%a%a]@]" pp f "@[<2>[%a%a]@]"
(fun f l (fun f l
@ -1235,11 +1235,11 @@ class printer ()= object(self:'self)
method record_declaration f lbls = method record_declaration f lbls =
let type_record_field f pld = let type_record_field f pld =
pp f "@[<2>%a%s%a:@;%a@]" pp f "@[<2>%a%s:@;%a@;%a@]"
self#mutable_flag pld.pld_mutable self#mutable_flag pld.pld_mutable
pld.pld_name.txt pld.pld_name.txt
self#attributes pld.pld_attributes
self#core_type pld.pld_type self#core_type pld.pld_type
self#attributes pld.pld_attributes
in in
pp f "{@\n%a}" pp f "{@\n%a}"
(self#list type_record_field ~sep:";@\n" ) lbls (self#list type_record_field ~sep:";@\n" ) lbls
@ -1301,17 +1301,16 @@ class printer ()= object(self:'self)
method constructor_declaration f (name, args, res, attrs) = method constructor_declaration f (name, args, res, attrs) =
match res with match res with
| None -> | None ->
pp f "%s%a%a" name pp f "%s%a@;%a" name
self#attributes attrs
(fun f -> function (fun f -> function
| Pcstr_tuple [] -> () | Pcstr_tuple [] -> ()
| Pcstr_tuple l -> | Pcstr_tuple l ->
pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l
| Pcstr_record l -> pp f "@;of@;%a" (self#record_declaration) l | Pcstr_record l -> pp f "@;of@;%a" (self#record_declaration) l
) args ) args
| Some r ->
pp f "%s%a:@;%a" name
self#attributes attrs self#attributes attrs
| Some r ->
pp f "%s:@;%a@;%a" name
(fun f -> function (fun f -> function
| Pcstr_tuple [] -> self#core_type1 f r | Pcstr_tuple [] -> self#core_type1 f r
| Pcstr_tuple l -> pp f "%a@;->@;%a" | Pcstr_tuple l -> pp f "%a@;->@;%a"
@ -1321,6 +1320,7 @@ class printer ()= object(self:'self)
pp f "%a@;->@;%a" (self#record_declaration) l self#core_type1 r pp f "%a@;->@;%a" (self#record_declaration) l self#core_type1 r
) )
args args
self#attributes attrs
method extension_constructor f x = method extension_constructor f x =