Skip to content

Commit 61360f5

Browse files
bobzhangbobzhang
committed
add tests and improve the API for bindings
1 parent 174494d commit 61360f5

15 files changed

+320
-117
lines changed

‎jscomp/bin/whole_compiler.ml

+45-14
Original file line numberDiff line numberDiff line change
@@ -65814,6 +65814,29 @@ let rec is_eta_conversion
6581465814
| [], [],[] -> true
6581565815
| _, _, _ -> false
6581665816

65817+
exception Not_simple_form
65818+
65819+
(** Simplfiy such behavior
65820+
{[
65821+
(apply
65822+
(function prim/1024 prim/1023 prim/1022
65823+
([js] (js_fn_make_2 prim/1024) prim/1023 prim/1022)) .. )
65824+
]}
65825+
*)
65826+
let rec is_eta_conversion_exn
65827+
params inner_args outer_args =
65828+
match params, inner_args, outer_args with
65829+
| x::xs, Lvar y::ys, r::rest
65830+
when Ident.same x y ->
65831+
r :: is_eta_conversion_exn xs ys rest
65832+
| x::xs,
65833+
(Lprim ({primitive = Pjs_fn_make _;
65834+
args = [Lvar y] } as p ) ::ys),
65835+
r :: rest when Ident.same x y ->
65836+
Lprim ({p with args = [ r]}) ::
65837+
is_eta_conversion_exn xs ys rest
65838+
| [], [], [] -> []
65839+
| _, _, _ -> raise_notrace Not_simple_form
6581765840

6581865841

6581965842
let var id : t = Lvar id
@@ -65823,14 +65846,22 @@ let const ct : t = Lconst ct
6582365846
let apply fn args loc status : t =
6582465847
match fn with
6582565848
| Lfunction {kind ; params;
65826-
body =Lprim ({primitive; args = inner_args}as primitive_call) } when
65827-
is_eta_conversion params inner_args args
65828-
->
65829-
Lprim { primitive_call with args ; loc = loc }
65830-
| Lfunction {kind; params ;
65831-
body = Lapply {fn = new_fn ; args = inner_args; status }
65832-
} when is_eta_conversion params inner_args args ->
65833-
Lapply {fn = new_fn ; args ; loc = loc; status }
65849+
body =Lprim ({primitive; args = inner_args}as primitive_call) }
65850+
65851+
->
65852+
begin match is_eta_conversion_exn params inner_args args with
65853+
| args
65854+
->
65855+
Lprim { primitive_call with args ; loc = loc }
65856+
| exception _ ->
65857+
Lapply { fn; args; loc ;
65858+
status }
65859+
end
65860+
(* | Lfunction {kind; params ;
65861+
body = Lapply {fn = new_fn ; args = inner_args; status }
65862+
} when is_eta_conversion params inner_args args ->
65863+
Lapply {fn = new_fn ; args ; loc = loc; status }
65864+
*)
6583465865
(* same as previous App status*)
6583565866
| _ ->
6583665867
Lapply { fn; args; loc ;
@@ -66177,7 +66208,7 @@ let rec transform_uncurried_arg_type loc (arg_types : Ast_ffi_types.arg_kind lis
6617766208
| _::_, []
6617866209
| [], _::_ as ok -> ok
6617966210

66180-
66211+
6618166212
(** drop Lseq (List! ) etc *)
6618266213
let rec drop_global_marker (lam : t) =
6618366214
match lam with
@@ -66579,11 +66610,11 @@ let convert exports lam : _ * _ =
6657966610
let f = aux f in
6658066611
let x = aux x in
6658166612
begin match f with
66582-
| Lapply{fn ; args }
66583-
->
66584-
apply fn (args @ [x]) outer_loc App_na
66585-
| _ -> apply f [x] outer_loc App_na
66586-
end
66613+
| Lapply{fn ; args }
66614+
->
66615+
apply fn (args @ [x]) outer_loc App_na
66616+
| _ -> apply f [x] outer_loc App_na
66617+
end
6658766618
| Lprim(Pdirapply, _, _) -> assert false
6658866619
| Lprim (primitive,args, loc)
6658966620
->

‎jscomp/core/lam.ml

+45-14
Original file line numberDiff line numberDiff line change
@@ -807,6 +807,29 @@ let rec is_eta_conversion
807807
| [], [],[] -> true
808808
| _, _, _ -> false
809809

810+
exception Not_simple_form
811+
812+
(** Simplfiy such behavior
813+
{[
814+
(apply
815+
(function prim/1024 prim/1023 prim/1022
816+
([js] (js_fn_make_2 prim/1024) prim/1023 prim/1022)) .. )
817+
]}
818+
*)
819+
let rec is_eta_conversion_exn
820+
params inner_args outer_args =
821+
match params, inner_args, outer_args with
822+
| x::xs, Lvar y::ys, r::rest
823+
when Ident.same x y ->
824+
r :: is_eta_conversion_exn xs ys rest
825+
| x::xs,
826+
(Lprim ({primitive = Pjs_fn_make _;
827+
args = [Lvar y] } as p ) ::ys),
828+
r :: rest when Ident.same x y ->
829+
Lprim ({p with args = [ r]}) ::
830+
is_eta_conversion_exn xs ys rest
831+
| [], [], [] -> []
832+
| _, _, _ -> raise_notrace Not_simple_form
810833

811834

812835
let var id : t = Lvar id
@@ -816,14 +839,22 @@ let const ct : t = Lconst ct
816839
let apply fn args loc status : t =
817840
match fn with
818841
| Lfunction {kind ; params;
819-
body =Lprim ({primitive; args = inner_args}as primitive_call) } when
820-
is_eta_conversion params inner_args args
821-
->
822-
Lprim { primitive_call with args ; loc = loc }
823-
| Lfunction {kind; params ;
824-
body = Lapply {fn = new_fn ; args = inner_args; status }
825-
} when is_eta_conversion params inner_args args ->
826-
Lapply {fn = new_fn ; args ; loc = loc; status }
842+
body =Lprim ({primitive; args = inner_args}as primitive_call) }
843+
844+
->
845+
begin match is_eta_conversion_exn params inner_args args with
846+
| args
847+
->
848+
Lprim { primitive_call with args ; loc = loc }
849+
| exception _ ->
850+
Lapply { fn; args; loc ;
851+
status }
852+
end
853+
(* | Lfunction {kind; params ;
854+
body = Lapply {fn = new_fn ; args = inner_args; status }
855+
} when is_eta_conversion params inner_args args ->
856+
Lapply {fn = new_fn ; args ; loc = loc; status }
857+
*)
827858
(* same as previous App status*)
828859
| _ ->
829860
Lapply { fn; args; loc ;
@@ -1170,7 +1201,7 @@ let rec transform_uncurried_arg_type loc (arg_types : Ast_ffi_types.arg_kind lis
11701201
| _::_, []
11711202
| [], _::_ as ok -> ok
11721203

1173-
1204+
11741205
(** drop Lseq (List! ) etc *)
11751206
let rec drop_global_marker (lam : t) =
11761207
match lam with
@@ -1572,11 +1603,11 @@ let convert exports lam : _ * _ =
15721603
let f = aux f in
15731604
let x = aux x in
15741605
begin match f with
1575-
| Lapply{fn ; args }
1576-
->
1577-
apply fn (args @ [x]) outer_loc App_na
1578-
| _ -> apply f [x] outer_loc App_na
1579-
end
1606+
| Lapply{fn ; args }
1607+
->
1608+
apply fn (args @ [x]) outer_loc App_na
1609+
| _ -> apply f [x] outer_loc App_na
1610+
end
15801611
| Lprim(Pdirapply, _, _) -> assert false
15811612
| Lprim (primitive,args, loc)
15821613
->

‎jscomp/core/lam_compile_group.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -376,7 +376,7 @@ let lambda_as_module
376376
begin
377377
Js_config.set_current_file filename ;
378378
#if BS_DEBUG then
379-
Js_config.set_debug_file "bs_auto_uncurry.ml";
379+
Js_config.set_debug_file "bs_array_test.ml";
380380
#end
381381
let lambda_output = compile ~filename output_prefix env sigs lam in
382382
let (//) = Filename.concat in

‎jscomp/others/js_array.ml

+20-20
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ type 'a array_iter = 'a array_like
3030
*)
3131

3232
external from : 'a array_like -> 'b array = "Array.from" [@@bs.val] (** ES2015 *)
33-
external fromMap : 'a array_like -> ('a -> 'b [@bs]) -> 'b array = "Array.from" [@@bs.val] (** ES2015 *)
33+
external fromMap : 'a array_like -> ('a -> 'b [@bs.uncurry]) -> 'b array = "Array.from" [@@bs.val] (** ES2015 *)
3434
external isArray : 'a -> Js.boolean = "Array.isArray" [@@bs.val] (** ES2015 *)
3535
(* Array.of: seems pointless unless you can bind *) (** ES2015 *)
3636

@@ -57,7 +57,7 @@ external reverseInPlace : 'this = "reverse" [@@bs.send.pipe: 'a t as 'this]
5757
external shift : 'a Js.undefined = "" [@@bs.send.pipe: 'a t as 'this]
5858

5959
external sortInPlace : 'this = "sort" [@@bs.send.pipe: 'a t as 'this]
60-
external sortInPlaceWith : ('a -> 'a -> int [@bs]) -> 'this = "sort" [@@bs.send.pipe: 'a t as 'this]
60+
external sortInPlaceWith : ('a -> 'a -> int [@bs.uncurry]) -> 'this = "sort" [@@bs.send.pipe: 'a t as 'this]
6161

6262
external spliceInPlace : pos:int -> remove:int -> add:('a array) -> 'this = "splice" [@@bs.send.pipe: 'a t as 'this] [@@bs.splice]
6363
external removeFromInPlace : pos:int -> 'this = "splice" [@@bs.send.pipe: 'a t as 'this]
@@ -106,37 +106,37 @@ external toLocaleString : string = "" [@@bs.send.pipe: 'a t as 'this]
106106
external entries : (int * 'a) array_iter = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
107107
*)
108108

109-
external every : ('a -> Js.boolean [@bs]) -> Js.boolean = "" [@@bs.send.pipe: 'a t as 'this]
110-
external everyi : ('a -> int -> Js.boolean [@bs]) -> Js.boolean = "every" [@@bs.send.pipe: 'a t as 'this]
109+
external every : ('a -> bool[@bs.uncurry]) -> Js.boolean = "" [@@bs.send.pipe: 'a t as 'this]
110+
external everyi : ('a -> int -> bool [@bs.uncurry]) -> Js.boolean = "every" [@@bs.send.pipe: 'a t as 'this]
111111

112112
(** should we use [bool] or [boolan] seems they are intechangeable here *)
113-
external filter : ('a -> bool [@bs]) -> 'this = "" [@@bs.send.pipe: 'a t as 'this]
114-
external filteri : ('a -> int -> Js.boolean[@bs]) -> 'this = "filter" [@@bs.send.pipe: 'a t as 'this]
113+
external filter : ('a -> bool [@bs.uncurry]) -> 'this = "" [@@bs.send.pipe: 'a t as 'this]
114+
external filteri : ('a -> int -> bool[@bs.uncurry]) -> 'this = "filter" [@@bs.send.pipe: 'a t as 'this]
115115

116-
external find : ('a -> bool [@bs]) -> 'a Js.undefined = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
117-
external findi : ('a -> int -> bool [@bs]) -> 'a Js.undefined = "find" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
116+
external find : ('a -> bool [@bs.uncurry]) -> 'a Js.undefined = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
117+
external findi : ('a -> int -> bool [@bs.uncurry]) -> 'a Js.undefined = "find" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
118118

119-
external findIndex : ('a -> bool [@bs]) -> int = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
120-
external findIndexi : ('a -> int -> bool [@bs]) -> int = "findIndex" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
119+
external findIndex : ('a -> bool [@bs.uncurry]) -> int = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
120+
external findIndexi : ('a -> int -> bool [@bs.uncurry]) -> int = "findIndex" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
121121

122-
external forEach : ('a -> unit [@bs]) -> unit = "" [@@bs.send.pipe: 'a t as 'this]
123-
external forEachi : ('a -> int -> unit [@bs]) -> unit = "forEach" [@@bs.send.pipe: 'a t as 'this]
122+
external forEach : ('a -> unit [@bs.uncurry]) -> unit = "" [@@bs.send.pipe: 'a t as 'this]
123+
external forEachi : ('a -> int -> unit [@bs.uncurry]) -> unit = "forEach" [@@bs.send.pipe: 'a t as 'this]
124124

125125
(* commented out until bs has a plan for iterators
126126
external keys : int array_iter = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)
127127
*)
128128

129-
external map : ('a -> 'b [@bs]) -> 'b t = "" [@@bs.send.pipe: 'a t as 'this]
130-
external mapi : ('a -> int -> 'b [@bs]) -> 'b t = "map" [@@bs.send.pipe: 'a t as 'this]
129+
external map : ('a -> 'b [@bs.uncurry]) -> 'b t = "" [@@bs.send.pipe: 'a t as 'this]
130+
external mapi : ('a -> int -> 'b [@bs.uncurry]) -> 'b t = "map" [@@bs.send.pipe: 'a t as 'this]
131131

132-
external reduce : ('b -> 'a -> 'b [@bs]) -> 'b -> 'b = "" [@@bs.send.pipe: 'a t as 'this]
133-
external reducei : ('b -> 'a -> int -> 'b [@bs]) -> 'b -> 'b = "reduce" [@@bs.send.pipe: 'a t as 'this]
132+
external reduce : ('b -> 'a -> 'b [@bs.uncurry]) -> 'b -> 'b = "" [@@bs.send.pipe: 'a t as 'this]
133+
external reducei : ('b -> 'a -> int -> 'b [@bs.uncurry]) -> 'b -> 'b = "reduce" [@@bs.send.pipe: 'a t as 'this]
134134

135-
external reduceRight : ('b -> 'a -> 'b [@bs]) -> 'b -> 'b = "" [@@bs.send.pipe: 'a t as 'this]
136-
external reduceRighti : ('b -> 'a -> int -> 'b [@bs]) -> 'b -> 'b = "reduceRight" [@@bs.send.pipe: 'a t as 'this]
135+
external reduceRight : ('b -> 'a -> 'b [@bs.uncurry]) -> 'b -> 'b = "" [@@bs.send.pipe: 'a t as 'this]
136+
external reduceRighti : ('b -> 'a -> int -> 'b [@bs.uncurry]) -> 'b -> 'b = "reduceRight" [@@bs.send.pipe: 'a t as 'this]
137137

138-
external some : ('a -> Js.boolean [@bs]) -> Js.boolean = "" [@@bs.send.pipe: 'a t as 'this]
139-
external somei : ('a -> int -> Js.boolean [@bs]) -> Js.boolean = "some" [@@bs.send.pipe: 'a t as 'this]
138+
external some : ('a -> bool [@bs.uncurry]) -> Js.boolean = "" [@@bs.send.pipe: 'a t as 'this]
139+
external somei : ('a -> int -> bool [@bs.uncurry]) -> Js.boolean = "some" [@@bs.send.pipe: 'a t as 'this]
140140

141141
(* commented out until bs has a plan for iterators
142142
external values : 'a array_iter = "" [@@bs.send.pipe: 'a t as 'this] (** ES2015 *)

‎jscomp/test/.depend

+2-1
Original file line numberDiff line numberDiff line change
@@ -69,11 +69,12 @@ bigarray_test.cmj : ../stdlib/int32.cmj ../stdlib/complex.cmj \
6969
boolean_test.cmj : test_bool_equal.cmj mt.cmj
7070
bs_array_test.cmj : ../runtime/js.cmj
7171
bs_auto_uncurry.cmj : ../runtime/js.cmj
72+
bs_auto_uncurry_test.cmj : mt.cmj ../others/js_array.cmj ../runtime/js.cmj
7273
bs_ignore_effect.cmj : mt.cmj
7374
bs_ignore_test.cmj : ../runtime/js.cmj
7475
bs_node_string_buffer_test.cmj : ../others/node.cmj ../runtime/js.cmj
7576
bs_rest_test.cmj :
76-
bs_string_test.cmj : ../runtime/js.cmj
77+
bs_string_test.cmj : mt.cmj ../runtime/js.cmj
7778
buffer_test.cmj : ../stdlib/string.cmj mt.cmj ../stdlib/bytes.cmj \
7879
../stdlib/buffer.cmj
7980
bytes_split_gpr_743_test.cmj : mt.cmj ../runtime/js.cmj ../stdlib/bytes.cmj

‎jscomp/test/Makefile

+2-1
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,8 @@ OTHERS := literals a test_ari test_export2 test_internalOO test_obj_simple_ffi t
102102
gpr_1240_missing_unbox\
103103
js_null_undefined_test js_null_test js_undefined_test\
104104
gpr_1268\
105-
bs_auto_uncurry
105+
bs_auto_uncurry\
106+
bs_auto_uncurry_test
106107

107108
# bs_uncurry_test
108109
# needs Lam to get rid of Uncurry arity first

‎jscomp/test/bs_array_test.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
type 'a t = 'a Js.Array.t
33
let () =
44
[| 1; 2; 3; 4 |]
5-
|> Js.Array.filter (fun [@bs] x -> x > 2)
6-
|> Js.Array.mapi (fun [@bs] x i -> x + i)
7-
|> Js.Array.reduce (fun [@bs] x y -> x + y) 0
5+
|> Js.Array.filter (fun x -> x > 2)
6+
|> Js.Array.mapi (fun x i -> x + i)
7+
|> Js.Array.reduce (fun x y -> x + y) 0
88
|> Js.log

‎jscomp/test/bs_auto_uncurry_test.js

+88
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
'use strict';
2+
3+
var Mt = require("./mt");
4+
var Block = require("../../lib/js/block");
5+
6+
var suites = [/* [] */0];
7+
8+
var test_id = [0];
9+
10+
function eq(loc, x, y) {
11+
test_id[0] = test_id[0] + 1 | 0;
12+
suites[0] = /* :: */[
13+
/* tuple */[
14+
loc + (" id " + test_id[0]),
15+
function () {
16+
return /* Eq */Block.__(0, [
17+
x,
18+
y
19+
]);
20+
}
21+
],
22+
suites[0]
23+
];
24+
return /* () */0;
25+
}
26+
27+
eq('File "bs_auto_uncurry_test.ml", line 15, characters 7-14', /* int array */[
28+
1,
29+
2,
30+
3
31+
].map(function (x) {
32+
return x + 1 | 0;
33+
}), /* int array */[
34+
2,
35+
3,
36+
4
37+
]);
38+
39+
eq('File "bs_auto_uncurry_test.ml", line 18, characters 7-14', /* int array */[
40+
1,
41+
2,
42+
3
43+
].map(function (x) {
44+
return x + 1 | 0;
45+
}), /* int array */[
46+
2,
47+
3,
48+
4
49+
]);
50+
51+
eq('File "bs_auto_uncurry_test.ml", line 22, characters 7-14', /* int array */[
52+
1,
53+
2,
54+
3
55+
].reduce(function (prim, prim$1) {
56+
return prim + prim$1 | 0;
57+
}, 0), 6);
58+
59+
eq('File "bs_auto_uncurry_test.ml", line 26, characters 7-14', /* int array */[
60+
1,
61+
2,
62+
3
63+
].reduce(function (x, y, i) {
64+
return (x + y | 0) + i | 0;
65+
}, 0), 9);
66+
67+
eq('File "bs_auto_uncurry_test.ml", line 30, characters 7-14', /* int array */[
68+
1,
69+
2,
70+
3
71+
].some(function (x) {
72+
return +(x < 1);
73+
}), false);
74+
75+
eq('File "bs_auto_uncurry_test.ml", line 34, characters 7-14', /* int array */[
76+
1,
77+
2,
78+
3
79+
].every(function (x) {
80+
return +(x > 0);
81+
}), true);
82+
83+
Mt.from_pair_suites("bs_auto_uncurry_test.ml", suites[0]);
84+
85+
exports.suites = suites;
86+
exports.test_id = test_id;
87+
exports.eq = eq;
88+
/* Not a pure module */

0 commit comments

Comments
 (0)