Skip to content

Commit 359b590

Browse files
bobzhangbobzhang
authored
Merge pull request rescript-lang#2280 from BuckleScript/interaction
isolate each ppx deriving to avoid name conflicts
2 parents 4756840 + 8f876ac commit 359b590

11 files changed

+317
-128
lines changed

‎jscomp/syntax/ast_derive.ml

+22-2
Original file line numberDiff line numberDiff line change
@@ -45,15 +45,15 @@ let register key value =
4545

4646

4747

48-
let gen_structure
48+
(* let gen_structure
4949
(tdcls : tdcls)
5050
(actions : Ast_payload.action list )
5151
(explict_nonrec : bool )
5252
: Ast_structure.t =
5353
Ext_list.flat_map
5454
(fun action ->
5555
(Ast_payload.table_dispatch !derive_table action).structure_gen
56-
tdcls explict_nonrec) actions
56+
tdcls explict_nonrec) actions *)
5757

5858
let gen_signature
5959
tdcls
@@ -74,3 +74,23 @@ let gen_expression ({Asttypes.txt ; loc}) typ =
7474
Bs_syntaxerr.err loc (Unregistered txt)
7575

7676
| Some f -> f typ
77+
78+
open Ast_helper
79+
let gen_structure_signature
80+
loc
81+
(tdcls : tdcls)
82+
(action : Ast_payload.action)
83+
(explicit_nonrec : bool) =
84+
let derive_table = !derive_table in
85+
let u =
86+
Ast_payload.table_dispatch derive_table action in
87+
88+
let a = u.structure_gen tdcls explicit_nonrec in
89+
let b = u.signature_gen tdcls explicit_nonrec in
90+
Str.include_ ~loc
91+
(Incl.mk ~loc
92+
(Mod.constraint_ ~loc
93+
(Mod.structure ~loc a)
94+
(Mty.signature ~loc b )
95+
)
96+
)

‎jscomp/syntax/ast_derive.mli

+12-3
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,11 @@ val register :
3939
(Parsetree.expression option -> gen) ->
4040
unit
4141

42-
val gen_structure:
42+
(* val gen_structure:
4343
tdcls ->
4444
Ast_payload.action list ->
4545
bool ->
46-
Ast_structure.t
46+
Ast_structure.t *)
4747

4848
val gen_signature:
4949
tdcls ->
@@ -53,6 +53,15 @@ val gen_signature:
5353

5454

5555
val gen_expression :
56-
string Asttypes.loc -> Parsetree.core_type -> Parsetree.expression
56+
string Asttypes.loc ->
57+
Parsetree.core_type ->
58+
Parsetree.expression
5759

5860

61+
62+
val gen_structure_signature :
63+
Location.t ->
64+
Parsetree.type_declaration list ->
65+
Ast_payload.action ->
66+
bool ->
67+
Parsetree.structure_item

‎jscomp/syntax/ast_derive_js_mapper.ml

+13-3
Original file line numberDiff line numberDiff line change
@@ -46,13 +46,23 @@ let handle_config (config : Parsetree.expression option) =
4646
| Pexp_record (
4747
[
4848
{txt = Lident "jsType"},
49-
{pexp_desc = Pexp_construct ({txt = Lident ("true" | "false" as x )}, None)}],None)
50-
-> x = "true"
49+
{pexp_desc =
50+
(Pexp_construct
51+
(
52+
{txt =
53+
Lident ("true"
54+
| "false"
55+
as x)}, None)
56+
| Pexp_ident {txt = Lident ("jsType" as x)}
57+
)
58+
}
59+
],None)
60+
-> not (x = "false")
5161
| _ -> invalid_config config)
5262
| None -> false
5363
let noloc = Location.none
5464
(* [eraseType] will be instrumented, be careful about the name conflict*)
55-
let eraseTypeLit = "eraseType"
65+
let eraseTypeLit = "jsMapperEraseType"
5666
let eraseTypeExp = Exp.ident {loc = noloc; txt = Lident eraseTypeLit}
5767
let eraseType x =
5868
Exp.apply eraseTypeExp ["", x]

‎jscomp/syntax/ast_structure.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ let fuse ?(loc=Location.none) (item : item ) (t : t) : item =
3232
Str.include_ ~loc
3333
(Incl.mk ~loc (Mod.structure ~loc (item :: t) ))
3434

35-
let fuse_with_constraint
35+
(* let fuse_with_constraint
3636
?(loc=Location.none)
3737
(item : Parsetree.type_declaration list ) (t : t) (coercion) =
3838
Str.include_ ~loc
@@ -45,7 +45,7 @@ let fuse_with_constraint
4545
({psig_loc = loc; psig_desc = Psig_type item} :: coercion)
4646
)
4747
)
48-
)
48+
) *)
4949
let constraint_ ?(loc=Location.none) (stru : t) (sign : Ast_signature.t) =
5050
Str.include_ ~loc
5151
(Incl.mk ~loc

‎jscomp/syntax/ast_structure.mli

+2-2
Original file line numberDiff line numberDiff line change
@@ -29,11 +29,11 @@ type t = item list
2929

3030
val fuse: ?loc:Ast_helper.loc -> item -> t -> item
3131

32-
val fuse_with_constraint:
32+
(* val fuse_with_constraint:
3333
?loc:Ast_helper.loc ->
3434
Parsetree.type_declaration list ->
3535
t ->
3636
Ast_signature.t ->
37-
item
37+
item *)
3838

3939
val constraint_ : ?loc:Ast_helper.loc -> t -> Ast_signature.t -> item

‎jscomp/syntax/ppx_entry.ml

+13-15
Original file line numberDiff line numberDiff line change
@@ -550,7 +550,9 @@ let rec unsafe_mapper : Ast_mapper.mapper =
550550
begin match Ast_attributes.iter_process_derive_type
551551
(Ext_list.last tdcls).ptype_attributes with
552552
| {bs_deriving = Some actions; explict_nonrec}
553-
-> Ast_signature.fuse sigi
553+
->
554+
let loc = sigi.psig_loc in
555+
Ast_signature.fuse ~loc sigi
554556
(self.signature
555557
self
556558
(Ast_derive.gen_signature tdcls actions explict_nonrec))
@@ -610,21 +612,17 @@ let rec unsafe_mapper : Ast_mapper.mapper =
610612
((Ext_list.last tdcls).ptype_attributes) with
611613
| {bs_deriving = Some actions;
612614
explict_nonrec
613-
} ->
614-
(* let new_tdcls = (** FIXME: mark as used instead of dropping*)
615-
(Ext_list.map_last (fun last tdcl ->
616-
if last then
617-
self.type_declaration self {tdcl with ptype_attributes}
618-
else
619-
self.type_declaration self tdcl) tdcls) in *)
620-
Ast_structure.fuse_with_constraint
621-
~loc:str.pstr_loc
622-
tdcls
615+
} ->
616+
let loc = str.pstr_loc in
617+
Ast_structure.fuse ~loc
618+
str
623619
(self.structure self
624-
(Ast_derive.gen_structure
625-
tdcls actions explict_nonrec ))
626-
(self.signature self
627-
(Ast_derive.gen_signature tdcls actions explict_nonrec))
620+
(List.map
621+
(fun action ->
622+
Ast_derive.gen_structure_signature
623+
loc
624+
tdcls action explict_nonrec
625+
) actions))
628626
| {bs_deriving = None } ->
629627
Ast_mapper.default_mapper.structure_item self str
630628
end

‎jscomp/test/ast_abstract_test.js

+52-19
Original file line numberDiff line numberDiff line change
@@ -97,23 +97,56 @@ function cFromJs(param) {
9797

9898
var c0 = 3;
9999

100-
exports.tToJs = tToJs;
101-
exports.tFromJs = tFromJs;
102-
exports.v0 = v0;
103-
exports.v1 = v1;
104-
exports.xToJs = xToJs;
105-
exports.xFromJs = xFromJs;
106-
exports.x0 = x0;
107-
exports.x1 = x1;
108-
exports.aToJs = aToJs;
109-
exports.aFromJs = aFromJs;
110-
exports.a0 = a0;
111-
exports.a1 = a1;
112-
exports.bToJs = bToJs;
113-
exports.bFromJs = bFromJs;
114-
exports.b0 = b0;
115-
exports.b1 = b1;
116-
exports.cToJs = cToJs;
117-
exports.cFromJs = cFromJs;
118-
exports.c0 = c0;
100+
function hToJs(param) {
101+
return param + 0 | 0;
102+
}
103+
104+
function hFromJs(param) {
105+
return param - 0 | 0;
106+
}
107+
108+
function zToJs(param) {
109+
return param + 0 | 0;
110+
}
111+
112+
function zFromJs(param) {
113+
if (param <= 2 && 0 <= param) {
114+
return /* Some */[param - 0 | 0];
115+
} else {
116+
return /* None */0;
117+
}
118+
}
119+
120+
var jsMapperEraseType = /* JsMapperEraseType */0;
121+
122+
var b = /* B */1;
123+
124+
var zXx = /* ZXx */2;
125+
126+
exports.tToJs = tToJs;
127+
exports.tFromJs = tFromJs;
128+
exports.v0 = v0;
129+
exports.v1 = v1;
130+
exports.xToJs = xToJs;
131+
exports.xFromJs = xFromJs;
132+
exports.x0 = x0;
133+
exports.x1 = x1;
134+
exports.aToJs = aToJs;
135+
exports.aFromJs = aFromJs;
136+
exports.a0 = a0;
137+
exports.a1 = a1;
138+
exports.bToJs = bToJs;
139+
exports.bFromJs = bFromJs;
140+
exports.b0 = b0;
141+
exports.b1 = b1;
142+
exports.cToJs = cToJs;
143+
exports.cFromJs = cFromJs;
144+
exports.c0 = c0;
145+
exports.jsMapperEraseType = jsMapperEraseType;
146+
exports.b = b;
147+
exports.hToJs = hToJs;
148+
exports.hFromJs = hFromJs;
149+
exports.zXx = zXx;
150+
exports.zToJs = zToJs;
151+
exports.zFromJs = zFromJs;
119152
/* x0 Not a pure module */

‎jscomp/test/ast_abstract_test.ml

+15-1
Original file line numberDiff line numberDiff line change
@@ -53,8 +53,22 @@ type c =
5353
| D1
5454
| D2
5555
| D3
56-
[@@bs.deriving {jsMapper = {jsType = true}}]
56+
[@@bs.deriving {jsMapper = {jsType }}]
5757

5858
let c0 = cToJs D0
5959

6060

61+
type h =
62+
| JsMapperEraseType
63+
| B [@@bs.deriving {accessors; jsMapper = {jsType = true}} ]
64+
65+
66+
type z =
67+
| ZFromJs
68+
| ZToJs
69+
| ZXx (* not overridden *)
70+
[@@bs.deriving {
71+
accessors;
72+
jsMapper
73+
}
74+
]

0 commit comments

Comments
 (0)