summaryrefslogtreecommitdiffstats
path: root/parsing
diff options
context:
space:
mode:
Diffstat (limited to 'parsing')
-rw-r--r--parsing/ast_helper.ml4
-rw-r--r--parsing/ast_helper.mli4
-rw-r--r--parsing/ast_mapper.ml9
-rw-r--r--parsing/parser.mly16
-rw-r--r--parsing/parsetree.mli18
-rw-r--r--parsing/pprintast.ml11
-rw-r--r--parsing/pprintast.mli2
-rw-r--r--parsing/printast.ml8
8 files changed, 47 insertions, 25 deletions
diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml
index 47c7bd338..f53cb2928 100644
--- a/parsing/ast_helper.ml
+++ b/parsing/ast_helper.ml
@@ -364,7 +364,7 @@ module Type = struct
ptype_loc = loc;
}
- let constructor ?(loc = !default_loc) ?(attrs = []) ?(args = []) ?res name =
+ let constructor ?(loc = !default_loc) ?(attrs = []) ?(args = Pcstr_tuple []) ?res name =
{
pcd_name = name;
pcd_args = args;
@@ -402,7 +402,7 @@ module Te = struct
pext_attributes = attrs;
}
- let decl ?(loc = !default_loc) ?(attrs = []) ?(args = []) ?res name =
+ let decl ?(loc = !default_loc) ?(attrs = []) ?(args = Pcstr_tuple []) ?res name =
{
pext_name = name;
pext_kind = Pext_decl(args, res);
diff --git a/parsing/ast_helper.mli b/parsing/ast_helper.mli
index b9b04f822..847d428f6 100644
--- a/parsing/ast_helper.mli
+++ b/parsing/ast_helper.mli
@@ -154,7 +154,7 @@ module Type:
sig
val mk: ?loc:loc -> ?attrs:attrs -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration
- val constructor: ?loc:loc -> ?attrs:attrs -> ?args:core_type list -> ?res:core_type -> str -> constructor_declaration
+ val constructor: ?loc:loc -> ?attrs:attrs -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration
val field: ?loc:loc -> ?attrs:attrs -> ?mut:mutable_flag -> str -> core_type -> label_declaration
end
@@ -165,7 +165,7 @@ module Te:
val constructor: ?loc:loc -> ?attrs:attrs -> str -> extension_constructor_kind -> extension_constructor
- val decl: ?loc:loc -> ?attrs:attrs -> ?args:core_type list -> ?res:core_type -> str -> extension_constructor
+ val decl: ?loc:loc -> ?attrs:attrs -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor
val rebind: ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor
end
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index 669d01449..aa9fdbfca 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -137,6 +137,11 @@ module T = struct
| Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l)
| Ptype_open -> Ptype_open
+ let map_constructor_arguments sub = function
+ | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l)
+ | Pcstr_record l ->
+ Pcstr_record (List.map (sub.label_declaration sub) l)
+
let map_type_extension sub
{ptyext_path; ptyext_params;
ptyext_constructors;
@@ -151,7 +156,7 @@ module T = struct
let map_extension_constructor_kind sub = function
Pext_decl(ctl, cto) ->
- Pext_decl(List.map (sub.typ sub) ctl, map_opt (sub.typ sub) cto)
+ Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto)
| Pext_rebind li ->
Pext_rebind (map_loc sub li)
@@ -573,7 +578,7 @@ let default_mapper =
(fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} ->
Type.constructor
(map_loc this pcd_name)
- ~args:(List.map (this.typ this) pcd_args)
+ ~args:(T.map_constructor_arguments this pcd_args)
?res:(map_opt (this.typ this) pcd_res)
~loc:(this.location this pcd_loc)
~attrs:(this.attributes this pcd_attributes)
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 4e2053be3..26bbdc1e9 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -1658,16 +1658,18 @@ sig_exception_declaration:
}
;
generalized_constructor_arguments:
- /*empty*/ { ([],None) }
- | OF core_type_list { (List.rev $2,None) }
- | COLON core_type_list MINUSGREATER simple_core_type
- { (List.rev $2,Some $4) }
+ /*empty*/ { (Pcstr_tuple [],None) }
+ | OF constructor_arguments { ($2,None) }
+ | COLON constructor_arguments MINUSGREATER simple_core_type
+ { ($2,Some $4) }
| COLON simple_core_type
- { ([],Some $2) }
+ { (Pcstr_tuple [],Some $2) }
;
-
-
+constructor_arguments:
+ | core_type_list { Pcstr_tuple (List.rev $1) }
+ | LBRACE label_declarations RBRACE { Pcstr_record (List.rev $2) }
+;
label_declarations:
label_declaration { [$1] }
| label_declarations SEMI label_declaration { $3 :: $1 }
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index a66317f47..d287b9eee 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -398,15 +398,23 @@ and label_declaration =
and constructor_declaration =
{
pcd_name: string loc;
- pcd_args: core_type list;
+ pcd_args: constructor_arguments;
pcd_res: core_type option;
pcd_loc: Location.t;
pcd_attributes: attributes; (* C [@id1] [@id2] of ... *)
}
+
+and constructor_arguments =
+ | Pcstr_tuple of core_type list
+ | Pcstr_record of label_declaration list
+
(*
- | C of T1 * ... * Tn (res = None)
- | C: T0 (args = [], res = Some T0)
- | C: T1 * ... * Tn -> T0 (res = Some T0)
+ | C of T1 * ... * Tn (res = None, args = Pcstr_tuple [])
+ | C: T0 (res = Some T0, args = [])
+ | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple)
+ | C of {...} (res = None, args = Pcstr_record)
+ | C: {...} -> T0 (res = Some T0, args = Pcstr_record)
+ | C of {...} as t (res = None, args = Pcstr_record)
*)
and type_extension =
@@ -430,7 +438,7 @@ and extension_constructor =
}
and extension_constructor_kind =
- Pext_decl of core_type list * core_type option
+ Pext_decl of constructor_arguments * core_type option
(*
| C of T1 * ... * Tn ([T1; ...; Tn], None)
| C: T0 ([], Some T0)
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 327d67041..5f59dacac 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -1313,18 +1313,21 @@ class printer ()= object(self:'self)
pp f "%s%a%a" name
self#attributes attrs
(fun f -> function
- | [] -> ()
- | l ->
+ | 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
(fun f -> function
- | [] -> self#core_type1 f r
- | l -> pp f "%a@;->@;%a"
+ | Pcstr_tuple [] -> self#core_type1 f r
+ | Pcstr_tuple l -> pp f "%a@;->@;%a"
(self#list self#core_type1 ~sep:"*@;") l
self#core_type1 r
+ | Pcstr_record l ->
+ pp f "%a@;->@;%a" (self#record_declaration) l self#core_type1 r
)
args
diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli
index 22e21adc6..42a340915 100644
--- a/parsing/pprintast.mli
+++ b/parsing/pprintast.mli
@@ -37,7 +37,7 @@ class printer :
Format.formatter -> Parsetree.class_type_declaration list -> unit
method constant : Format.formatter -> Asttypes.constant -> unit
method constant_string : Format.formatter -> string -> unit
- method constructor_declaration : Format.formatter -> (string * Parsetree.core_type list * Parsetree.core_type option * Parsetree.attributes) -> unit
+ method constructor_declaration : Format.formatter -> (string * Parsetree.constructor_arguments * Parsetree.core_type option * Parsetree.attributes) -> unit
method core_type : Format.formatter -> Parsetree.core_type -> unit
method core_type1 : Format.formatter -> Parsetree.core_type -> unit
method direction_flag :
diff --git a/parsing/printast.ml b/parsing/printast.ml
index f0472bcdb..2bf9d8f3e 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -439,7 +439,7 @@ and extension_constructor_kind i ppf x =
match x with
Pext_decl(a, r) ->
line i ppf "Pext_decl\n";
- list (i+1) core_type ppf a;
+ constructor_arguments (i+1) ppf a;
option (i+1) core_type ppf r;
| Pext_rebind li ->
line i ppf "Pext_rebind\n";
@@ -810,9 +810,13 @@ and constructor_decl i ppf
line i ppf "%a\n" fmt_location pcd_loc;
line (i+1) ppf "%a\n" fmt_string_loc pcd_name;
attributes i ppf pcd_attributes;
- list (i+1) core_type ppf pcd_args;
+ constructor_arguments (i+1) ppf pcd_args;
option (i+1) core_type ppf pcd_res
+and constructor_arguments i ppf = function
+ | Pcstr_tuple l -> list i core_type ppf l
+ | Pcstr_record l -> list i label_decl ppf l
+
and label_decl i ppf {pld_name; pld_mutable; pld_type; pld_loc; pld_attributes}=
line i ppf "%a\n" fmt_location pld_loc;
attributes i ppf pld_attributes;
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-27 18:57:25 +0000