#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-0dff7051ff02master
Alain Frisch
parent
11333d938c
commit
4c48d802cb
|
|
@ -1649,10 +1649,10 @@ constructor_declarations:
|
|||
| constructor_declarations BAR constructor_declaration { $3 :: $1 }
|
||||
;
|
||||
constructor_declaration:
|
||||
| constr_ident attributes generalized_constructor_arguments
|
||||
| constr_ident generalized_constructor_arguments attributes
|
||||
{
|
||||
let args,res = $3 in
|
||||
Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2
|
||||
let args,res = $2 in
|
||||
Type.constructor (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$3
|
||||
}
|
||||
;
|
||||
str_exception_declaration:
|
||||
|
|
@ -1677,14 +1677,14 @@ sig_exception_declaration:
|
|||
generalized_constructor_arguments:
|
||||
/*empty*/ { (Pcstr_tuple [],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) }
|
||||
| COLON simple_core_type
|
||||
| COLON simple_core_type_no_attr
|
||||
{ (Pcstr_tuple [],Some $2) }
|
||||
;
|
||||
|
||||
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) }
|
||||
;
|
||||
label_declarations:
|
||||
|
|
@ -1692,9 +1692,9 @@ label_declarations:
|
|||
| label_declarations SEMI label_declaration { $3 :: $1 }
|
||||
;
|
||||
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 }
|
||||
;
|
||||
extension_constructor_declaration:
|
||||
| constr_ident attributes generalized_constructor_arguments
|
||||
{ let args, res = $3 in
|
||||
Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$2 }
|
||||
| constr_ident generalized_constructor_arguments attributes
|
||||
{ let args, res = $2 in
|
||||
Te.decl (mkrhs $1 1) ~args ?res ~loc:(symbol_rloc()) ~attrs:$3 }
|
||||
;
|
||||
extension_constructor_rebind:
|
||||
| constr_ident attributes EQUAL constr_longident
|
||||
{ Te.rebind (mkrhs $1 1) (mkrhs $4 4) ~loc:(symbol_rloc()) ~attrs:$2 }
|
||||
| constr_ident EQUAL constr_longident attributes
|
||||
{ Te.rebind (mkrhs $1 1) (mkrhs $3 3) ~loc:(symbol_rloc()) ~attrs:$4 }
|
||||
;
|
||||
|
||||
/* "with" constraints (additional type equations over signature components) */
|
||||
|
|
@ -1742,7 +1742,7 @@ with_constraints:
|
|||
| with_constraints AND with_constraint { $3 :: $1 }
|
||||
;
|
||||
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
|
||||
(mkrhs $3 3,
|
||||
(Type.mk (mkrhs (Longident.last $3) 3)
|
||||
|
|
@ -1753,7 +1753,7 @@ with_constraint:
|
|||
~loc:(symbol_rloc()))) }
|
||||
/* used label_longident instead of type_longident to disallow
|
||||
functor applications in type path */
|
||||
| TYPE type_parameters label COLONEQUAL core_type
|
||||
| TYPE type_parameters label COLONEQUAL core_type_no_attr
|
||||
{ Pwith_typesubst
|
||||
(Type.mk (mkrhs $3 3)
|
||||
~params:$2
|
||||
|
|
@ -1781,10 +1781,22 @@ poly_type:
|
|||
| typevar_list DOT core_type
|
||||
{ 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_type:
|
||||
core_type_no_attr
|
||||
{ $1 }
|
||||
| core_type attribute
|
||||
{ Typ.attr $1 $2 }
|
||||
;
|
||||
core_type_no_attr:
|
||||
core_type2
|
||||
{ $1 }
|
||||
| core_type2 AS QUOTE ident
|
||||
|
|
@ -1808,8 +1820,6 @@ simple_core_type:
|
|||
{ $1 }
|
||||
| LPAREN core_type_comma_list RPAREN %prec below_SHARP
|
||||
{ match $2 with [sty] -> sty | _ -> raise Parse_error }
|
||||
| simple_core_type attribute
|
||||
{ Typ.attr $1 $2 }
|
||||
;
|
||||
|
||||
simple_core_type_no_attr:
|
||||
|
|
@ -1883,8 +1893,8 @@ row_field:
|
|||
| simple_core_type { Rinherit $1 }
|
||||
;
|
||||
tag_field:
|
||||
name_tag attributes OF opt_ampersand amper_type_list
|
||||
{ Rtag ($1, $2, $4, List.rev $5) }
|
||||
name_tag OF opt_ampersand amper_type_list attributes
|
||||
{ Rtag ($1, $5, $3, List.rev $4) }
|
||||
| name_tag attributes
|
||||
{ Rtag ($1, $2, true, []) }
|
||||
;
|
||||
|
|
@ -1893,8 +1903,8 @@ opt_ampersand:
|
|||
| /* empty */ { false }
|
||||
;
|
||||
amper_type_list:
|
||||
core_type { [$1] }
|
||||
| amper_type_list AMPERSAND core_type { $3 :: $1 }
|
||||
core_type_no_attr { [$1] }
|
||||
| amper_type_list AMPERSAND core_type_no_attr { $3 :: $1 }
|
||||
;
|
||||
name_tag_list:
|
||||
name_tag { [$1] }
|
||||
|
|
@ -1929,7 +1939,7 @@ meth_list:
|
|||
| DOTDOT { [], Open }
|
||||
;
|
||||
field:
|
||||
label attributes COLON poly_type { ($1, $2, $4) }
|
||||
label COLON poly_type_no_attr attributes { ($1, $4, $3) }
|
||||
;
|
||||
label:
|
||||
LIDENT { $1 }
|
||||
|
|
|
|||
|
|
@ -258,12 +258,12 @@ class printer ()= object(self:'self)
|
|||
| Ptyp_variant (l, closed, low) ->
|
||||
let type_variant_helper f x =
|
||||
match x with
|
||||
| Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a%a@]" self#string_quot l
|
||||
self#attributes attrs
|
||||
| Rtag (l, attrs, _, ctl) -> pp f "@[<2>%a%a@;%a@]" self#string_quot l
|
||||
(fun f l -> match l with
|
||||
|[] -> ()
|
||||
| _ -> pp f "@;of@;%a"
|
||||
(self#list self#core_type ~sep:"&") ctl) ctl
|
||||
self#attributes attrs
|
||||
| Rinherit ct -> self#core_type f ct in
|
||||
pp f "@[<2>[%a%a]@]"
|
||||
(fun f l
|
||||
|
|
@ -1235,11 +1235,11 @@ class printer ()= object(self:'self)
|
|||
|
||||
method record_declaration f lbls =
|
||||
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
|
||||
pld.pld_name.txt
|
||||
self#attributes pld.pld_attributes
|
||||
self#core_type pld.pld_type
|
||||
self#attributes pld.pld_attributes
|
||||
in
|
||||
pp f "{@\n%a}"
|
||||
(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) =
|
||||
match res with
|
||||
| None ->
|
||||
pp f "%s%a%a" name
|
||||
self#attributes attrs
|
||||
pp f "%s%a@;%a" name
|
||||
(fun f -> function
|
||||
| Pcstr_tuple [] -> ()
|
||||
| Pcstr_tuple l ->
|
||||
pp f "@;of@;%a" (self#list self#core_type1 ~sep:"*@;") l
|
||||
| Pcstr_record l -> pp f "@;of@;%a" (self#record_declaration) l
|
||||
) args
|
||||
| Some r ->
|
||||
pp f "%s%a:@;%a" name
|
||||
self#attributes attrs
|
||||
| Some r ->
|
||||
pp f "%s:@;%a@;%a" name
|
||||
(fun f -> function
|
||||
| Pcstr_tuple [] -> self#core_type1 f r
|
||||
| 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
|
||||
)
|
||||
args
|
||||
self#attributes attrs
|
||||
|
||||
|
||||
method extension_constructor f x =
|
||||
|
|
|
|||
Loading…
Reference in New Issue