Skip to content

Commit aa61788

Browse files
committed
Clean up Ast_core_type using the arg type.
1 parent 5429398 commit aa61788

File tree

3 files changed

+20
-43
lines changed

3 files changed

+20
-43
lines changed

compiler/frontend/ast_core_type.ml

Lines changed: 7 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -131,35 +131,22 @@ let get_curry_arity (ty : t) =
131131

132132
let is_arity_one ty = get_curry_arity ty = 1
133133

134-
type param_type = {
135-
label: Asttypes.arg_label;
136-
ty: Parsetree.core_type;
137-
attr: Parsetree.attributes;
138-
loc: loc;
139-
}
140-
141-
let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
134+
let mk_fn_type ~loc (new_arg_types_ty : Parsetree.arg list) (result : t) : t =
142135
let t =
143-
Ext_list.fold_right new_arg_types_ty result
144-
(fun {label; ty; attr; loc} acc ->
145-
Ast_helper.Typ.arrow ~loc ~attrs:attr ~arity:None
146-
{attrs = []; lbl = label; typ = ty}
147-
acc)
136+
Ext_list.fold_right new_arg_types_ty result (fun {lbl; typ; attrs} acc ->
137+
Ast_helper.Typ.arrow ~loc ~attrs ~arity:None {attrs = []; lbl; typ} acc)
148138
in
149139
match t.ptyp_desc with
150140
| Ptyp_arrow arr ->
151141
let arity = List.length new_arg_types_ty in
152142
{t with ptyp_desc = Ptyp_arrow {arr with arity = Some arity}}
153143
| _ -> t
154144

155-
let list_of_arrow (ty : t) : t * param_type list =
145+
let list_of_arrow (ty : t) : t * Parsetree.arg list =
156146
let rec aux (ty : t) acc =
157147
match ty.ptyp_desc with
158148
| Ptyp_arrow {arg; ret; arity} when arity = None || acc = [] ->
159-
aux ret
160-
(({label = arg.lbl; ty = arg.typ; attr = arg.attrs; loc = ty.ptyp_loc}
161-
: param_type)
162-
:: acc)
149+
aux ret (arg :: acc)
163150
| Ptyp_poly (_, ty) ->
164151
(* should not happen? *)
165152
Bs_syntaxerr.err ty.ptyp_loc Unhandled_poly_type
@@ -169,6 +156,6 @@ let list_of_arrow (ty : t) : t * param_type list =
169156

170157
let add_last_obj (ty : t) (obj : t) =
171158
let result, params = list_of_arrow ty in
172-
mk_fn_type
173-
(params @ [{label = Nolabel; ty = obj; attr = []; loc = obj.ptyp_loc}])
159+
mk_fn_type ~loc:obj.ptyp_loc
160+
(params @ [{lbl = Nolabel; typ = obj; attrs = []}])
174161
result

compiler/frontend/ast_core_type.mli

Lines changed: 2 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -47,16 +47,9 @@ val get_uncurry_arity : t -> int option
4747
None -- means not a function
4848
*)
4949

50-
type param_type = {
51-
label: Asttypes.arg_label;
52-
ty: t;
53-
attr: Parsetree.attributes;
54-
loc: Location.t;
55-
}
50+
val mk_fn_type : loc:Location.t -> Parsetree.arg list -> t -> t
5651

57-
val mk_fn_type : param_type list -> t -> t
58-
59-
val list_of_arrow : t -> t * param_type list
52+
val list_of_arrow : t -> t * Parsetree.arg list
6053
(** fails when Ptyp_poly *)
6154

6255
val add_last_obj : t -> t -> t

compiler/frontend/ast_external_process.ml

Lines changed: 11 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -408,8 +408,7 @@ type response = {
408408
}
409409

410410
let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
411-
(arg_types_ty : Ast_core_type.param_type list)
412-
(result_type : Ast_core_type.t) :
411+
(arg_types_ty : Parsetree.arg list) (result_type : Ast_core_type.t) :
413412
int * Parsetree.core_type * External_ffi_types.t =
414413
match st with
415414
| {
@@ -440,11 +439,10 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
440439
Ext_list.fold_right arg_types_ty ([], [], [])
441440
(fun
442441
param_type
443-
(arg_labels, (arg_types : Ast_core_type.param_type list), result_types)
442+
(arg_labels, (arg_types : Parsetree.arg list), result_types)
444443
->
445-
let arg_label = param_type.label in
446-
let loc = param_type.loc in
447-
let ty = param_type.ty in
444+
let arg_label = param_type.lbl in
445+
let ty = param_type.typ in
448446
let new_arg_label, new_arg_types, output_tys =
449447
match arg_label with
450448
| Nolabel -> (
@@ -459,7 +457,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
459457
| Labelled {txt = label} -> (
460458
let field_name =
461459
match
462-
Ast_attributes.iter_process_bs_string_as param_type.attr
460+
Ast_attributes.iter_process_bs_string_as param_type.attrs
463461
with
464462
| Some alias -> alias
465463
| None -> label
@@ -518,7 +516,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
518516
| Optional {txt = label} -> (
519517
let field_name =
520518
match
521-
Ast_attributes.iter_process_bs_string_as param_type.attr
519+
Ast_attributes.iter_process_bs_string_as param_type.attrs
522520
with
523521
| Some alias -> alias
524522
| None -> label
@@ -594,7 +592,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
594592
in
595593

596594
( List.length new_arg_types_ty,
597-
Ast_core_type.mk_fn_type new_arg_types_ty result,
595+
Ast_core_type.mk_fn_type ~loc new_arg_types_ty result,
598596
External_ffi_types.ffi_obj_create arg_kinds )
599597
| _ -> Location.raise_errorf ~loc "Attribute found that conflicts with %@obj"
600598

@@ -942,11 +940,10 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
942940
let splice = external_desc.splice in
943941
let arg_type_specs, new_arg_types_ty, arg_type_specs_length =
944942
Ext_list.fold_right arg_types_ty
945-
(([], [], 0)
946-
: External_arg_spec.params * Ast_core_type.param_type list * int)
943+
(([], [], 0) : External_arg_spec.params * Parsetree.arg list * int)
947944
(fun param_type (arg_type_specs, arg_types, i) ->
948-
let arg_label = param_type.label in
949-
let ty = param_type.ty in
945+
let arg_label = param_type.lbl in
946+
let ty = param_type.typ in
950947
(if i = 0 && splice then
951948
match arg_label with
952949
| Optional _ ->
@@ -1008,7 +1005,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type)
10081005
let return_wrapper =
10091006
check_return_wrapper loc external_desc.return_wrapper result_type
10101007
in
1011-
let fn_type = Ast_core_type.mk_fn_type new_arg_types_ty result_type in
1008+
let fn_type = Ast_core_type.mk_fn_type ~loc new_arg_types_ty result_type in
10121009
( build_uncurried_type ~arity:(List.length new_arg_types_ty) fn_type,
10131010
External_ffi_types.ffi_bs arg_type_specs return_wrapper ffi,
10141011
unused_attrs,

0 commit comments

Comments
 (0)