Skip to content

Commit 22c10ed

Browse files
nojafnojaf
committed
Transform initial simple element
1 parent fb543e4 commit 22c10ed

File tree

12 files changed

+199
-42
lines changed

12 files changed

+199
-42
lines changed

‎compiler/core/js_dump.ml‎

Lines changed: 51 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -524,13 +524,58 @@ and expression_desc cxt ~(level : int) f x : cxt =
524524
when Ext_list.length_equal el i
525525
]}
526526
*)
527-
| Call (e, el, {call_transformed_jsx = Some jsx_element}) ->
528-
(* The grand point would be to reconstruct the JSX here *)
529-
P.string f "<meh />";
530-
cxt
527+
| Call (e, el, {call_transformed_jsx = Some jsx_element}) -> (
528+
match el with
529+
| [
530+
_tag;
531+
{
532+
expression_desc =
533+
Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
534+
};
535+
] -> (
536+
let fields =
537+
Ext_list.array_list_filter_map fields el (fun (f, opt) x ->
538+
match x.expression_desc with
539+
| Undefined _ when opt -> None
540+
| _ -> Some (f, x))
541+
in
542+
match jsx_element with
543+
| Parsetree.Jsx_container_element
544+
{
545+
jsx_container_element_tag_name_start =
546+
{txt = Longident.Lident tagName};
547+
} ->
548+
P.string f (Format.sprintf "<%s" tagName);
549+
List.iter
550+
(fun (n, x) ->
551+
P.space f;
552+
P.string f n;
553+
P.string f "=";
554+
P.string f "{";
555+
let _ = expression ~level:0 cxt f x in
556+
P.string f "}")
557+
fields;
558+
P.string f "></";
559+
P.string f tagName;
560+
P.string f ">";
561+
cxt
562+
| _ ->
563+
expression_desc cxt ~level f
564+
(Call
565+
( e,
566+
el,
567+
{call_transformed_jsx = None; arity = Full; call_info = Call_ml}
568+
)))
569+
| _ ->
570+
expression_desc cxt ~level f
571+
(Call
572+
( e,
573+
el,
574+
{call_transformed_jsx = None; arity = Full; call_info = Call_ml} ))
575+
)
531576
| Call (e, el, info) ->
532577
Format.fprintf Format.err_formatter "Js_dump Has transformed_jsx %b\n"
533-
(Option.is_some info.call_transformed_jsx);
578+
(Option.is_some info.call_transformed_jsx);
534579
P.cond_paren_group f (level > 15) (fun _ ->
535580
P.group f 0 (fun _ ->
536581
match (info, el) with
@@ -687,6 +732,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
687732
P.cond_paren_group f (level > 12) (fun _ ->
688733
let cxt = expression ~level:0 cxt f prop in
689734
P.string f " in ";
735+
P.string f " in ";
690736
expression ~level:0 cxt f obj)
691737
| Typeof e ->
692738
P.string f "typeof";

‎compiler/core/jsx_help.ml‎

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
let j_exp_to_string (e : J.expression) =
2+
match e.J.expression_desc with
3+
| J.Object _ -> "Object"
4+
| J.Str _ -> "String"
5+
| J.Var _ -> "Var"
6+
| J.Call _ -> "Call"
7+
| J.Fun _ -> "Fun"
8+
| J.Array _ -> "Array"
9+
| J.Bin _ -> "Bin"
10+
| J.Cond _ -> "Cond"
11+
| J.New _ -> "New"
12+
| J.Seq _ -> "Seq"
13+
| J.Number _ -> "Number"
14+
| J.Bool _ -> "Bool"
15+
| J.Null -> "Null"
16+
| J.Undefined _ -> "Undefined"
17+
| J.Is_null_or_undefined _ -> "Is_null_or_undefined"
18+
| J.Js_not _ -> "Js_not"
19+
| J.Typeof _ -> "Typeof"
20+
| J.String_index _ -> "String_index"
21+
| J.Array_index _ -> "Array_index"
22+
| J.Static_index _ -> "Static_index"
23+
| J.Length _ -> "Length"
24+
| J.Caml_block _ -> "Caml_block"
25+
| J.Caml_block_tag _ -> "Caml_block_tag"
26+
| J.Tagged_template _ -> "Tagged_template"
27+
| J.Optional_block _ -> "Optional_block"
28+
| J.Spread _ -> "Spread"
29+
| J.Await _ -> "Await"
30+
| J.Raw_js_code _ -> "Raw_js_code"
31+
| _ -> "Other"
32+
33+
let lambda_tag_info_to_string (e : Lambda.tag_info) =
34+
match e with
35+
| Lambda.Blk_constructor _ -> "Blk_constructor"
36+
| Lambda.Blk_record_inlined _ -> "Blk_record_inlined"
37+
| Lambda.Blk_tuple -> "Blk_tuple"
38+
| Lambda.Blk_poly_var _ -> "Blk_poly_var"
39+
| Lambda.Blk_record _ -> "Blk_record"
40+
| Lambda.Blk_module _ -> "Blk_module"
41+
| Lambda.Blk_module_export _ -> "Blk_module_export"
42+
| Lambda.Blk_extension -> "Blk_extension"
43+
| Lambda.Blk_some -> "Blk_some"
44+
| Lambda.Blk_some_not_nested -> "Blk_some_not_nested"
45+
| Lambda.Blk_record_ext _ -> "Blk_record_ext"
46+
| Lambda.Blk_lazy_general -> "Blk_lazy_general"

‎compiler/core/lam.ml‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -723,10 +723,12 @@ let result_wrap loc (result_type : External_ffi_types.return_wrapper) result =
723723
prim ~primitive:Pundefined_to_opt ~args:[result] loc
724724
| Return_unset | Return_identity -> result
725725

726-
let handle_bs_non_obj_ffi ?transformed_jsx (arg_types : External_arg_spec.params)
726+
let handle_bs_non_obj_ffi ?transformed_jsx
727+
(arg_types : External_arg_spec.params)
727728
(result_type : External_ffi_types.return_wrapper) ffi args loc prim_name
728729
~dynamic_import =
729730
result_wrap loc result_type
730731
(prim
731-
~primitive:(Pjs_call {prim_name; arg_types; ffi; dynamic_import; transformed_jsx})
732+
~primitive:
733+
(Pjs_call {prim_name; arg_types; ffi; dynamic_import; transformed_jsx})
732734
~args loc)

‎compiler/core/lam_compile_external_call.ml‎

Lines changed: 43 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -267,7 +267,8 @@ let translate_scoped_access scopes obj =
267267
| [] -> obj
268268
| x :: xs -> Ext_list.fold_left xs (E.dot obj x) E.dot
269269

270-
let translate_ffi (cxt : Lam_compile_context.t) arg_types
270+
let translate_ffi ?(transformed_jsx : Parsetree.jsx_element option)
271+
(cxt : Lam_compile_context.t) arg_types
271272
(ffi : External_ffi_types.external_spec) (args : J.expression list)
272273
~dynamic_import =
273274
match ffi with
@@ -290,7 +291,11 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
290291
add_eff eff
291292
(E.call
292293
~info:
293-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
294+
{
295+
arity = Full;
296+
call_info = Call_na;
297+
call_transformed_jsx = transformed_jsx;
298+
}
294299
fn args))
295300
| Js_call
296301
{
@@ -309,14 +314,22 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
309314
add_eff eff
310315
(E.call
311316
~info:
312-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
317+
{
318+
arity = Full;
319+
call_info = Call_na;
320+
call_transformed_jsx = transformed_jsx;
321+
}
313322
fn args)
314323
else
315324
let args, eff = assemble_args_no_splice arg_types args in
316325
add_eff eff
317326
@@ E.call
318327
~info:
319-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
328+
{
329+
arity = Full;
330+
call_info = Call_na;
331+
call_transformed_jsx = transformed_jsx;
332+
}
320333
fn args
321334
| Js_module_as_fn {external_module_name; splice} ->
322335
let fn = external_var external_module_name ~dynamic_import in
@@ -326,15 +339,23 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
326339
add_eff eff
327340
(E.call
328341
~info:
329-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
342+
{
343+
arity = Full;
344+
call_info = Call_na;
345+
call_transformed_jsx = transformed_jsx;
346+
}
330347
fn args)
331348
else
332349
let args, eff = assemble_args_no_splice arg_types args in
333350
(* TODO: fix in rest calling convention *)
334351
add_eff eff
335352
(E.call
336353
~info:
337-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
354+
{
355+
arity = Full;
356+
call_info = Call_na;
357+
call_transformed_jsx = transformed_jsx;
358+
}
338359
fn args)
339360
| Js_new {external_module_name = module_name; name = fn; splice; scopes} ->
340361
(* handle [@@new]*)
@@ -383,15 +404,23 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
383404
(let self = translate_scoped_access js_send_scopes self in
384405
E.call
385406
~info:
386-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
407+
{
408+
arity = Full;
409+
call_info = Call_na;
410+
call_transformed_jsx = transformed_jsx;
411+
}
387412
(E.dot self name) args)
388413
else
389414
let args, eff = assemble_args_no_splice arg_types args in
390415
add_eff eff
391416
(let self = translate_scoped_access js_send_scopes self in
392417
E.call
393418
~info:
394-
{arity = Full; call_info = Call_na; call_transformed_jsx = None}
419+
{
420+
arity = Full;
421+
call_info = Call_na;
422+
call_transformed_jsx = transformed_jsx;
423+
}
395424
(E.dot self name) args)
396425
| _ -> assert false)
397426
| Js_module_as_var module_name -> external_var module_name ~dynamic_import
@@ -408,7 +437,12 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
408437
if args = [] then e
409438
else
410439
E.call
411-
~info:{arity = Full; call_info = Call_na; call_transformed_jsx = None}
440+
~info:
441+
{
442+
arity = Full;
443+
call_info = Call_na;
444+
call_transformed_jsx = transformed_jsx;
445+
}
412446
e args
413447
| Js_module_as_class module_name ->
414448
let fn = external_var module_name ~dynamic_import in

‎compiler/core/lam_compile_external_call.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ val ocaml_to_js_eff :
3030
(** Compile ocaml external function call to JS IR. *)
3131

3232
val translate_ffi :
33+
?transformed_jsx:Parsetree.jsx_element ->
3334
Lam_compile_context.t ->
3435
External_arg_spec.params ->
3536
External_ffi_types.external_spec ->

‎compiler/core/lam_compile_primitive.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -597,9 +597,9 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
597597
(* Lam_compile_external_call.translate loc cxt prim args *)
598598
(* Test if the argument is a block or an immediate integer *)
599599
| Pjs_object_create _ -> assert false
600-
| Pjs_call {arg_types; ffi; dynamic_import} ->
600+
| Pjs_call {arg_types; ffi; dynamic_import; transformed_jsx} ->
601601
Lam_compile_external_call.translate_ffi cxt arg_types ffi args
602-
~dynamic_import
602+
~dynamic_import ?transformed_jsx
603603
(* FIXME, this can be removed later *)
604604
| Pisint -> E.is_type_number (Ext_list.singleton_exn args)
605605
| Pis_poly_var_block -> E.is_type_object (Ext_list.singleton_exn args)

‎compiler/core/lam_convert.ml‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -373,8 +373,9 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
373373
let exit_map = Hash_int.create 0 in
374374
let may_depends = Lam_module_ident.Hash_set.create 0 in
375375

376-
let rec convert_ccall ?(transformed_jsx = None) (a_prim : Primitive.description)
377-
(args : Lambda.lambda list) loc ~dynamic_import : Lam.t =
376+
let rec convert_ccall ?(transformed_jsx = None)
377+
(a_prim : Primitive.description) (args : Lambda.lambda list) loc
378+
~dynamic_import : Lam.t =
378379
let prim_name = a_prim.prim_name in
379380
match External_ffi_types.from_string a_prim.prim_native_name with
380381
| Ffi_obj_create labels ->
@@ -388,8 +389,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
388389
| Param_number i -> Ext_list.init i (fun _ -> External_arg_spec.dummy)
389390
in
390391
let args = Ext_list.map args convert_aux in
391-
Lam.handle_bs_non_obj_ffi ?transformed_jsx arg_types result_type ffi args loc prim_name
392-
~dynamic_import
392+
Lam.handle_bs_non_obj_ffi ?transformed_jsx arg_types result_type ffi args
393+
loc prim_name ~dynamic_import
393394
| Ffi_inline_const i -> Lam.const i
394395
| Ffi_normal ->
395396
Location.raise_errorf ~loc
@@ -455,7 +456,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
455456
| Lprim (Pdirapply, _, _, _) -> assert false
456457
| Lprim (Pccall a, args, loc, transformed_jsx) ->
457458
Format.fprintf Format.err_formatter
458-
"lam convert Pccall Has transformed_jsx %b\n" (Option.is_some transformed_jsx);
459+
"lam convert Pccall Has transformed_jsx %b\n"
460+
(Option.is_some transformed_jsx);
459461
convert_ccall ~transformed_jsx a args loc ~dynamic_import
460462
| Lprim (Pjs_raw_expr, args, loc, _) -> (
461463
match args with

‎compiler/core/polyvar_pattern_match.ml‎

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,8 @@ let or_list (arg : lam) (hash_names : (int * string) list) =
6565
Lprim
6666
( Pintcomp Ceq,
6767
[arg; Lconst (Const_pointer (hash, Pt_variant {name}))],
68-
Location.none, None )
68+
Location.none,
69+
None )
6970
in
7071
Ext_list.fold_left rest init (fun acc (hash, name) ->
7172
Lambda.Lprim
@@ -75,9 +76,11 @@ let or_list (arg : lam) (hash_names : (int * string) list) =
7576
Lprim
7677
( Pintcomp Ceq,
7778
[arg; Lconst (Const_pointer (hash, Pt_variant {name}))],
78-
Location.none , None );
79+
Location.none,
80+
None );
7981
],
80-
Location.none, None ))
82+
Location.none,
83+
None ))
8184
| _ -> assert false
8285

8386
let make_test_sequence_variant_constant (fail : lam option) (arg : lam)

‎compiler/ml/lambda.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -357,7 +357,7 @@ type lambda =
357357
| Lfunction of lfunction
358358
| Llet of let_kind * value_kind * Ident.t * lambda * lambda
359359
| Lletrec of (Ident.t * lambda) list * lambda
360-
| Lprim of primitive * lambda list * Location.t * Parsetree.jsx_element option
360+
| Lprim of primitive * lambda list * Location.t * Parsetree.jsx_element option
361361
| Lswitch of lambda * lambda_switch * Location.t
362362
| Lstringswitch of
363363
lambda * (string * lambda) list * lambda option * Location.t
@@ -624,7 +624,8 @@ let rec transl_normal_path = function
624624
Lprim
625625
( Pfield (pos, Fld_module {name = s}),
626626
[transl_normal_path p],
627-
Location.none , None)
627+
Location.none,
628+
None )
628629
| Papply _ -> assert false
629630

630631
(* Translation of identifiers *)

0 commit comments

Comments
 (0)