Skip to content

Commit 4785d1a

Browse files
bobzhangbobzhang
committed
finish the new conversion scheme
Ideally, we don't need such conversion for polyvar, this is for leagcy
1 parent 1e19497 commit 4785d1a

File tree

1 file changed

+74
-77
lines changed

1 file changed

+74
-77
lines changed

‎jscomp/syntax/ast_derive_js_mapper.ml

Lines changed: 74 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ let handle_config (config : Parsetree.expression option) =
6060
| None -> false
6161
let noloc = Location.none
6262
(* [eraseType] will be instrumented, be careful about the name conflict*)
63-
let eraseTypeLit = "jsMapperEraseType"
63+
let eraseTypeLit = "_eraseType"
6464
let eraseTypeExp = Exp.ident {loc = noloc; txt = Lident eraseTypeLit}
6565
let eraseType x =
6666
Ast_compatible.app1 eraseTypeExp x
@@ -70,7 +70,57 @@ let eraseTypeStr =
7070
(Val.mk ~prim:["%identity"] {loc = noloc; txt = eraseTypeLit}
7171
(Ast_compatible.arrow any any)
7272
)
73+
let unsafeIndex = "_index"
74+
let unsafeIndexGet =
75+
Str.primitive
76+
(Val.mk ~prim:[""] {loc = noloc; txt = unsafeIndex} ~attrs:[Ast_attributes.bs_get_index]
77+
(Ast_compatible.arrow (Typ.var "b") (Ast_compatible.arrow (Typ.var "a") (Typ.var "c")))
78+
)
79+
80+
(* JavaScript has allowed trailing commas in array literals since the beginning,
81+
and later added them to object literals (ECMAScript 5) and most recently (ECMAScript 2017)
82+
to function parameters. *)
83+
let add_key_value buf key value last =
84+
Ext_buffer.add_char_string buf '"' key;
85+
Ext_buffer.add_string buf "\":\"";
86+
Ext_buffer.add_string buf value;
87+
if last then
88+
Ext_buffer.add_string buf "\""
89+
else
90+
Ext_buffer.add_string buf "\","
7391

92+
let buildMap (row_fields : Parsetree.row_field list) =
93+
let has_bs_as = ref false in
94+
let data, revData =
95+
let buf = Ext_buffer.create 50 in
96+
let revBuf = Ext_buffer.create 50 in
97+
Ext_buffer.add_string buf "{";
98+
Ext_buffer.add_string revBuf "{";
99+
let rec aux (row_fields : Parsetree.row_field list) =
100+
match row_fields with
101+
| [] -> ()
102+
| tag :: rest ->
103+
(match tag with
104+
| Rtag ({txt}, attrs, _, []) ->
105+
let name : string =
106+
match Ast_attributes.iter_process_bs_string_as attrs with
107+
| Some name ->
108+
has_bs_as := true;
109+
name
110+
| None -> txt in
111+
let last = rest = [] in
112+
add_key_value buf txt name last ;
113+
add_key_value revBuf name txt last
114+
| _ -> assert false (* checked by [is_enum_polyvar] *)
115+
); aux rest
116+
in
117+
aux row_fields;
118+
Ext_buffer.add_string buf "}" ;
119+
Ext_buffer.add_string revBuf "}" ;
120+
Ext_buffer.contents buf, Ext_buffer.contents revBuf
121+
in
122+
data,revData, !has_bs_as
123+
let app1 = Ast_compatible.app1
74124
let app2 = Ast_compatible.app2
75125
let app3 = Ast_compatible.app3
76126

@@ -222,89 +272,36 @@ let init () =
222272
| Ptype_abstract ->
223273
(match Ast_polyvar.is_enum_polyvar tdcl with
224274
| Some row_fields ->
225-
let expConstantArray =
226-
Exp.ident {loc; txt = Longident.Lident constantArray} in
227-
(* let has_bs_as = ref false in *)
228-
let result : _ list =
229-
Ext_list.map row_fields (fun tag ->
230-
match tag with
231-
| Rtag ({txt}, attrs, _, []) ->
232-
(txt,
233-
match Ast_attributes.iter_process_bs_string_as_ast attrs with
234-
| Some name ->
235-
name
236-
| None ->
237-
Ast_compatible.const_exp_string txt
238-
)
239-
| _ -> assert false (* checked by [is_enum_polyvar] *)
240-
) in
241-
let result_len = List.length result in
242-
let exp_len = Ast_compatible.const_exp_int result_len in
243-
let search upper polyvar array =
244-
app3
245-
(Exp.ident ({loc = noloc;
246-
txt = Longident.Ldot (jsMapperRt,"binarySearch") })
247-
)
248-
upper
249-
(eraseType polyvar)
250-
array in
251-
let revSearch len constantArray exp =
252-
app3
253-
(Exp.ident
254-
{loc= noloc;
255-
txt = Longident.Ldot (jsMapperRt, "revSearch")})
256-
len
257-
constantArray
258-
exp in
259-
let revSearchAssert len constantArray exp =
260-
app3
261-
(Exp.ident
262-
{loc= noloc;
263-
txt = Longident.Ldot (jsMapperRt, "revSearchAssert")})
264-
len
265-
constantArray
266-
exp in
267-
275+
let map, revMap = "_map", "_revMap" in
276+
let expMap = Exp.ident {loc; txt = Lident map} in
277+
let revExpMap = Exp.ident {loc ; txt = Lident revMap} in
278+
let data, revData, has_bs_as = buildMap row_fields in
279+
let exp_get = (Exp.ident {loc ; txt = Lident unsafeIndex}) in
268280
let v = [
269-
eraseTypeStr;
281+
eraseTypeStr;
282+
unsafeIndexGet;
283+
Ast_comb.single_non_rec_value
284+
{loc; txt = map}
285+
(Exp.extension ({txt = "raw";loc}, PStr [Str.eval (Exp.constant(Const.string data))]));
270286
Ast_comb.single_non_rec_value
271-
{loc; txt = constantArray}
272-
(Exp.array
273-
(Ext_list.map (List.sort (fun (a,_) (b,_) -> compare (a: Ast_compatible.hash_label) b) result)
274-
(fun (i,str) ->
275-
Exp.tuple
276-
[
277-
Ast_compatible.const_hash_label i;
278-
str
279-
]
280-
) ));
281-
(
282-
toJsBody
283-
(coerceResultToNewType
284-
(search
285-
exp_len
286-
exp_param
287-
expConstantArray
288-
))
289-
);
287+
{loc; txt = revMap}
288+
(if has_bs_as then
289+
(Exp.extension ({txt = "raw";loc}, PStr [Str.eval (Exp.constant(Const.string revData))]))
290+
else expMap);
291+
toJsBody
292+
(if has_bs_as then
293+
app2 exp_get expMap exp_param
294+
else app1 eraseTypeExp exp_param)
295+
;
290296
Ast_comb.single_non_rec_value
291297
patFromJs
292298
(Ast_compatible.fun_
293299
(Pat.var pat_param)
294-
(if createType then
295-
revSearchAssert
296-
exp_len
297-
expConstantArray
298-
(exp_param +: newType)
299-
+>
300-
core_type
301-
else
302-
revSearch
303-
exp_len
304-
expConstantArray
300+
(
301+
app2
302+
exp_get
303+
revExpMap
305304
exp_param
306-
+>
307-
Ast_core_type.lift_option_type core_type
308305
)
309306
)
310307
] in

0 commit comments

Comments
 (0)