Skip to content

Commit b66fc0e

Browse files
authored
Merge pull request #4960 from rescript-lang/prototype_initialize_external_obj
2 parents f49f4a6 + c757eff commit b66fc0e

13 files changed

+179
-175
lines changed

jscomp/core/lam_compile_external_obj.ml

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -71,14 +71,15 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) (args : J.express
7171
let (accs, eff, assign) as r = aux labels args in
7272
Js_of_lam_option.destruct_optional arg
7373
~for_sure_none:r
74-
~for_sure_some:(fun x -> let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff
75-
~arg_label:Arg_label ~arg_type:obj_arg_type x in
76-
begin match acc with
77-
| Splice2 _
78-
| Splice0 -> assert false
79-
| Splice1 x ->
80-
(Js_op.Lit label, x) :: accs , Ext_list.append new_eff eff , assign
81-
end )
74+
~for_sure_some:(fun x ->
75+
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff
76+
~arg_label:Arg_label ~arg_type:obj_arg_type x in
77+
begin match acc with
78+
| Splice2 _
79+
| Splice0 -> assert false
80+
| Splice1 x ->
81+
(Js_op.Lit label, x) :: accs , Ext_list.append new_eff eff , assign
82+
end )
8283
~not_sure:(fun _ -> accs, eff , (arg_kind,arg)::assign )
8384
| {obj_arg_label = Obj_empty | Obj_label _ | Obj_optional _ } :: _ , [] -> assert false
8485
| [], _ :: _ -> assert false
@@ -103,7 +104,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) (args : J.express
103104
(Ext_list.flat_map assignment (fun
104105
((xlabel : External_arg_spec.obj_param), (arg : J.expression )) ->
105106
match xlabel with
106-
| {obj_arg_label = Obj_optional {name = label} } ->
107+
| {obj_arg_label = Obj_optional {name = label;for_sure_no_nested_option} } ->
107108
(* Need make sure whether assignment is effectful or not
108109
to avoid code duplication
109110
*)
@@ -113,7 +114,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) (args : J.express
113114
Lam_compile_external_call.ocaml_to_js_eff
114115
~arg_label:
115116
Arg_empty ~arg_type:xlabel.obj_arg_type
116-
(Js_of_lam_option.val_from_option arg) in
117+
(if for_sure_no_nested_option then arg else Js_of_lam_option.val_from_option arg) in
117118
begin match acc with
118119
| Splice1 v ->
119120
[S.if_ (Js_of_lam_option.is_not_none arg )
@@ -133,7 +134,7 @@ let assemble_obj_args (labels : External_arg_spec.obj_params) (args : J.express
133134
~arg_label:
134135
Arg_empty
135136
~arg_type:xlabel.obj_arg_type
136-
(Js_of_lam_option.val_from_option arg) in
137+
(if for_sure_no_nested_option then arg else Js_of_lam_option.val_from_option arg) in
137138
begin match acc with
138139
| Splice1 v ->
139140
st ::

jscomp/frontend/ast_core_type.ml

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,11 +56,26 @@ open Ast_helper
5656
| _ -> result in
5757
aux ty *)
5858

59+
let is_builtin_rank0_type txt =
60+
match txt with
61+
| "int"
62+
| "char"
63+
| "bytes"
64+
| "float"
65+
| "bool"
66+
| "unit"
67+
| "exn"
68+
| "int32"
69+
| "int64"
70+
| "string" -> true
71+
| _ -> false
72+
5973
let is_unit (ty : t ) =
6074
match ty.ptyp_desc with
6175
| Ptyp_constr({txt =Lident "unit"}, []) -> true
6276
| _ -> false
6377

78+
6479
(* let is_array (ty : t) =
6580
match ty.ptyp_desc with
6681
| Ptyp_constr({txt =Lident "array"}, [_]) -> true

jscomp/frontend/ast_core_type.mli

Lines changed: 2 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -29,13 +29,10 @@ type t = Parsetree.core_type
2929

3030
val lift_option_type : t -> t
3131

32-
(* val replace_result : t -> t -> t *)
33-
34-
(* val opt_arrow: Location.t -> string -> t -> t -> t *)
35-
3632
val is_unit : t -> bool
37-
(* val is_array : t -> bool *)
3833

34+
val is_builtin_rank0_type :
35+
string -> bool
3936

4037
(** return a function type
4138
[from_labels ~loc tyvars labels]
@@ -52,11 +49,6 @@ val make_obj :
5249

5350
val is_user_option : t -> bool
5451

55-
(* val is_user_bool : t -> bool
56-
57-
val is_user_int : t -> bool *)
58-
59-
6052

6153
(**
6254
returns 0 when it can not tell arity from the syntax

jscomp/frontend/ast_external_process.ml

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -492,17 +492,22 @@ let process_obj
492492
param_type::arg_types, result_types
493493
| Nothing ->
494494
let s = (Lam_methname.translate name) in
495-
{obj_arg_label = External_arg_spec.optional s; obj_arg_type},
495+
let for_sure_not_nested =
496+
match ty.ptyp_desc with
497+
| Ptyp_constr({txt = Lident txt;_}, []) ->
498+
Ast_core_type.is_builtin_rank0_type txt
499+
| _ -> false in
500+
{obj_arg_label = External_arg_spec.optional for_sure_not_nested s; obj_arg_type},
496501
param_type :: arg_types,
497502
( Parsetree.Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc ty) :: result_types)
498503
| Int _ ->
499504
let s = Lam_methname.translate name in
500-
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
505+
{obj_arg_label = External_arg_spec.optional true s ; obj_arg_type },
501506
param_type :: arg_types,
502507
(Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
503508
| Poly_var_string _ ->
504509
let s = Lam_methname.translate name in
505-
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
510+
{obj_arg_label = External_arg_spec.optional true s ; obj_arg_type },
506511
param_type::arg_types,
507512
(Otag ({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc ()) :: result_types)
508513
| Arg_cst _
@@ -1020,7 +1025,7 @@ let pval_prim_of_option_labels
10201025
let label_name = Lam_methname.translate p.txt in
10211026
let obj_arg_label =
10221027
if is_option then
1023-
External_arg_spec.optional label_name
1028+
External_arg_spec.optional false label_name
10241029
else External_arg_spec.obj_label label_name
10251030
in
10261031
{obj_arg_type = Nothing ;

jscomp/frontend/bs_ast_invariant.ml

Lines changed: 4 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -117,27 +117,10 @@ let emit_external_warnings : iterator=
117117
super with
118118
type_declaration = (fun self ptyp ->
119119
let txt = ptyp.ptype_name.txt in
120-
(match txt with
121-
| "int"
122-
| "char"
123-
| "bytes"
124-
| "float"
125-
| "bool"
126-
| "unit"
127-
| "exn"
128-
| "int32"
129-
| "int64"
130-
| "string"
131-
(* not adding parametric types yet
132-
| "array"
133-
| "list"
134-
| "option"
135-
*)
136-
->
137-
Location.raise_errorf ~loc:ptyp.ptype_loc
138-
"built-in type `%s` can not be redefined " txt
139-
| _ -> ()
140-
);
120+
if Ast_core_type.is_builtin_rank0_type txt then
121+
Location.raise_errorf ~loc:ptyp.ptype_loc
122+
"built-in type `%s` can not be redefined " txt
123+
;
141124
super.type_declaration self ptyp
142125
);
143126
attribute = (fun _ attr -> warn_unused_attribute attr);

jscomp/frontend/external_arg_spec.ml

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,8 @@ type label_noname =
3737
type label =
3838
| Obj_label of {name : string }
3939
| Obj_empty
40-
| Obj_optional of {name : string }
40+
| Obj_optional of {name : string; for_sure_no_nested_option : bool }
41+
4142
(* it will be ignored , side effect will be recorded *)
4243

4344

@@ -90,7 +91,8 @@ let empty_label = Obj_empty
9091
let obj_label name =
9192
Obj_label {name }
9293

93-
let optional name = Obj_optional {name}
94+
let optional for_sure_no_nested_option name =
95+
Obj_optional {name; for_sure_no_nested_option}
9496

9597
let empty_kind obj_arg_type = { obj_arg_label = empty_label ; obj_arg_type }
9698
let dummy =

jscomp/frontend/external_arg_spec.mli

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,8 @@ type label = private
3232
| Obj_label of {name : string}
3333
| Obj_empty
3434

35-
| Obj_optional of {name : string}
35+
| Obj_optional of {name : string;
36+
for_sure_no_nested_option : bool}
3637
(* it will be ignored , side effect will be recorded *)
3738

3839

@@ -83,6 +84,8 @@ val cst_string : string -> cst
8384
val empty_label : label
8485
(* val empty_lit : cst -> label *)
8586
val obj_label : string -> label
86-
val optional : string -> label
87+
val optional :
88+
bool ->
89+
string -> label
8790
val empty_kind : attr -> obj_param
8891
val dummy : param

jscomp/main/builtin_cmi_datasets.ml

Lines changed: 5 additions & 5 deletions
Large diffs are not rendered by default.

jscomp/test/debug_tmp.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11

22
[@@@config {
33
flags = [|
4+
(* "-w";
5+
"@A" *)
46
(* "-drawlambda"; *)
57
(* "-dtypedtree"; *)
68
(* "-bs-diagnose"; *)

jscomp/test/gpr_1409_test.js

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ function make(foo) {
5252
return function (param) {
5353
var tmp = {};
5454
if (partial_arg !== undefined) {
55-
tmp.foo = Caml_option.valFromOption(partial_arg);
55+
tmp.foo = partial_arg;
5656
}
5757
return tmp;
5858
};
@@ -79,10 +79,10 @@ function test3(_open, xx__hi) {
7979
hi: 2
8080
};
8181
if (_open !== undefined) {
82-
tmp.open = Caml_option.valFromOption(_open);
82+
tmp.open = _open;
8383
}
8484
if (xx__hi !== undefined) {
85-
tmp.xx = Caml_option.valFromOption(xx__hi);
85+
tmp.xx = xx__hi;
8686
}
8787
return tmp;
8888
}
@@ -94,7 +94,7 @@ function test4(_open, xx__hi) {
9494
hi: 2
9595
};
9696
if (xx__hi !== undefined) {
97-
tmp.xx = Caml_option.valFromOption(xx__hi);
97+
tmp.xx = xx__hi;
9898
}
9999
return tmp;
100100
}
@@ -106,11 +106,11 @@ function test5(f, x) {
106106
};
107107
var tmp$1 = Curry._1(f, x);
108108
if (tmp$1 !== undefined) {
109-
tmp.open = Caml_option.valFromOption(tmp$1);
109+
tmp.open = tmp$1;
110110
}
111111
var tmp$2 = Curry._1(f, x);
112112
if (tmp$2 !== undefined) {
113-
tmp.xx = Caml_option.valFromOption(tmp$2);
113+
tmp.xx = tmp$2;
114114
}
115115
return tmp;
116116
}
@@ -125,11 +125,11 @@ function test6(f, x) {
125125
};
126126
var tmp$1 = (x$1.contents = x$1.contents + 1 | 0, x$1.contents);
127127
if (tmp$1 !== undefined) {
128-
tmp.open = Caml_option.valFromOption(tmp$1);
128+
tmp.open = tmp$1;
129129
}
130130
var tmp$2 = f(x$1);
131131
if (tmp$2 !== undefined) {
132-
tmp.xx = Caml_option.valFromOption(tmp$2);
132+
tmp.xx = tmp$2;
133133
}
134134
return tmp;
135135
}

jscomp/test/test_obj_simple_ffi.js

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
'use strict';
22

3-
var Caml_option = require("../../lib/js/caml_option.js");
43

54
function v(displayName, param) {
65
var tmp = {
@@ -9,7 +8,7 @@ function v(displayName, param) {
98
hi: "ghos"
109
};
1110
if (displayName !== undefined) {
12-
tmp.displayName = Caml_option.valFromOption(displayName);
11+
tmp.displayName = displayName;
1312
}
1413
return tmp;
1514
}

lib/4.06.1/unstable/js_compiler.ml

Lines changed: 56 additions & 55 deletions
Large diffs are not rendered by default.

0 commit comments

Comments
 (0)