Skip to content

Commit a8ad4c9

Browse files
committed
Move arity decoding to ast conversion.
1 parent dd373f0 commit a8ad4c9

File tree

2 files changed

+15
-11
lines changed

2 files changed

+15
-11
lines changed

compiler/ml/ast_mapper_from0.ml

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -109,7 +109,17 @@ module T = struct
109109
| Ptyp_constr
110110
(lid, [({ptyp_desc = Ptyp_arrow (lbl, t1, t2, _)} as fun_t); t_arity])
111111
when lid.txt = Lident "function$" ->
112-
let arity = Ast_uncurried.arity_from_type t_arity in
112+
let decode_arity_string arity_s =
113+
int_of_string
114+
((String.sub [@doesNotRaise]) arity_s 9 (String.length arity_s - 9))
115+
in
116+
let arity_from_type (typ : Parsetree.core_type) =
117+
match typ.ptyp_desc with
118+
| Ptyp_variant ([Rtag ({txt}, _, _, _)], _, _) ->
119+
decode_arity_string txt
120+
| _ -> assert false
121+
in
122+
let arity = arity_from_type t_arity in
113123
let fun_t =
114124
{fun_t with ptyp_desc = Ptyp_arrow (lbl, t1, t2, Some arity)}
115125
in

compiler/ml/ast_uncurried.ml

Lines changed: 4 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,12 @@
11
(* Uncurried AST *)
22

33
let encode_arity_string arity = "Has_arity" ^ string_of_int arity
4-
let decode_arity_string arity_s =
5-
int_of_string
6-
((String.sub [@doesNotRaise]) arity_s 9 (String.length arity_s - 9))
74

85
let arity_type ~loc arity =
96
Ast_helper.Typ.variant ~loc
107
[Rtag ({txt = encode_arity_string arity; loc}, [], true, [])]
118
Closed None
129

13-
let arity_from_type (typ : Parsetree.core_type) =
14-
match typ.ptyp_desc with
15-
| Ptyp_variant ([Rtag ({txt}, _, _, _)], _, _) -> decode_arity_string txt
16-
| _ -> assert false
17-
1810
let uncurried_type ~loc ~arity (t_arg : Parsetree.core_type) =
1911
let t_arg =
2012
match t_arg.ptyp_desc with
@@ -52,8 +44,10 @@ let core_type_is_uncurried_fun (typ : Parsetree.core_type) =
5244

5345
let core_type_extract_uncurried_fun (typ : Parsetree.core_type) =
5446
match typ.ptyp_desc with
55-
| Ptyp_constr ({txt = Lident "function$"}, [t_arg; t_arity]) ->
56-
(arity_from_type t_arity, t_arg)
47+
| Ptyp_constr
48+
( {txt = Lident "function$"},
49+
[({ptyp_desc = Ptyp_arrow (_, _, _, Some arity)} as t_arg); _] ) ->
50+
(arity, t_arg)
5751
| _ -> assert false
5852

5953
let type_is_uncurried_fun = Ast_uncurried_utils.type_is_uncurried_fun

0 commit comments

Comments
 (0)