Attributes on value declared in signatures.

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13341 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-03-04 16:03:20 +00:00
parent a3f6606793
commit 2825f94d5b
4 changed files with 16 additions and 10 deletions

View File

@ -92,7 +92,7 @@ module T = struct
ptype_kind = sub # type_kind td.ptype_kind; ptype_kind = sub # type_kind td.ptype_kind;
ptype_manifest = map_opt (sub # typ) td.ptype_manifest; ptype_manifest = map_opt (sub # typ) td.ptype_manifest;
ptype_loc = sub # location td.ptype_loc; ptype_loc = sub # location td.ptype_loc;
ptype_attributes = List.map (sub # attribute) td.ptype_attributes; ptype_attributes = map_attributes sub td.ptype_attributes;
} }
let constructor_decl ?res ?(loc = Location.none) ?(attributes = []) name args = let constructor_decl ?res ?(loc = Location.none) ?(attributes = []) name args =
@ -110,7 +110,7 @@ module T = struct
(List.map (sub # typ) pcd_args) (List.map (sub # typ) pcd_args)
?res:(map_opt (sub # typ) pcd_res) ?res:(map_opt (sub # typ) pcd_res)
~loc:(sub # location pcd_loc) ~loc:(sub # location pcd_loc)
~attributes:(List.map (sub # attribute) pcd_attributes) ~attributes:(map_attributes sub pcd_attributes)
let map_type_kind sub = function let map_type_kind sub = function
| Ptype_abstract -> Ptype_abstract | Ptype_abstract -> Ptype_abstract
@ -512,11 +512,12 @@ class mapper =
method type_kind = T.map_type_kind this method type_kind = T.map_type_kind this
method typ = T.map this method typ = T.map this
method value_description {pval_type; pval_prim; pval_loc} = method value_description {pval_type; pval_prim; pval_loc; pval_attributes} =
{ {
pval_type = this # typ pval_type; pval_type = this # typ pval_type;
pval_prim; pval_prim;
pval_loc = this # location pval_loc; pval_loc = this # location pval_loc;
pval_attributes = map_attributes this pval_attributes;
} }
method pat = P.map this method pat = P.map this
method expr = E.map this method expr = E.map this

View File

@ -605,7 +605,8 @@ structure_item:
| _ -> mkstr(Pstr_value($2, List.rev $3)) } | _ -> mkstr(Pstr_value($2, List.rev $3)) }
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
{ mkstr(Pstr_primitive(mkrhs $2 2, {pval_type = $4; pval_prim = $6; { mkstr(Pstr_primitive(mkrhs $2 2, {pval_type = $4; pval_prim = $6;
pval_loc = symbol_rloc ()})) } pval_attributes = [];
pval_loc = symbol_rloc ()})) }
| TYPE type_declarations | TYPE type_declarations
{ mkstr(Pstr_type(List.rev $2)) } { mkstr(Pstr_type(List.rev $2)) }
| EXCEPTION UIDENT constructor_arguments | EXCEPTION UIDENT constructor_arguments
@ -676,12 +677,14 @@ signature:
| signature signature_item SEMISEMI { $2 :: $1 } | signature signature_item SEMISEMI { $2 :: $1 }
; ;
signature_item: signature_item:
VAL val_ident COLON core_type opt_with_pre_attributes VAL val_ident COLON core_type opt_with_attributes
{ mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = []; { mksig(Psig_value(mkrhs $3 3, {pval_type = $5; pval_prim = [];
pval_loc = symbol_rloc()})) } pval_attributes = $1 @ $6;
| EXTERNAL val_ident COLON core_type EQUAL primitive_declaration pval_loc = symbol_rloc()})) }
{ mksig(Psig_value(mkrhs $2 2, {pval_type = $4; pval_prim = $6; | opt_with_pre_attributes EXTERNAL val_ident COLON core_type EQUAL primitive_declaration opt_with_attributes
pval_loc = symbol_rloc()})) } { mksig(Psig_value(mkrhs $3 3, {pval_type = $5; pval_prim = $7;
pval_attributes = $1 @ $8;
pval_loc = symbol_rloc()})) }
| TYPE type_declarations | TYPE type_declarations
{ mksig(Psig_type(List.rev $2)) } { mksig(Psig_type(List.rev $2)) }
| EXCEPTION UIDENT constructor_arguments | EXCEPTION UIDENT constructor_arguments

View File

@ -137,6 +137,7 @@ and expression_desc =
and value_description = and value_description =
{ pval_type: core_type; { pval_type: core_type;
pval_prim: string list; pval_prim: string list;
pval_attributes: attribute list;
pval_loc: Location.t pval_loc: Location.t
} }

View File

@ -363,6 +363,7 @@ and value_description i ppf x =
line i ppf "value_description %a\n" fmt_location x.pval_loc; line i ppf "value_description %a\n" fmt_location x.pval_loc;
core_type (i+1) ppf x.pval_type; core_type (i+1) ppf x.pval_type;
list (i+1) string ppf x.pval_prim; list (i+1) string ppf x.pval_prim;
attributes (i+1) ppf x.pval_attributes
and string_option_underscore i ppf = and string_option_underscore i ppf =
function function