Follow Lprim

Author: nojaf

compiler/core/js_dump.ml

@@ -529,6 +529,8 @@ and expression_desc cxt ~(level : int) f x : cxt =
     P.string f "<meh />";
     cxt
   | Call (e, el, info) ->
+    Format.fprintf Format.err_formatter "Js_dump Has transformed_jsx %b\n"
+    (Option.is_some info.call_transformed_jsx);
     P.cond_paren_group f (level > 15) (fun _ ->
         P.group f 0 (fun _ ->
             match (info, el) with

compiler/core/lam.ml

@@ -723,10 +723,10 @@ let result_wrap loc (result_type : External_ffi_types.return_wrapper) result =
     prim ~primitive:Pundefined_to_opt ~args:[result] loc
   | Return_unset | Return_identity -> result
 
-let handle_bs_non_obj_ffi (arg_types : External_arg_spec.params)
+let handle_bs_non_obj_ffi ?transformed_jsx (arg_types : External_arg_spec.params)
     (result_type : External_ffi_types.return_wrapper) ffi args loc prim_name
     ~dynamic_import =
   result_wrap loc result_type
     (prim
-       ~primitive:(Pjs_call {prim_name; arg_types; ffi; dynamic_import})
+       ~primitive:(Pjs_call {prim_name; arg_types; ffi; dynamic_import; transformed_jsx})
        ~args loc)

compiler/core/lam.mli

@@ -90,6 +90,7 @@ and t = private
 val inner_map : t -> (t -> t) -> t
 
 val handle_bs_non_obj_ffi :
+  ?transformed_jsx:Parsetree.jsx_element ->
   External_arg_spec.params ->
   External_ffi_types.return_wrapper ->
   External_ffi_types.external_spec ->

compiler/core/lam_convert.ml

@@ -348,8 +348,8 @@ let rec rename_optional_parameters map params (body : Lambda.lambda) =
         value_kind,
         id,
         Lifthenelse
-          ( Lprim (p, [Lvar ({name = "*opt*"} as opt)], p_loc),
-            Lprim (p1, [Lvar ({name = "*opt*"} as opt2)], x_loc),
+          ( Lprim (p, [Lvar ({name = "*opt*"} as opt)], p_loc, p_tj),
+            Lprim (p1, [Lvar ({name = "*opt*"} as opt2)], x_loc, x_tj),
             f ),
         rest )
     when Ident.same opt opt2 && List.mem opt params ->
@@ -361,8 +361,8 @@ let rec rename_optional_parameters map params (body : Lambda.lambda) =
           value_kind,
           id,
           Lifthenelse
-            ( Lprim (p, [Lvar new_id], p_loc),
-              Lprim (p1, [Lvar new_id], x_loc),
+            ( Lprim (p, [Lvar new_id], p_loc, p_tj),
+              Lprim (p1, [Lvar new_id], x_loc, x_tj),
               f ),
           rest ) )
   | _ -> (map, body)
@@ -373,21 +373,22 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
   let exit_map = Hash_int.create 0 in
   let may_depends = Lam_module_ident.Hash_set.create 0 in
 
-  let rec convert_ccall (a_prim : Primitive.description)
+  let rec convert_ccall ?(transformed_jsx = None) (a_prim : Primitive.description)
       (args : Lambda.lambda list) loc ~dynamic_import : Lam.t =
     let prim_name = a_prim.prim_name in
     match External_ffi_types.from_string a_prim.prim_native_name with
     | Ffi_obj_create labels ->
       let args = Ext_list.map args convert_aux in
       prim ~primitive:(Pjs_object_create labels) ~args loc
     | Ffi_bs (arg_types, result_type, ffi) ->
+      Format.fprintf Format.err_formatter "Ffi_bs\n";
       let arg_types =
         match arg_types with
         | Params ls -> ls
         | Param_number i -> Ext_list.init i (fun _ -> External_arg_spec.dummy)
       in
       let args = Ext_list.map args convert_aux in
-      Lam.handle_bs_non_obj_ffi arg_types result_type ffi args loc prim_name
+      Lam.handle_bs_non_obj_ffi ?transformed_jsx arg_types result_type ffi args loc prim_name
         ~dynamic_import
     | Ffi_inline_const i -> Lam.const i
     | Ffi_normal ->
@@ -447,39 +448,42 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
       let lam = Lam.letrec bindings body in
       Lam_scc.scc bindings lam body
     (* inlining will affect how mututal recursive behave *)
-    | Lprim (Prevapply, [x; f], outer_loc) | Lprim (Pdirapply, [f; x], outer_loc)
-      ->
+    | Lprim (Prevapply, [x; f], outer_loc, _)
+    | Lprim (Pdirapply, [f; x], outer_loc, _) ->
       convert_pipe f x outer_loc
-    | Lprim (Prevapply, _, _) -> assert false
-    | Lprim (Pdirapply, _, _) -> assert false
-    | Lprim (Pccall a, args, loc) -> convert_ccall a args loc ~dynamic_import
-    | Lprim (Pjs_raw_expr, args, loc) -> (
+    | Lprim (Prevapply, _, _, _) -> assert false
+    | Lprim (Pdirapply, _, _, _) -> assert false
+    | Lprim (Pccall a, args, loc, transformed_jsx) ->
+      Format.fprintf Format.err_formatter
+        "lam convert Pccall Has transformed_jsx %b\n" (Option.is_some transformed_jsx);
+      convert_ccall ~transformed_jsx a args loc ~dynamic_import
+    | Lprim (Pjs_raw_expr, args, loc, _) -> (
       match args with
       | [Lconst (Const_base (Const_string (code, _)))] ->
         (* js parsing here *)
         let kind = Classify_function.classify code in
         prim ~primitive:(Praw_js_code {code; code_info = Exp kind}) ~args:[] loc
       | _ -> assert false)
-    | Lprim (Pjs_raw_stmt, args, loc) -> (
+    | Lprim (Pjs_raw_stmt, args, loc, _) -> (
       match args with
       | [Lconst (Const_base (Const_string (code, _)))] ->
         let kind = Classify_function.classify_stmt code in
         prim
           ~primitive:(Praw_js_code {code; code_info = Stmt kind})
           ~args:[] loc
       | _ -> assert false)
-    | Lprim (Pgetglobal id, args, _) ->
+    | Lprim (Pgetglobal id, args, _, _) ->
       let args = Ext_list.map args convert_aux in
       if Ident.is_predef_exn id then
         Lam.const (Const_string {s = id.name; unicode = false})
       else (
         may_depend may_depends (Lam_module_ident.of_ml ~dynamic_import id);
         assert (args = []);
         Lam.global_module ~dynamic_import id)
-    | Lprim (Pimport, args, loc) ->
+    | Lprim (Pimport, args, loc, _) ->
       let args = Ext_list.map args (convert_aux ~dynamic_import:true) in
       lam_prim ~primitive:Pimport ~args loc
-    | Lprim (primitive, args, loc) ->
+    | Lprim (primitive, args, loc, tj) ->
       let args = Ext_list.map args (convert_aux ~dynamic_import) in
       lam_prim ~primitive ~args loc
     | Lswitch (e, s, _loc) -> convert_switch e s

compiler/core/lam_primitive.ml

@@ -46,6 +46,7 @@ type t =
       arg_types: External_arg_spec.params;
       ffi: External_ffi_types.external_spec;
       dynamic_import: bool;
+      transformed_jsx: Parsetree.jsx_element option;
     }
   | Pjs_object_create of External_arg_spec.obj_params
   (* Exceptions *)
@@ -250,7 +251,7 @@ let eq_primitive_approx (lhs : t) (rhs : t) =
     | Pmakeblock (i1, info1, flag1) ->
       i0 = i1 && flag0 = flag1 && eq_tag_info info0 info1
     | _ -> false)
-  | Pjs_call {prim_name; arg_types; ffi; dynamic_import} -> (
+  | Pjs_call {prim_name; arg_types; ffi; dynamic_import; _} -> (
     match rhs with
     | Pjs_call rhs ->
       prim_name = rhs.prim_name && arg_types = rhs.arg_types && ffi = rhs.ffi

compiler/core/lam_primitive.mli

@@ -42,6 +42,7 @@ type t =
       arg_types: External_arg_spec.params;
       ffi: External_ffi_types.external_spec;
       dynamic_import: bool;
+      transformed_jsx: Parsetree.jsx_element option;
     }
   | Pjs_object_create of External_arg_spec.obj_params
   | Praise

compiler/core/polyvar_pattern_match.ml

@@ -65,7 +65,7 @@ let or_list (arg : lam) (hash_names : (int * string) list) =
       Lprim
         ( Pintcomp Ceq,
           [arg; Lconst (Const_pointer (hash, Pt_variant {name}))],
-          Location.none )
+          Location.none, None )
     in
     Ext_list.fold_left rest init (fun acc (hash, name) ->
         Lambda.Lprim
@@ -75,9 +75,9 @@ let or_list (arg : lam) (hash_names : (int * string) list) =
               Lprim
                 ( Pintcomp Ceq,
                   [arg; Lconst (Const_pointer (hash, Pt_variant {name}))],
-                  Location.none );
+                  Location.none , None );
             ],
-            Location.none ))
+            Location.none, None ))
   | _ -> assert false
 
 let make_test_sequence_variant_constant (fail : lam option) (arg : lam)
@@ -111,5 +111,5 @@ let call_switcher_variant_constr (loc : Location.t) (fail : lam option)
     ( Alias,
       Pgenval,
       v,
-      Lprim (Pfield (0, Fld_poly_var_tag), [arg], loc),
+      Lprim (Pfield (0, Fld_poly_var_tag), [arg], loc, None),
       call_switcher_variant_constant loc fail (Lvar v) int_lambda_list names )

compiler/frontend/bs_ast_mapper.ml

@@ -330,8 +330,8 @@ module E = struct
       fun_ ~loc ~attrs ~arity ~async lab
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
-    | Pexp_apply {funct = e; args = l; partial} ->
-      apply ~loc ~attrs ~partial (sub.expr sub e)
+    | Pexp_apply {funct = e; args = l; partial; transformed_jsx} ->
+      apply ~loc ~attrs ~partial ?transformed_jsx (sub.expr sub e)
         (List.map (map_snd (sub.expr sub)) l)
     | Pexp_match (e, pel) ->
       match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

compiler/ml/lambda.ml

@@ -357,7 +357,7 @@ type lambda =
   | Lfunction of lfunction
   | Llet of let_kind * value_kind * Ident.t * lambda * lambda
   | Lletrec of (Ident.t * lambda) list * lambda
-  | Lprim of primitive * lambda list * Location.t
+  | Lprim of primitive * lambda list * Location.t * Parsetree.jsx_element option 
   | Lswitch of lambda * lambda_switch * Location.t
   | Lstringswitch of
       lambda * (string * lambda) list * lambda option * Location.t
@@ -462,7 +462,7 @@ let make_key e =
       let ex = tr_rec env ex in
       let y = make_key x in
       Llet (str, k, y, ex, tr_rec (Ident.add x (Lvar y) env) e)
-    | Lprim (p, es, _) -> Lprim (p, tr_recs env es, Location.none)
+    | Lprim (p, es, _, tj) -> Lprim (p, tr_recs env es, Location.none, tj)
     | Lswitch (e, sw, loc) -> Lswitch (tr_rec env e, tr_sw env sw, loc)
     | Lstringswitch (e, sw, d, _) ->
       Lstringswitch
@@ -520,7 +520,7 @@ let iter f = function
   | Lletrec (decl, body) ->
     f body;
     List.iter (fun (_id, exp) -> f exp) decl
-  | Lprim (_p, args, _loc) -> List.iter f args
+  | Lprim (_p, args, _loc, _tj) -> List.iter f args
   | Lswitch (arg, sw, _) ->
     f arg;
     List.iter (fun (_key, case) -> f case) sw.sw_consts;
@@ -618,13 +618,13 @@ let rec patch_guarded patch = function
 
 let rec transl_normal_path = function
   | Path.Pident id ->
-    if Ident.global id then Lprim (Pgetglobal id, [], Location.none)
+    if Ident.global id then Lprim (Pgetglobal id, [], Location.none, None)
     else Lvar id
   | Pdot (p, s, pos) ->
     Lprim
       ( Pfield (pos, Fld_module {name = s}),
         [transl_normal_path p],
-        Location.none )
+        Location.none , None)
   | Papply _ -> assert false
 
 (* Translation of identifiers *)
@@ -658,7 +658,7 @@ let subst_lambda s lam =
       Lfunction {params; body = subst body; attr; loc}
     | Llet (str, k, id, arg, body) -> Llet (str, k, id, subst arg, subst body)
     | Lletrec (decl, body) -> Lletrec (List.map subst_decl decl, subst body)
-    | Lprim (p, args, loc) -> Lprim (p, List.map subst args, loc)
+    | Lprim (p, args, loc, tj) -> Lprim (p, List.map subst args, loc, tj)
     | Lswitch (arg, sw, loc) ->
       Lswitch
         ( subst arg,

compiler/ml/lambda.mli

@@ -324,7 +324,7 @@ type lambda =
   | Lfunction of lfunction
   | Llet of let_kind * value_kind * Ident.t * lambda * lambda
   | Lletrec of (Ident.t * lambda) list * lambda
-  | Lprim of primitive * lambda list * Location.t
+  | Lprim of primitive * lambda list * Location.t * Parsetree.jsx_element option
   | Lswitch of lambda * lambda_switch * Location.t
   (* switch on strings, clauses are sorted by string order,
      strings are pairwise distinct *)