Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

#6387: also allow attributes on methods in object types (< m [@foo] :…

… int; ..>).

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14741 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
commit 0b3423ef2cd3a7a181ae0d96ec803c347ed6a3bf 1 parent 470131d
@alainfrisch alainfrisch authored
View
5 parsing/ast_helper.mli
@@ -42,8 +42,9 @@ module Typ :
-> core_type
val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
- val object_: ?loc:loc -> ?attrs:attrs -> (string * core_type) list
- -> closed_flag -> core_type
+ val object_: ?loc:loc -> ?attrs:attrs ->
+ (string * attributes * core_type) list -> closed_flag ->
+ core_type
val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
View
3  parsing/ast_mapper.ml
@@ -97,7 +97,8 @@ module T = struct
| Ptyp_constr (lid, tl) ->
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
| Ptyp_object (l, o) ->
- object_ ~loc ~attrs (List.map (map_snd (sub.typ sub)) l) o
+ let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in
+ object_ ~loc ~attrs (List.map f l) o
| Ptyp_class (lid, tl) ->
class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
| Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
View
5 parsing/parser.mly
@@ -237,7 +237,8 @@ let varify_constructors var_names t =
| Ptyp_constr(longident, lst) ->
Ptyp_constr(longident, List.map loop lst)
| Ptyp_object (lst, o) ->
- Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+ Ptyp_object
+ (List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o)
| Ptyp_class (longident, lst) ->
Ptyp_class (longident, List.map loop lst)
| Ptyp_alias(core_type, string) ->
@@ -1894,7 +1895,7 @@ meth_list:
| DOTDOT { [], Open }
;
field:
- label COLON poly_type /* ok */ { ($1, $3) }
+ label attributes COLON poly_type { ($1, $2, $4) }
;
label:
LIDENT { $1 }
View
2  parsing/parsetree.mli
@@ -66,7 +66,7 @@ and core_type_desc =
T tconstr
(T1, ..., Tn) tconstr
*)
- | Ptyp_object of (string * core_type) list * closed_flag
+ | Ptyp_object of (string * attributes * core_type) list * closed_flag
(* < l1:T1; ...; ln:Tn > (flag = Closed)
< l1:T1; ...; ln:Tn; .. > (flag = Open)
*)
View
2  parsing/pprintast.ml
@@ -307,7 +307,7 @@ class printer ()= object(self:'self)
pp f ">@ %a"
(self#list self#string_quot) xs) low
| Ptyp_object (l, o) ->
- let core_field_type f (s, ct) =
+ let core_field_type f (s, _attrs, ct) =
pp f "@[<hov2>%s@ :%a@ @]" s self#core_type ct
in
let field_var f = function
View
5 parsing/printast.ml
@@ -157,8 +157,9 @@ let rec core_type i ppf x =
line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
let i = i + 1 in
List.iter
- (fun (s, t) ->
- line i ppf "method %s" s;
+ (fun (s, attrs, t) ->
+ line i ppf "method %s\n" s;
+ attributes i ppf attrs;
core_type (i + 1) ppf t
)
l
View
2  tools/depend.ml
@@ -43,7 +43,7 @@ let rec add_type bv ty =
| Ptyp_arrow(_, t1, t2) -> add_type bv t1; add_type bv t2
| Ptyp_tuple tl -> List.iter (add_type bv) tl
| Ptyp_constr(c, tl) -> add bv c; List.iter (add_type bv) tl
- | Ptyp_object (fl, _) -> List.iter (fun (_, t) -> add_type bv t) fl
+ | Ptyp_object (fl, _) -> List.iter (fun (_, _, t) -> add_type bv t) fl
| Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
| Ptyp_alias(t, s) -> add_type bv t
| Ptyp_variant(fl, _, _) ->
View
2  tools/tast_iter.ml
@@ -303,7 +303,7 @@ let core_type sub ct =
| Ttyp_constr (_path, _, list) ->
List.iter (sub # core_type) list
| Ttyp_object (list, _o) ->
- List.iter (fun (_, t) -> sub # core_type t) list
+ List.iter (fun (_, _, t) -> sub # core_type t) list
| Ttyp_class (_path, _, list) ->
List.iter (sub # core_type) list
| Ttyp_alias (ct, _s) ->
View
3  tools/untypeast.ml
@@ -558,7 +558,8 @@ and untype_core_type ct =
Ptyp_constr (lid,
List.map untype_core_type list)
| Ttyp_object (list, o) ->
- Ptyp_object (List.map (fun (s, t) -> (s, untype_core_type t)) list, o)
+ Ptyp_object
+ (List.map (fun (s, a, t) -> (s, a, untype_core_type t)) list, o)
| Ttyp_class (_path, lid, list) ->
Ptyp_class (lid, List.map untype_core_type list)
| Ttyp_alias (ct, s) ->
View
5 typing/printtyped.ml
@@ -171,8 +171,9 @@ let rec core_type i ppf x =
line i ppf "Ptyp_object %a\n" fmt_closed_flag c;
let i = i + 1 in
List.iter
- (fun (s, t) ->
- line i ppf "method %s" s;
+ (fun (s, attrs, t) ->
+ line i ppf "method %s\n" s;
+ attributes i ppf attrs;
core_type (i + 1) ppf t
)
l
View
2  typing/typedtree.ml
@@ -348,7 +348,7 @@ and core_type_desc =
| Ttyp_arrow of label * core_type * core_type
| Ttyp_tuple of core_type list
| Ttyp_constr of Path.t * Longident.t loc * core_type list
- | Ttyp_object of (string * core_type) list * closed_flag
+ | Ttyp_object of (string * attributes * core_type) list * closed_flag
| Ttyp_class of Path.t * Longident.t loc * core_type list
| Ttyp_alias of core_type * string
| Ttyp_variant of row_field list * closed_flag * label list option
View
2  typing/typedtree.mli
@@ -347,7 +347,7 @@ and core_type_desc =
| Ttyp_arrow of label * core_type * core_type
| Ttyp_tuple of core_type list
| Ttyp_constr of Path.t * Longident.t loc * core_type list
- | Ttyp_object of (string * core_type) list * closed_flag
+ | Ttyp_object of (string * attributes * core_type) list * closed_flag
| Ttyp_class of Path.t * Longident.t loc * core_type list
| Ttyp_alias of core_type * string
| Ttyp_variant of row_field list * closed_flag * label list option
View
2  typing/typedtreeIter.ml
@@ -536,7 +536,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
| Ttyp_constr (path, _, list) ->
List.iter iter_core_type list
| Ttyp_object (list, o) ->
- List.iter (fun (_, t) -> iter_core_type t) list
+ List.iter (fun (_, _, t) -> iter_core_type t) list
| Ttyp_class (path, _, list) ->
List.iter iter_core_type list
| Ttyp_alias (ct, s) ->
View
3  typing/typedtreeMap.ml
@@ -595,7 +595,8 @@ module MakeMap(Map : MapArgument) = struct
| Ttyp_constr (path, lid, list) ->
Ttyp_constr (path, lid, List.map map_core_type list)
| Ttyp_object (list, o) ->
- Ttyp_object (List.map (fun (s, t) -> (s, map_core_type t)) list, o)
+ Ttyp_object
+ (List.map (fun (s, a, t) -> (s, a, map_core_type t)) list, o)
| Ttyp_class (path, lid, list) ->
Ttyp_class (path, lid, List.map map_core_type list)
| Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
View
4 typing/typetexp.ml
@@ -377,7 +377,7 @@ let rec transl_type env policy styp =
ctyp (Ttyp_constr (path, lid, args)) constr
| Ptyp_object (fields, o) ->
let fields =
- List.map (fun (s, t) -> (s, transl_poly_type env policy t))
+ List.map (fun (s, a, t) -> (s, a, transl_poly_type env policy t))
fields
in
let ty = newobj (transl_fields loc env policy [] o fields) in
@@ -659,7 +659,7 @@ and transl_fields loc env policy seen o =
| Open, Univars -> new_pre_univar ()
| Open, _ -> newvar ()
end
- | (s, ty1) :: l ->
+ | (s, _attrs, ty1) :: l ->
if List.mem s seen then raise (Error (loc, env, Repeated_method_label s));
let ty2 = transl_fields loc env policy (s :: seen) o l in
newty (Tfield (s, Fpresent, ty1.ctyp_type, ty2))
Please sign in to comment.
Something went wrong with that request. Please try again.