WIP - Extra app data

analysis/src/CompletionFrontEnd.ml

@@ -267,12 +267,14 @@ let rec exprToContextPathInner ~(inJsxContext : bool) (e : Parsetree.expression)
           };
         args =
           [(_, lhs); (_, {pexp_desc = Pexp_apply {funct = d; args; partial}})];
+        transformed_jsx;
       } ->
     (* Transform away pipe with apply call *)
     exprToContextPath ~inJsxContext
       {
         pexp_desc =
-          Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial};
+          Pexp_apply
+            {funct = d; args = (Nolabel, lhs) :: args; partial; transformed_jsx};
         pexp_loc;
         pexp_attributes;
       }
@@ -284,6 +286,7 @@ let rec exprToContextPathInner ~(inJsxContext : bool) (e : Parsetree.expression)
             (_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
           ];
         partial;
+        transformed_jsx;
       } ->
     (* Transform away pipe with identifier *)
     exprToContextPath ~inJsxContext
@@ -294,6 +297,7 @@ let rec exprToContextPathInner ~(inJsxContext : bool) (e : Parsetree.expression)
               funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes};
               args = [(Nolabel, lhs)];
               partial;
+              transformed_jsx;
             };
         pexp_loc;
         pexp_attributes;

compiler/core/js_call_info.ml

@@ -33,10 +33,16 @@ type call_info =
    {[ fun x y -> (f x y) === f ]} when [f] is an atom
 *)
 
-type t = {call_info: call_info; arity: arity}
+type t = {
+  call_info: call_info;
+  arity: arity;
+  call_transformed_jsx: Parsetree.jsx_element option;
+}
 
-let dummy = {arity = NA; call_info = Call_na}
+let dummy = {arity = NA; call_info = Call_na; call_transformed_jsx = None}
 
-let builtin_runtime_call = {arity = Full; call_info = Call_builtin_runtime}
+let builtin_runtime_call =
+  {arity = Full; call_info = Call_builtin_runtime; call_transformed_jsx = None}
 
-let ml_full_call = {arity = Full; call_info = Call_ml}
+let ml_full_call =
+  {arity = Full; call_info = Call_ml; call_transformed_jsx = None}

compiler/core/js_call_info.mli

@@ -35,7 +35,11 @@ type call_info =
    {[ fun x y -> f x y === f ]} when [f] is an atom
 *)
 
-type t = {call_info: call_info; arity: arity}
+type t = {
+  call_info: call_info;
+  arity: arity;
+  call_transformed_jsx: Parsetree.jsx_element option;
+}
 
 val dummy : t
 

compiler/core/js_dump.ml

@@ -524,7 +524,58 @@ and expression_desc cxt ~(level : int) f x : cxt =
          when Ext_list.length_equal el i
        ]}
     *)
+  | Call (e, el, {call_transformed_jsx = Some jsx_element}) -> (
+    match el with
+    | [
+     _tag;
+     {
+       expression_desc =
+         Caml_block (el, _mutable_flag, _, Lambda.Blk_record {fields});
+     };
+    ] -> (
+      let fields =
+        Ext_list.array_list_filter_map fields el (fun (f, opt) x ->
+            match x.expression_desc with
+            | Undefined _ when opt -> None
+            | _ -> Some (f, x))
+      in
+      match jsx_element with
+      | Parsetree.Jsx_container_element
+          {
+            jsx_container_element_tag_name_start =
+              {txt = Longident.Lident tagName};
+          } ->
+        P.string f (Format.sprintf "<%s" tagName);
+        List.iter
+          (fun (n, x) ->
+            P.space f;
+            P.string f n;
+            P.string f "=";
+            P.string f "{";
+            let _ = expression ~level:0 cxt f x in
+            P.string f "}")
+          fields;
+        P.string f "></";
+        P.string f tagName;
+        P.string f ">";
+        cxt
+      | _ ->
+        expression_desc cxt ~level f
+          (Call
+             ( e,
+               el,
+               {call_transformed_jsx = None; arity = Full; call_info = Call_ml}
+             )))
+    | _ ->
+      expression_desc cxt ~level f
+        (Call
+           ( e,
+             el,
+             {call_transformed_jsx = None; arity = Full; call_info = Call_ml} ))
+    )
   | 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
@@ -681,6 +732,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
     P.cond_paren_group f (level > 12) (fun _ ->
         let cxt = expression ~level:0 cxt f prop in
         P.string f " in ";
+        P.string f " in ";
         expression ~level:0 cxt f obj)
   | Typeof e ->
     P.string f "typeof";

compiler/core/jsx_help.ml

@@ -0,0 +1,46 @@
+let j_exp_to_string (e : J.expression) =
+  match e.J.expression_desc with
+  | J.Object _ -> "Object"
+  | J.Str _ -> "String"
+  | J.Var _ -> "Var"
+  | J.Call _ -> "Call"
+  | J.Fun _ -> "Fun"
+  | J.Array _ -> "Array"
+  | J.Bin _ -> "Bin"
+  | J.Cond _ -> "Cond"
+  | J.New _ -> "New"
+  | J.Seq _ -> "Seq"
+  | J.Number _ -> "Number"
+  | J.Bool _ -> "Bool"
+  | J.Null -> "Null"
+  | J.Undefined _ -> "Undefined"
+  | J.Is_null_or_undefined _ -> "Is_null_or_undefined"
+  | J.Js_not _ -> "Js_not"
+  | J.Typeof _ -> "Typeof"
+  | J.String_index _ -> "String_index"
+  | J.Array_index _ -> "Array_index"
+  | J.Static_index _ -> "Static_index"
+  | J.Length _ -> "Length"
+  | J.Caml_block _ -> "Caml_block"
+  | J.Caml_block_tag _ -> "Caml_block_tag"
+  | J.Tagged_template _ -> "Tagged_template"
+  | J.Optional_block _ -> "Optional_block"
+  | J.Spread _ -> "Spread"
+  | J.Await _ -> "Await"
+  | J.Raw_js_code _ -> "Raw_js_code"
+  | _ -> "Other"
+
+let lambda_tag_info_to_string (e : Lambda.tag_info) =
+  match e with
+  | Lambda.Blk_constructor _ -> "Blk_constructor"
+  | Lambda.Blk_record_inlined _ -> "Blk_record_inlined"
+  | Lambda.Blk_tuple -> "Blk_tuple"
+  | Lambda.Blk_poly_var _ -> "Blk_poly_var"
+  | Lambda.Blk_record _ -> "Blk_record"
+  | Lambda.Blk_module _ -> "Blk_module"
+  | Lambda.Blk_module_export _ -> "Blk_module_export"
+  | Lambda.Blk_extension -> "Blk_extension"
+  | Lambda.Blk_some -> "Blk_some"
+  | Lambda.Blk_some_not_nested -> "Blk_some_not_nested"
+  | Lambda.Blk_record_ext _ -> "Blk_record_ext"
+  | Lambda.Blk_lazy_general -> "Blk_lazy_general"

compiler/core/lam.ml

@@ -81,7 +81,12 @@ module Types = struct
   *)
   and prim_info = {primitive: Lam_primitive.t; args: t list; loc: Location.t}
 
-  and apply = {ap_func: t; ap_args: t list; ap_info: ap_info}
+  and apply = {
+    ap_func: t;
+    ap_args: t list;
+    ap_info: ap_info;
+    ap_transformed_jsx: Parsetree.jsx_element option;
+  }
 
   and t =
     | Lvar of ident
@@ -121,7 +126,12 @@ module X = struct
     loc: Location.t;
   }
 
-  and apply = Types.apply = {ap_func: t; ap_args: t list; ap_info: ap_info}
+  and apply = Types.apply = {
+    ap_func: t;
+    ap_args: t list;
+    ap_info: ap_info;
+    ap_transformed_jsx: Parsetree.jsx_element option;
+  }
 
   and lfunction = Types.lfunction = {
     arity: int;
@@ -159,10 +169,10 @@ include Types
 let inner_map (l : t) (f : t -> X.t) : X.t =
   match l with
   | Lvar (_ : ident) | Lconst (_ : Lam_constant.t) -> ((* Obj.magic *) l : X.t)
-  | Lapply {ap_func; ap_args; ap_info} ->
+  | Lapply {ap_func; ap_args; ap_info; ap_transformed_jsx} ->
     let ap_func = f ap_func in
     let ap_args = Ext_list.map ap_args f in
-    Lapply {ap_func; ap_args; ap_info}
+    Lapply {ap_func; ap_args; ap_info; ap_transformed_jsx}
   | Lfunction {body; arity; params; attr} ->
     let body = f body in
     Lfunction {body; arity; params; attr}
@@ -279,7 +289,7 @@ let rec is_eta_conversion_exn params inner_args outer_args : t list =
   | _, _, _ -> raise_notrace Not_simple_form
 
 (** FIXME: more robust inlining check later, we should inline it before we add stub code*)
-let rec apply fn args (ap_info : ap_info) : t =
+let rec apply ?(ap_transformed_jsx = None) fn args (ap_info : ap_info) : t =
   match fn with
   | Lfunction
       {
@@ -300,15 +310,16 @@ let rec apply fn args (ap_info : ap_info) : t =
       Lprim
         {primitive = wrap; args = [Lprim {primitive_call with args; loc}]; loc}
     | exception Not_simple_form ->
-      Lapply {ap_func = fn; ap_args = args; ap_info})
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
   | Lfunction
       {
         params;
         body = Lprim ({primitive = _; args = inner_args} as primitive_call);
       } -> (
     match is_eta_conversion_exn params inner_args args with
     | args -> Lprim {primitive_call with args; loc = ap_info.ap_loc}
-    | exception _ -> Lapply {ap_func = fn; ap_args = args; ap_info})
+    | exception _ ->
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
   | Lfunction
       {
         params;
@@ -321,17 +332,17 @@ let rec apply fn args (ap_info : ap_info) : t =
     | args ->
       Lsequence (Lprim {primitive_call with args; loc = ap_info.ap_loc}, const)
     | exception _ ->
-      Lapply {ap_func = fn; ap_args = args; ap_info}
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
       (* | Lfunction {params;body} when Ext_list.same_length params args ->
           Ext_list.fold_right2 (fun p arg acc ->
             Llet(Strict,p,arg,acc)
           ) params args body *)
       (* TODO: more rigirous analysis on [let_kind] *))
   | Llet (kind, id, e, (Lfunction _ as fn)) ->
-    Llet (kind, id, e, apply fn args ap_info)
+    Llet (kind, id, e, apply fn args ap_info ~ap_transformed_jsx)
   (* | Llet (kind0, id0, e0, Llet (kind,id, e, (Lfunction _ as fn))) ->
      Llet(kind0,id0,e0,Llet (kind, id, e, apply fn args loc status)) *)
-  | _ -> Lapply {ap_func = fn; ap_args = args; ap_info}
+  | _ -> Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
 
 let rec eq_approx (l1 : t) (l2 : t) =
   match l1 with
@@ -712,10 +723,12 @@ 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

@@ -41,7 +41,12 @@ type lambda_switch = {
   sw_names: Ast_untagged_variants.switch_names option;
 }
 
-and apply = private {ap_func: t; ap_args: t list; ap_info: ap_info}
+and apply = private {
+  ap_func: t;
+  ap_args: t list;
+  ap_info: ap_info;
+  ap_transformed_jsx: Parsetree.jsx_element option;
+}
 
 and lfunction = {
   arity: int;
@@ -85,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 ->
@@ -103,7 +109,12 @@ val global_module : ?dynamic_import:bool -> ident -> t
 
 val const : Lam_constant.t -> t
 
-val apply : t -> t list -> ap_info -> t
+val apply :
+  ?ap_transformed_jsx:Parsetree.jsx_element option ->
+  t ->
+  t list ->
+  ap_info ->
+  t
 
 val function_ :
   attr:Lambda.function_attribute ->

compiler/core/lam_bounded_vars.ml

@@ -108,10 +108,10 @@ let rewrite (map : _ Hash_ident.t) (lam : Lam.t) : Lam.t =
       (* here it makes sure that global vars are not rebound *)
       Lam.prim ~primitive ~args:(Ext_list.map args aux) loc
     | Lglobal_module _ -> lam
-    | Lapply {ap_func; ap_args; ap_info} ->
+    | Lapply {ap_func; ap_args; ap_info; ap_transformed_jsx} ->
       let fn = aux ap_func in
       let args = Ext_list.map ap_args aux in
-      Lam.apply fn args ap_info
+      Lam.apply ~ap_transformed_jsx fn args ap_info
     | Lswitch
         ( l,
           {