Skip to content

Commit d6e4a51

Browse files
bobzhangbobzhang
authored
Merge pull request #2687 from BuckleScript/abstract_type_use_bs_optional_for_less_surprise
explicit for less surprise
2 parents 75e124b + 07b6ea2 commit d6e4a51

File tree

9 files changed

+294
-196
lines changed

9 files changed

+294
-196
lines changed

‎jscomp/core/jsoo_main.ml

Lines changed: 1 addition & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -126,19 +126,11 @@ let implementation prefix impl str : Js.Unsafe.obj =
126126

127127

128128

129-
let string_of_fmt (f : Format.formatter -> 'a -> unit) v =
130-
let buf = Buffer.create 37 in
131-
let fmt = Format.formatter_of_buffer buf in
132-
let () =
133-
f fmt v;
134-
Format.pp_print_flush fmt () in
135-
Buffer.contents buf
136-
137129
let compile impl : string -> Js.Unsafe.obj =
138130
implementation false impl
139131
(** TODO: add `[@@bs.config{no_export}]\n# 1 "repl.ml"`*)
140132
let shake_compile impl : string -> Js.Unsafe.obj =
141-
implementation true impl
133+
implementation true impl
142134

143135

144136

‎jscomp/syntax/ast_attributes.ml

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -240,6 +240,20 @@ let iter_process_bs_string_as (attrs : t) : string option =
240240
) attrs;
241241
!st
242242

243+
let has_bs_optional (attrs : t) : bool =
244+
List.exists
245+
(fun
246+
(({txt ; loc}, _payload ) as attr : attr) ->
247+
match txt with
248+
| "bs.optional"
249+
->
250+
Bs_ast_invariant.mark_used_bs_attribute attr ;
251+
true
252+
| _ -> false
253+
) attrs
254+
255+
256+
243257
let iter_process_bs_int_as attrs =
244258
let st = ref None in
245259
List.iter

‎jscomp/syntax/ast_attributes.mli

Lines changed: 32 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
2-
*
2+
*
33
* This program is free software: you can redistribute it and/or modify
44
* it under the terms of the GNU Lesser General Public License as published by
55
* the Free Software Foundation, either version 3 of the License, or
@@ -17,67 +17,70 @@
1717
* but WITHOUT ANY WARRANTY; without even the implied warranty of
1818
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1919
* GNU Lesser General Public License for more details.
20-
*
20+
*
2121
* You should have received a copy of the GNU Lesser General Public License
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424
type attr = Parsetree.attribute
25-
type t = attr list
25+
type t = attr list
2626

27-
type ('a,'b) st =
28-
{ get : 'a option ;
27+
type ('a,'b) st =
28+
{ get : 'a option ;
2929
set : 'b option }
3030

31-
val process_method_attributes_rev :
31+
val process_method_attributes_rev :
3232
t ->
33-
(bool * bool , [`Get | `No_get ]) st * t
33+
(bool * bool , [`Get | `No_get ]) st * t
3434

35-
val process_attributes_rev :
36-
t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t
35+
val process_attributes_rev :
36+
t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t
3737

3838
val process_pexp_fun_attributes_rev :
39-
t -> [ `Nothing | `Exn ] * t
40-
val process_bs :
41-
t -> [ `Nothing | `Has] * t
39+
t -> [ `Nothing | `Exn ] * t
40+
val process_bs :
41+
t -> [ `Nothing | `Has] * t
4242

43-
val process_external : t -> bool
43+
val process_external : t -> bool
4444

4545
type derive_attr = {
4646
explict_nonrec : bool;
47-
bs_deriving : Ast_payload.action list option
47+
bs_deriving : Ast_payload.action list option
4848
}
4949
val process_bs_string_int_unwrap_uncurry :
5050
t -> [`Nothing | `String | `Int | `Ignore | `Unwrap | `Uncurry of int option ] * t
5151

5252

5353
val iter_process_bs_string_as :
54-
t -> string option
54+
t -> string option
5555

56-
val iter_process_bs_int_as :
57-
t -> int option
56+
val has_bs_optional :
57+
t -> bool
5858

59+
val iter_process_bs_int_as :
60+
t -> int option
5961

60-
val iter_process_bs_string_or_int_as :
62+
63+
val iter_process_bs_string_or_int_as :
6164
t ->
62-
[ `Int of int
65+
[ `Int of int
6366
| `Str of string
64-
| `Json_str of string ] option
65-
67+
| `Json_str of string ] option
68+
6669

67-
val process_derive_type :
68-
t -> derive_attr * t
70+
val process_derive_type :
71+
t -> derive_attr * t
6972

70-
val iter_process_derive_type :
71-
t -> derive_attr
73+
val iter_process_derive_type :
74+
t -> derive_attr
7275

7376

74-
val bs : attr
77+
val bs : attr
7578
val is_bs : attr -> bool
7679
val bs_this : attr
7780
val bs_method : attr
78-
val bs_obj : attr
81+
val bs_obj : attr
7982

8083

81-
val bs_get : attr
84+
val bs_get : attr
8285
val bs_set : attr
83-
val bs_return_undefined : attr
86+
val bs_return_undefined : attr

‎jscomp/syntax/ast_core_type.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,10 @@ let is_array (ty : t) =
9898

9999
let is_user_option (ty : t) =
100100
match ty.ptyp_desc with
101-
| Ptyp_constr({txt = Lident "option"},[_]) -> true
101+
| Ptyp_constr(
102+
{txt = Lident "option" |
103+
(Ldot (Lident "*predef*", "option")) },
104+
[_]) -> true
102105
| _ -> false
103106

104107
let is_user_bool (ty : t) =

‎jscomp/syntax/ast_derive_abstract.ml

Lines changed: 14 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -74,8 +74,8 @@ let handleTdcl (tdcl : Parsetree.type_declaration) =
7474
| Ptype_record label_declarations ->
7575
let is_private = tdcl.ptype_private = Private in
7676
let has_optional_field =
77-
List.exists (fun ({pld_type} : Parsetree.label_declaration) ->
78-
Ast_core_type.is_user_option pld_type
77+
List.exists (fun ({pld_type; pld_attributes} : Parsetree.label_declaration) ->
78+
Ast_attributes.has_bs_optional pld_attributes
7979
) label_declarations in
8080
let setter_accessor, makeType, labels =
8181
Ext_list.fold_right
@@ -97,9 +97,16 @@ let handleTdcl (tdcl : Parsetree.type_declaration) =
9797
| Some new_name ->
9898
[new_name], {pld_name with txt = new_name}
9999
in
100-
let is_option = Ast_core_type.is_user_option pld_type in
101-
let getter_type =
102-
Typ.arrow ~loc "" core_type pld_type in
100+
let is_option = Ast_attributes.has_bs_optional pld_attributes in
101+
let maker, getter_type =
102+
if is_option then
103+
let optional_type = Ast_core_type.lift_option_type pld_type in
104+
Ast_core_type.opt_arrow pld_loc label_name optional_type maker,
105+
Typ.arrow ~loc "" core_type optional_type
106+
else
107+
Typ.arrow ~loc:pld_loc label_name pld_type maker,
108+
Typ.arrow ~loc "" core_type pld_type
109+
in
103110
let acc =
104111
Val.mk pld_name
105112
~attrs:(
@@ -112,9 +119,7 @@ let handleTdcl (tdcl : Parsetree.type_declaration) =
112119
let setter_type =
113120
(Typ.arrow "" core_type
114121
(Typ.arrow ""
115-
(if is_option then
116-
Ast_core_type.extract_option_type_exn pld_type
117-
else pld_type)
122+
pld_type (* setter *)
118123
(Ast_literal.type_unit ()))) in
119124
Val.mk
120125
{loc = label_loc; txt = label_name ^ "Set"}
@@ -124,10 +129,7 @@ let handleTdcl (tdcl : Parsetree.type_declaration) =
124129
:: acc
125130
else acc in
126131
acc,
127-
(if is_option then
128-
Ast_core_type.opt_arrow pld_loc label_name pld_type maker
129-
else Typ.arrow ~loc:pld_loc label_name pld_type maker
130-
),
132+
maker,
131133
(is_option, newLabel)::labels
132134
) label_declarations
133135
([],

‎jscomp/test/gpr_2614_test.ml

Lines changed: 37 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -28,8 +28,9 @@ let ff () =
2828

2929

3030
type a = {
31-
mutable low : string option
32-
[@bs.as "lo-x"]
31+
mutable low : string
32+
[@bs.optional]
33+
[@bs.as "lo-x"]
3334
;
3435
hi : int
3536
} [@@bs.deriving abstract]
@@ -62,25 +63,42 @@ let hh2 x =
6263
| None -> 0
6364
| Some _ -> 1
6465

66+
6567
type css =
6668
{
67-
a0 : int option ;
68-
a1 : int option ;
69-
a2 : int option ;
70-
a3 : int option ;
71-
a4 : int option ;
72-
a5 : int option ;
73-
a6 : int option ;
74-
a7 : int option ;
75-
a8 : int option ;
76-
a9 : int option
69+
a0 : int
70+
[@bs.optional] ;
71+
a1 : int
72+
[@bs.optional];
73+
a2 : int
74+
[@bs.optional];
75+
a3 : int
76+
[@bs.optional];
77+
a4 : int
78+
[@bs.optional];
79+
a5 : int
80+
[@bs.optional];
81+
a6 : int
82+
[@bs.optional];
83+
a7 : int
84+
[@bs.optional];
85+
a8 : int
86+
[@bs.optional];
87+
a9 : int
88+
[@bs.optional]
7789
[@bs.as "xx-yy"];
78-
a10 : int option ;
79-
a11 : int option ;
80-
a12 : int option ;
81-
a13 : int option ;
82-
a14 : int option ;
83-
a15 : int option ;
90+
a10 : int
91+
[@bs.optional];
92+
a11 : int
93+
[@bs.optional];
94+
a12 : int
95+
[@bs.optional];
96+
a13 : int
97+
[@bs.optional];
98+
a14 : int
99+
[@bs.optional];
100+
a15 : int
101+
[@bs.optional] ;
84102
}
85103
[@@bs.deriving abstract]
86104

@@ -89,4 +107,4 @@ let u = css ~a9:3 ()
89107
let v =
90108
match u |. a9 with
91109
| None -> 0
92-
| Some x -> x
110+
| Some x -> x

0 commit comments

Comments
 (0)