Skip to content

Commit ca652d8

Browse files
committed
Use uncurried type for @deriving(jsConverter)
This goes towards making all arities explicit.
1 parent 8ff4713 commit ca652d8

File tree

2 files changed

+31
-21
lines changed

2 files changed

+31
-21
lines changed

compiler/frontend/ast_derive_js_mapper.ml

Lines changed: 27 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,9 @@ let app1 = Ast_compatible.app1
128128

129129
let app2 = Ast_compatible.app2
130130

131-
let ( ->~ ) a b = Ast_compatible.arrow a b
131+
let ( ->~ ) a b =
132+
Ast_uncurried.uncurried_type ~loc:Location.none ~arity:1
133+
(Ast_compatible.arrow a b)
132134

133135
let raise_when_not_found_ident =
134136
Longident.Ldot (Lident Primitive_modules.util, "raiseWhenNotFound")
@@ -167,9 +169,10 @@ let init () =
167169
in
168170
let to_js_body body =
169171
Ast_comb.single_non_rec_value pat_to_js
170-
(Ast_compatible.fun_ ~arity:None
171-
(Pat.constraint_ (Pat.var pat_param) core_type)
172-
body)
172+
(Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
173+
(Ast_compatible.fun_ ~arity:None
174+
(Pat.constraint_ (Pat.var pat_param) core_type)
175+
body))
173176
in
174177
let ( +> ) a ty = Exp.constraint_ (erase_type a) ty in
175178
let ( +: ) a ty = erase_type (Exp.constraint_ a ty) in
@@ -211,12 +214,16 @@ let init () =
211214
in
212215
let from_js =
213216
Ast_comb.single_non_rec_value pat_from_js
214-
(Ast_compatible.fun_ ~arity:None (Pat.var pat_param)
215-
(if create_type then
216-
Exp.let_ Nonrecursive
217-
[Vb.mk (Pat.var pat_param) (exp_param +: new_type)]
218-
(Exp.constraint_ obj_exp core_type)
219-
else Exp.constraint_ obj_exp core_type))
217+
(Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
218+
(Ast_compatible.fun_ ~arity:(Some 1) (Pat.var pat_param)
219+
(if create_type then
220+
Exp.let_ Nonrecursive
221+
[
222+
Vb.mk (Pat.var pat_param)
223+
(exp_param +: new_type);
224+
]
225+
(Exp.constraint_ obj_exp core_type)
226+
else Exp.constraint_ obj_exp core_type)))
220227
in
221228
let rest = [to_js; from_js] in
222229
if create_type then erase_type_str :: new_type_str :: rest
@@ -253,12 +260,14 @@ let init () =
253260
app2 unsafe_index_get_exp exp_map exp_param
254261
else app1 erase_type_exp exp_param);
255262
Ast_comb.single_non_rec_value pat_from_js
256-
(Ast_compatible.fun_ ~arity:None (Pat.var pat_param)
257-
(let result =
258-
app2 unsafe_index_get_exp rev_exp_map exp_param
259-
in
260-
if create_type then raise_when_not_found result
261-
else result));
263+
(Ast_uncurried.uncurried_fun ~loc:Location.none ~arity:1
264+
(Ast_compatible.fun_ ~arity:(Some 1)
265+
(Pat.var pat_param)
266+
(let result =
267+
app2 unsafe_index_get_exp rev_exp_map exp_param
268+
in
269+
if create_type then raise_when_not_found result
270+
else result)));
262271
]
263272
in
264273
if create_type then new_type_str :: v else v
@@ -285,7 +294,8 @@ let init () =
285294
let pat_from_js = {Asttypes.loc; txt = from_js} in
286295
let to_js_type result =
287296
Ast_comb.single_non_rec_val pat_to_js
288-
(Ast_compatible.arrow core_type result)
297+
(Ast_uncurried.uncurried_type ~loc:Location.none ~arity:1
298+
(Ast_compatible.arrow core_type result))
289299
in
290300
let new_type, new_tdcl =
291301
U.new_type_of_type_declaration tdcl ("abs_" ^ name)

tests/tests/src/ast_abstract_test.mjs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -68,6 +68,10 @@ function idx(v) {
6868
eq("File \"ast_abstract_test.res\", line 29, characters 18-25", xFromJs(v), v);
6969
}
7070

71+
let x0 = "a";
72+
73+
let x1 = "b";
74+
7175
idx("a");
7276

7377
idx("b");
@@ -76,10 +80,6 @@ idx("c");
7680

7781
Mt.from_pair_suites("Ast_abstract_test", suites.contents);
7882

79-
let x0 = "a";
80-
81-
let x1 = "b";
82-
8383
export {
8484
suites,
8585
test_id,

0 commit comments

Comments
 (0)