Skip to content

Commit 69eca55

Browse files
committed
clean up class type handling
1 parent bc52427 commit 69eca55

8 files changed

+107
-95
lines changed

jscomp/frontend/bs_builtin_ppx.ml

+23-20
Original file line numberDiff line numberDiff line change
@@ -171,26 +171,29 @@ let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
171171
Ast_core_type_class_type.typ_mapper self typ
172172

173173
let class_type_mapper (self : mapper) ({pcty_attributes; pcty_loc} as ctd : Parsetree.class_type) =
174-
match Ast_attributes.process_bs pcty_attributes with
175-
| false, _ ->
176-
default_mapper.class_type self ctd
177-
| true, pcty_attributes ->
178-
(match ctd.pcty_desc with
179-
| Pcty_signature ({pcsig_self; pcsig_fields })
180-
->
181-
let pcsig_self = self.typ self pcsig_self in
182-
{ctd with
183-
pcty_desc = Pcty_signature {
184-
pcsig_self ;
185-
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
186-
};
187-
pcty_attributes
188-
}
189-
| Pcty_open _ (* let open M in CT *)
190-
| Pcty_constr _
191-
| Pcty_extension _
192-
| Pcty_arrow _ ->
193-
Location.raise_errorf ~loc:pcty_loc "invalid or unused attribute `bs`")
174+
let pcty_attributes =
175+
match Ast_attributes.process_bs pcty_attributes with
176+
| false, _ ->
177+
pcty_attributes
178+
| true, pcty_attributes ->
179+
Location.prerr_warning pcty_loc (Bs_ffi_warning "Here @bs attribute is not needed any more.");
180+
pcty_attributes in
181+
(match ctd.pcty_desc with
182+
| Pcty_signature ({pcsig_self; pcsig_fields })
183+
->
184+
let pcsig_self = self.typ self pcsig_self in
185+
{ctd with
186+
pcty_desc = Pcty_signature {
187+
pcsig_self ;
188+
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
189+
};
190+
pcty_attributes
191+
}
192+
| Pcty_open _ (* let open M in CT *)
193+
| Pcty_constr _
194+
| Pcty_extension _
195+
| Pcty_arrow _ ->
196+
default_mapper.class_type self ctd)
194197
(* {[class x : int -> object
195198
end [@bs]
196199
]}

jscomp/test/class_setter_getter.ml

+15-15
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,29 @@
11

22

33

4-
class type _y = object
4+
class type y = object
55
method height : int [@@bs.set {no_get}]
6-
end [@bs]
7-
type y = _y
8-
class type _y0 = object
6+
end
7+
8+
class type y0 = object
99
method height : int [@@bs.set] [@@bs.get {null}]
10-
end [@bs]
11-
type y0 = _y0
10+
end
11+
1212

13-
class type _y1 = object
13+
class type y1 = object
1414
method height : int [@@bs.set] [@@bs.get {undefined}]
15-
end[@bs]
16-
type y1 = _y1
15+
end
16+
1717

18-
class type _y2 = object
18+
class type y2 = object
1919
method height : int [@@bs.set] [@@bs.get {undefined; null}]
20-
end [@bs]
21-
type y2 = _y2
20+
end
2221

23-
class type _y3 = object
22+
23+
class type y3 = object
2424
method height : int [@@bs.get {undefined ; null}]
25-
end[@bs]
26-
type y3 = _y3
25+
end
26+
2727

2828

2929
type yy2 = < height : int [@bs.get{undefined ; null}] [@bs.set] >

jscomp/test/class_setter_getter.mli

+15-15
Original file line numberDiff line numberDiff line change
@@ -23,29 +23,29 @@
2323
(* type y3 = _y3 *)
2424

2525

26-
class type _y = object
26+
class type y = object
2727
method height : int [@@bs.set no_get]
28-
end [@bs]
29-
type y = _y
30-
class type _y0 = object
28+
end
29+
30+
class type y0 = object
3131
method height : int [@@bs.set] [@@bs.get null]
32-
end [@bs]
33-
type y0 = _y0
32+
end
33+
3434

35-
class type _y1 = object
35+
class type y1 = object
3636
method height : int [@@bs.set] [@@bs.get undefined]
37-
end[@bs]
38-
type y1 = _y1
37+
end
38+
3939

40-
class type _y2 = object
40+
class type y2 = object
4141
method height : int [@@bs.set] [@@bs.get nullable]
42-
end [@bs]
43-
type y2 = _y2
42+
end
4443

45-
class type _y3 = object
44+
45+
class type y3 = object
4646
method height : int [@@bs.get nullable]
47-
end[@bs]
48-
type y3 = _y3
47+
end
48+
4949

5050

5151
type yy2 =

jscomp/test/class_type_ffi_test.ml

+6-3
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,13 @@ class type ['k,'v] arrayLike =
55
method caseSet : 'k * 'v -> unit
66
method case__unsafe : 'k -> 'v
77
method length : int
8-
end[@bs]
8+
end
99

1010
class type floatArray = [int, float] arrayLike
1111
(** here we can see [@bs] is really attached to `object end` instead of `class type` *)
12+
13+
14+
1215
class type intArray = [int, int] arrayLike
1316

1417

@@ -68,7 +71,7 @@ let mk_f () =
6871

6972
(* Test [fn_method] *)
7073
let omk_f ()=
71-
object
74+
object[@bs]
7275
method huge_methdo a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =
7376
a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12
74-
end [@bs]
77+
end

jscomp/test/oo_js_test_date.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -97,7 +97,7 @@ class type date =
9797
method toISOString : unit -> string
9898
method toJSON__ : unit -> string
9999
method toJSON__1 : 'a -> string
100-
end[@bs]
100+
end
101101

102102
type t = date
103103

jscomp/test/unboxed_use_case.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ module rec R:
6666

6767
module rec R1 : sig
6868
class type ['a] container =
69-
object [@bs]
69+
object
7070
method map : 'b. ('a -> 'b) -> 'b R1.container_aux
7171
end
7272
type 'a container_aux =

lib/4.06.1/unstable/js_compiler.ml

+23-20
Original file line numberDiff line numberDiff line change
@@ -406014,26 +406014,29 @@ let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
406014406014
Ast_core_type_class_type.typ_mapper self typ
406015406015

406016406016
let class_type_mapper (self : mapper) ({pcty_attributes; pcty_loc} as ctd : Parsetree.class_type) =
406017-
match Ast_attributes.process_bs pcty_attributes with
406018-
| false, _ ->
406019-
default_mapper.class_type self ctd
406020-
| true, pcty_attributes ->
406021-
(match ctd.pcty_desc with
406022-
| Pcty_signature ({pcsig_self; pcsig_fields })
406023-
->
406024-
let pcsig_self = self.typ self pcsig_self in
406025-
{ctd with
406026-
pcty_desc = Pcty_signature {
406027-
pcsig_self ;
406028-
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
406029-
};
406030-
pcty_attributes
406031-
}
406032-
| Pcty_open _ (* let open M in CT *)
406033-
| Pcty_constr _
406034-
| Pcty_extension _
406035-
| Pcty_arrow _ ->
406036-
Location.raise_errorf ~loc:pcty_loc "invalid or unused attribute `bs`")
406017+
let pcty_attributes =
406018+
match Ast_attributes.process_bs pcty_attributes with
406019+
| false, _ ->
406020+
pcty_attributes
406021+
| true, pcty_attributes ->
406022+
Location.prerr_warning pcty_loc (Bs_ffi_warning "Here @bs attribute is not needed any more.");
406023+
pcty_attributes in
406024+
(match ctd.pcty_desc with
406025+
| Pcty_signature ({pcsig_self; pcsig_fields })
406026+
->
406027+
let pcsig_self = self.typ self pcsig_self in
406028+
{ctd with
406029+
pcty_desc = Pcty_signature {
406030+
pcsig_self ;
406031+
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
406032+
};
406033+
pcty_attributes
406034+
}
406035+
| Pcty_open _ (* let open M in CT *)
406036+
| Pcty_constr _
406037+
| Pcty_extension _
406038+
| Pcty_arrow _ ->
406039+
default_mapper.class_type self ctd)
406037406040
(* {[class x : int -> object
406038406041
end [@bs]
406039406042
]}

lib/4.06.1/whole_compiler.ml

+23-20
Original file line numberDiff line numberDiff line change
@@ -409100,26 +409100,29 @@ let typ_mapper (self : mapper) (typ : Parsetree.core_type) =
409100409100
Ast_core_type_class_type.typ_mapper self typ
409101409101

409102409102
let class_type_mapper (self : mapper) ({pcty_attributes; pcty_loc} as ctd : Parsetree.class_type) =
409103-
match Ast_attributes.process_bs pcty_attributes with
409104-
| false, _ ->
409105-
default_mapper.class_type self ctd
409106-
| true, pcty_attributes ->
409107-
(match ctd.pcty_desc with
409108-
| Pcty_signature ({pcsig_self; pcsig_fields })
409109-
->
409110-
let pcsig_self = self.typ self pcsig_self in
409111-
{ctd with
409112-
pcty_desc = Pcty_signature {
409113-
pcsig_self ;
409114-
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
409115-
};
409116-
pcty_attributes
409117-
}
409118-
| Pcty_open _ (* let open M in CT *)
409119-
| Pcty_constr _
409120-
| Pcty_extension _
409121-
| Pcty_arrow _ ->
409122-
Location.raise_errorf ~loc:pcty_loc "invalid or unused attribute `bs`")
409103+
let pcty_attributes =
409104+
match Ast_attributes.process_bs pcty_attributes with
409105+
| false, _ ->
409106+
pcty_attributes
409107+
| true, pcty_attributes ->
409108+
Location.prerr_warning pcty_loc (Bs_ffi_warning "Here @bs attribute is not needed any more.");
409109+
pcty_attributes in
409110+
(match ctd.pcty_desc with
409111+
| Pcty_signature ({pcsig_self; pcsig_fields })
409112+
->
409113+
let pcsig_self = self.typ self pcsig_self in
409114+
{ctd with
409115+
pcty_desc = Pcty_signature {
409116+
pcsig_self ;
409117+
pcsig_fields = Ast_core_type_class_type.handle_class_type_fields self pcsig_fields
409118+
};
409119+
pcty_attributes
409120+
}
409121+
| Pcty_open _ (* let open M in CT *)
409122+
| Pcty_constr _
409123+
| Pcty_extension _
409124+
| Pcty_arrow _ ->
409125+
default_mapper.class_type self ctd)
409123409126
(* {[class x : int -> object
409124409127
end [@bs]
409125409128
]}

0 commit comments

Comments
 (0)