Skip to content

fix #4922 #4923

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jan 28, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion jscomp/common/js_config.ml
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ let no_stdlib = ref false

let no_export = ref false

let record_as_js_object = ref false (* otherwise has an attribute *)


let as_ppx = ref false

Expand Down
2 changes: 1 addition & 1 deletion jscomp/common/js_config.mli
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ val all_module_aliases : bool ref

val no_stdlib: bool ref
val no_export: bool ref
val record_as_js_object : bool ref

val as_ppx : bool ref

val mono_empty_array : bool ref
16 changes: 8 additions & 8 deletions jscomp/others/node_path.ml
Original file line number Diff line number Diff line change
Expand Up @@ -35,14 +35,14 @@ external dirname : string -> string = "dirname" [@@bs.module "path"]
external dirname_ext : string -> string -> string = "dirname" [@@bs.module "path"]

type pathObject =
[%bs.obj: <
dir : string ;
root : string ;
base : string ;
name : string ;
ext : string
>
]
<
dir : string ;
root : string ;
base : string ;
name : string ;
ext : string
> Js.t

external format : pathObject -> string = "format" [@@bs.module "path"]

external isAbsolute : string -> bool = "isAbsolute" [@@bs.module "path"]
Expand Down
19 changes: 5 additions & 14 deletions jscomp/syntax/ast_core_type_class_type.ml
Original file line number Diff line number Diff line change
Expand Up @@ -128,16 +128,11 @@ let default_typ_mapper = Bs_ast_mapper.default_mapper.typ
we can only use it locally
*)

let typ_mapper
record_as_js_object
let typ_mapper
(self : Bs_ast_mapper.mapper)
(ty : Parsetree.core_type)
=
match ty with
| {ptyp_desc = Ptyp_extension({txt = ("bs.obj"|"obj")}, PTyp ty)}
->
Ext_ref.non_exn_protect record_as_js_object true
(fun _ -> self.typ self ty )
| {ptyp_attributes ;
ptyp_desc = Ptyp_arrow (label, args, body);
(* let it go without regard label names,
Expand Down Expand Up @@ -205,14 +200,10 @@ let typ_mapper
Ast_compatible.object_field label attrs (self.typ self core_type) in
process_getter_setter ~not_getter_setter ~get ~set
loc label ptyp_attrs core_type acc
)in
let inner_type =
{ ty
with ptyp_desc = Ptyp_object(new_methods, closed_flag);
} in
if !record_as_js_object then
Ast_comb.to_js_type loc inner_type
else inner_type
)in
{ ty
with ptyp_desc = Ptyp_object(new_methods, closed_flag);
}
| _ -> default_typ_mapper self ty

let handle_class_type_fields self fields =
Expand Down
1 change: 0 additions & 1 deletion jscomp/syntax/ast_core_type_class_type.mli
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,6 @@ val handle_class_type_fields :
Parsetree.class_type_field list

val typ_mapper :
bool ref ->
Bs_ast_mapper.mapper ->
Parsetree.core_type ->
Parsetree.core_type
14 changes: 9 additions & 5 deletions jscomp/syntax/ast_exp_extension.ml
Original file line number Diff line number Diff line change
Expand Up @@ -27,7 +27,7 @@ open Ast_helper



let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
let handle_extension e (self : Bs_ast_mapper.mapper)
(({txt ; loc} , payload) : Parsetree.extension) =
begin match txt with
| "bs.raw" | "raw" ->
Expand Down Expand Up @@ -134,11 +134,15 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
{e with pexp_desc = Ast_exp_handle_external.handle_debugger loc payload}
| "bs.obj" | "obj" ->
begin match payload with
| PStr [{pstr_desc = Pstr_eval (e,_)}]
|PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record(label_exprs, None)} as e,_)}]
->
Ext_ref.non_exn_protect record_as_js_object true
(fun () -> self.expr self e )
| _ -> Location.raise_errorf ~loc "Expect an expression here"
{e
with
pexp_desc =
Ast_util.record_as_js_object e.pexp_loc self label_exprs
}

| _ -> Location.raise_errorf ~loc "Expect a record expression here"
end
| _ ->
e (* For an unknown extension, we don't really need to process further*)
Expand Down
1 change: 0 additions & 1 deletion jscomp/syntax/ast_exp_extension.mli
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@


val handle_extension :
bool ref ->
Parsetree.expression ->
Bs_ast_mapper.mapper ->
Parsetree.extension ->
Expand Down
24 changes: 2 additions & 22 deletions jscomp/syntax/bs_builtin_ppx.ml
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
match e.pexp_desc with
(** Its output should not be rewritten anymore *)
| Pexp_extension extension ->
Ast_exp_extension.handle_extension Js_config.record_as_js_object e self extension
Ast_exp_extension.handle_extension e self extension
| Pexp_constant (
Pconst_string
(s, (Some delim)))
Expand Down Expand Up @@ -134,26 +134,6 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
end
| Pexp_apply (fn, args ) ->
Ast_exp_apply.app_exp_mapper e self fn args
| Pexp_record (label_exprs, opt_exp) ->
(* could be supported using `Object.assign`?
type
{[
external update : 'a Js.t -> 'b Js.t -> 'a Js.t = ""
constraint 'b :> 'a
]}
*)
if !Js_config.record_as_js_object then
(match opt_exp with
| None ->
{ e with
pexp_desc =
Ast_util.record_as_js_object e.pexp_loc self label_exprs;
}
| Some e ->
Location.raise_errorf
~loc:e.pexp_loc "`with` construct is not supported in js obj ")
else
default_expr_mapper self e
| Pexp_object {pcstr_self; pcstr_fields} ->
(match Ast_attributes.process_bs e.pexp_attributes with
| true, pexp_attributes
Expand Down Expand Up @@ -204,7 +184,7 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =


let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
Ast_core_type_class_type.typ_mapper Js_config.record_as_js_object self typ
Ast_core_type_class_type.typ_mapper self typ

let class_type_mapper (self : mapper) ({pcty_attributes; pcty_loc} as ctd : Parsetree.class_type) =
match Ast_attributes.process_bs pcty_attributes with
Expand Down
7 changes: 7 additions & 0 deletions jscomp/test/arity.js
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,16 @@ function h(u) {
return m(1, 2);
}

var nested = {
x: {
y: 3
}
};

exports.u = u;
exports.u2 = u2;
exports.f = f;
exports.add = add;
exports.h = h;
exports.nested = nested;
/* No side effect */
5 changes: 4 additions & 1 deletion jscomp/test/arity.re
Original file line number Diff line number Diff line change
Expand Up @@ -59,4 +59,7 @@ let u = obj => {
let h = u => {
let m = u##hi ;
m(.1,2);
}
}

//
let nested = ({ "x" : {"y" : 3 }} : {. "x" : {. "y" : int }})
2 changes: 1 addition & 1 deletion jscomp/test/bs_unwrap_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ let _ = dyn_log3 ~req:(`Int 8) ~opt:(`Bool true) ()

external log4 :
([ `String of string
| `Options of [%bs.obj: < foo : int > ]
| `Options of < foo : int > Js.t
] [@bs.unwrap])
-> unit = "console.log" [@@bs.val]

Expand Down
2 changes: 1 addition & 1 deletion jscomp/test/chain_code_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,6 @@ let f4 h x y =
(* ##(draw (x,y)) *)
(* ##(draw(x,y)) *)
let () =
eq __LOC__ 32 [%bs.obj f2 { x = {y = {z = 32}}} ]
eq __LOC__ 32 ( f2 [%obj{ x = [%obj{y = [%obj{z = 32}]}]}] )

let () = Mt.from_pair_suites __MODULE__ !suites
8 changes: 4 additions & 4 deletions jscomp/test/config2_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,15 +11,15 @@ class type v2 = object
end [@bs]

type vv =
[%obj: <
<
hey : int -> int -> int [@bs]
> ]
> Js.t


type vv2 =
[%obj: <
<
hey : int -> int -> int [@bs]
> ]
> Js.t


let hh (x : v) : v2 = x
Expand Down
8 changes: 4 additions & 4 deletions jscomp/test/config2_test.mli
Original file line number Diff line number Diff line change
Expand Up @@ -9,14 +9,14 @@ class type v2 = object
end [@bs]

type vv =
[%bs.obj: <
<
hey : int -> int -> int [@bs]
> ]
> Js.t

type vv2 =
[%bs.obj: <
<
hey : int -> int -> int [@bs]
> ]
> Js.t


val test_v : v Js.t -> int
Expand Down
2 changes: 1 addition & 1 deletion jscomp/test/demo.ml
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ let ui_layout
stackPanel##addChild grid;
stackPanel##addChild inputCode;
stackPanel##addChild button;
let mk_titleRow text = [%bs.obj {label = {text } } ] in
let mk_titleRow text = [%obj {label = [%obj{text }] } ] in
let u = [%bs.obj {width = 200} ] in
grid##minHeight #= 300;
grid##titleRows #=
Expand Down
6 changes: 3 additions & 3 deletions jscomp/test/demo_binding.ml
Original file line number Diff line number Diff line change
Expand Up @@ -80,11 +80,11 @@ class type grid =
object
inherit widget
inherit measure
method columns : [%bs.obj: <width : int; .. > ] array [@@bs.set]
method columns : <width : int; .. > Js.t array [@@bs.set]
method titleRows :
[%bs.obj: <label : <text : string; .. > ; ..> ] array [@@bs.set]
<label : <text : string; .. > Js.t ; ..> Js.t array [@@bs.set]
method dataSource :
[%bs.obj: <label : <text : string; .. > ; ..> ] array array [@@bs.set]
<label : <text : string; .. > Js.t ; ..> Js.t array array [@@bs.set]
end[@bs]


Expand Down
2 changes: 1 addition & 1 deletion jscomp/test/js_obj_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ let suites = Mt.[
"js_obj", (fun _ ->
Eq(34, f_js [%obj{ say = fun [@bs] x -> x + 2 } ]));
"js_obj2", (fun _ ->
Eq(34, [%obj { say = fun [@bs] x -> x + 2 } #@say 32 ]));
Eq(34, [%obj { say = fun [@bs] x -> x + 2 }] #@say 32 ));
"empty", (fun _ ->
Eq(0, empty () |> keys |> Array.length));
"assign", (fun _ ->
Expand Down
2 changes: 1 addition & 1 deletion jscomp/test/module_as_function.ml
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
external nightmare : [%bs.obj: < show : bool > ] -> int = "nightmare" [@@bs.module]
external nightmare : < show : bool > Js.t -> int = "nightmare" [@@bs.module]

let v = nightmare [%bs.obj {show = true}]
2 changes: 1 addition & 1 deletion jscomp/test/mutable_obj_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ let f ( x : < height : int [@bs.set{no_get}] > Js.t) =


type v =
[%bs.obj: < dec : int -> < x : int ; y : float > [@bs] [@bs.set] > ]
< dec : int -> < x : int ; y : float > Js.t [@bs] [@bs.set] > Js.t

let f (x : v ) =
x##dec#= (fun [@bs] x -> [%bs.obj {x ; y = float_of_int x }])
2 changes: 1 addition & 1 deletion jscomp/test/nested_obj_literal.ml
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@


let structural_obj =
[%bs.obj { x = { y = { z = 3 }}} ]
[%bs.obj { x = [%obj{ y = [%obj{ z = 3 }]}]} ]
(* compiler inferred type :
val structural_obj : < x : < y : < z : int > > > [@bs.obj] *)

Expand Down
30 changes: 15 additions & 15 deletions jscomp/test/nested_obj_test.ml
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@


type f_obj = [%bs.obj:< x : < y : < z : int > > > ]
let f : f_obj = [%bs.obj { x = { y = { z = 3 }}}]
type f_obj = < x : < y : < z : int > Js.t > Js.t > Js.t
let f : f_obj = [%obj{ x = [%obj{ y = [%obj{ z = 3 }]}]}]

type 'a x = {x : 'a }
type 'a y = {y : 'a}
Expand All @@ -11,27 +11,27 @@ let f_record = { x = { y = { z = 3 }}}



let f : f_obj = [%bs.obj { x = { y = ({ z = 3 }) }}]
let f : f_obj = [%bs.obj { x = [%obj{ y = ([%obj{ z = 3 }]) }]}]


let f2 : [%bs.obj:
< x : < y : < z : int > > > list * < x : < y : < z : int > > > array
] =
[%bs.obj
let f2 :
< x : < y : < z : int > Js.t > Js.t > Js.t list * < x : < y : < z : int > Js.t > Js.t > Js.t array
=

[
{ x = { y = { z = 3 }}} ;
{ x = { y = { z = 31 }}} ;
[%obj{ x = [%obj{ y = [%obj{ z = 3 }]}]}] ;
[%obj{ x = [%obj{ y = [%obj{ z = 31 }]}]}] ;
] ,
[|
{ x = { y = { z = 3 }}} ;
{ x = { y = { z = 31 }}} ;
[%obj{ x = [%obj{ y = [%obj{ z = 3 }]}]}] ;
[%obj{ x = [%obj{ y = [%obj{ z = 31 }]}]}] ;
|]
]


let f3 =
[%bs.obj
({x = {y = {z = 3 }}} : < x : < y : < z : int > > > )
]

([%obj{x = [%obj{y = [%obj{z = 3 }]}]}] : < x : < y : < z : int > Js.t > Js.t > Js.t )

(* how about
let f x = [%bs.obj (x : < x : int > ) ]
*)
Expand Down
6 changes: 1 addition & 5 deletions jscomp/test/obj_type_test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,10 @@



type u = [%bs.obj: <
x : int ;
y : 'self -> int
> as 'self ]

type x = (
(< x : int ; y : 'self -> int > Js.t)
as 'self
)

let f (u : x) : u = u
let f (u : x) : x = u
2 changes: 1 addition & 1 deletion jscomp/test/pipe_send_readline.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ let u rl =



external send : string -> 'self = "send" [@@bs.send.pipe: [%bs.obj: < hi : int > ] as 'self]
external send : string -> 'self = "send" [@@bs.send.pipe: < hi : int > Js.t as 'self]


let xx h : int =
Expand Down
2 changes: 1 addition & 1 deletion jscomp/test/test_bs_this.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@


let uux_this :[%bs.obj: < length : int > ] -> int -> int -> int [@bs.this]
let uux_this : < length : int > Js.t -> int -> int -> int [@bs.this]
=
fun[@bs.this] o x y -> o##length + x + y

Expand Down
Loading