summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--parsing/ast_helper.mli5
-rw-r--r--parsing/ast_mapper.ml3
-rw-r--r--parsing/parser.mly5
-rw-r--r--parsing/parsetree.mli2
-rw-r--r--parsing/pprintast.ml2
-rw-r--r--parsing/printast.ml5
-rw-r--r--tools/depend.ml2
-rw-r--r--tools/tast_iter.ml2
-rw-r--r--tools/untypeast.ml3
-rw-r--r--typing/printtyped.ml5
-rw-r--r--typing/typedtree.ml2
-rw-r--r--typing/typedtree.mli2
-rw-r--r--typing/typedtreeIter.ml2
-rw-r--r--typing/typedtreeMap.ml3
-rw-r--r--typing/typetexp.ml4
15 files changed, 27 insertions, 20 deletions
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index 5d0d6afa7a..a899091501 100644
--- a/parsing/ast_helper.mli
+++ b/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
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index b09740bd67..e6c3738488 100644
--- a/parsing/ast_mapper.ml
+++ b/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
diff --git a/parsing/parser.mly b/parsing/parser.mly
index a96d5896c2..c53249f693 100644
--- a/parsing/parser.mly
+++ b/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 }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index ae388e92b1..4f8c046034 100644
--- a/parsing/parsetree.mli
+++ b/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)
*)
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index cdf605b3dc..a774336eec 100644
--- a/parsing/pprintast.ml
+++ b/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
diff --git a/parsing/printast.ml b/parsing/printast.ml
index a6883e75c0..c9c2453d3e 100644
--- a/parsing/printast.ml
+++ b/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
diff --git a/tools/depend.ml b/tools/depend.ml
index e267e4f1da..f009b4a11b 100644
--- a/tools/depend.ml
+++ b/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, _, _) ->
diff --git a/tools/tast_iter.ml b/tools/tast_iter.ml
index a7723c88dc..b28731613a 100644
--- a/tools/tast_iter.ml
+++ b/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) ->
diff --git a/tools/untypeast.ml b/tools/untypeast.ml
index e8e392f681..c887c089e9 100644
--- a/tools/untypeast.ml
+++ b/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) ->
diff --git a/typing/printtyped.ml b/typing/printtyped.ml
index dffe0bb86f..361116378b 100644
--- a/typing/printtyped.ml
+++ b/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
diff --git a/typing/typedtree.ml b/typing/typedtree.ml
index 75937d5e36..49ce742199 100644
--- a/typing/typedtree.ml
+++ b/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
diff --git a/typing/typedtree.mli b/typing/typedtree.mli
index 97f54f966d..7c7d4a88f4 100644
--- a/typing/typedtree.mli
+++ b/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
diff --git a/typing/typedtreeIter.ml b/typing/typedtreeIter.ml
index 99a401f3b2..29827513cb 100644
--- a/typing/typedtreeIter.ml
+++ b/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) ->
diff --git a/typing/typedtreeMap.ml b/typing/typedtreeMap.ml
index b9ab3f0e91..262fe299e6 100644
--- a/typing/typedtreeMap.ml
+++ b/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)
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 979686574c..993c93ecba 100644
--- a/typing/typetexp.ml
+++ b/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))
View Lorry Controller Status