WIP - Try and transform jsx through compilation

compiler/core/j.ml

@@ -164,6 +164,7 @@ and expression_desc =
   | Null
   | Await of expression
   | Spread of expression
+  | Jsx_container_element of string * expression list
 
 and for_ident_expression = expression
 (* pure*)

compiler/core/js_analyzer.ml

@@ -118,6 +118,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
   | FlatCall _ | Call _ | New _ | Raw_js_code _ (* actually true? *) -> false
   | Await _ -> false
   | Spread _ -> false
+  | Jsx_container_element _ -> false
 
 and no_side_effect (x : J.expression) =
   no_side_effect_expression_desc x.expression_desc
@@ -232,6 +233,7 @@ let rec eq_expression ({expression_desc = x0} : J.expression)
   | Caml_block_tag _ | Object _ | Tagged_template _ | Await _ ->
     false
   | Spread _ -> false
+  | Jsx_container_element _ -> false
 
 and eq_expression_list xs ys = Ext_list.for_all2_no_exn xs ys eq_expression
 

compiler/core/js_dump.ml

@@ -174,6 +174,7 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) =
   | Tagged_template _ -> false
   | Optional_block (e, true) when arrow -> exp_need_paren ~arrow e
   | Optional_block _ -> false
+  | Jsx_container_element _ -> false
 
 (** Print as underscore for unused vars, may not be 
     needed in the future *)
@@ -955,6 +956,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
     P.cond_paren_group f (level > 13) (fun _ ->
         P.string f "...";
         expression ~level:13 cxt f e)
+  | Jsx_container_element (name, children) ->
+    P.string f (Format.sprintf "<%s></%s>" name name);
+    cxt
 
 and property_name_and_value_list cxt f (l : J.property_map) =
   iter_lst cxt f l

compiler/core/js_fold.ml

@@ -187,6 +187,7 @@ class fold =
       | Spread _x0 ->
         let _self = _self#expression _x0 in
         _self
+      | Jsx_container_element _ -> _self
 
     method for_ident_expression : for_ident_expression -> 'self_type =
       _self#expression

compiler/core/js_record_fold.ml

@@ -193,6 +193,9 @@ let expression_desc : 'a. ('a, expression_desc) fn =
   | Spread _x0 ->
     let st = _self.expression _self st _x0 in
     st
+  | Jsx_container_element (_x0, _x1) ->
+    let st = list _self.expression _self st _x1 in
+    st
 
 let for_ident_expression : 'a. ('a, for_ident_expression) fn =
  fun _self arg -> _self.expression _self arg

compiler/core/js_record_iter.ml

@@ -144,6 +144,7 @@ let expression_desc : expression_desc fn =
   | Null -> ()
   | Await _x0 -> _self.expression _self _x0
   | Spread _x0 -> _self.expression _self _x0
+  | Jsx_container_element (_, children) -> list _self.expression _self children
 
 let for_ident_expression : for_ident_expression fn =
  fun _self arg -> _self.expression _self arg

compiler/core/js_record_map.ml

@@ -191,6 +191,8 @@ let expression_desc : expression_desc fn =
   | Spread _x0 ->
     let _x0 = _self.expression _self _x0 in
     Spread _x0
+  | Jsx_container_element (name, children) ->
+    Jsx_container_element (name, children)
 
 let for_ident_expression : for_ident_expression fn =
  fun _self arg -> _self.expression _self arg

compiler/core/lam.ml

@@ -102,6 +102,7 @@ module Types = struct
     | Lwhile of t * t
     | Lfor of ident * t * t * Asttypes.direction_flag * t
     | Lassign of ident * t
+    | LJsx_container_element of (* name *) string * (* children *) t list
   (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *)
 end
 
@@ -149,6 +150,7 @@ module X = struct
     | Lwhile of t * t
     | Lfor of ident * t * t * Asttypes.direction_flag * t
     | Lassign of ident * t
+    | LJsx_container_element of (* name *) string * (* children *) t list
   (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *)
 end
 
@@ -239,6 +241,8 @@ let inner_map (l : t) (f : t -> X.t) : X.t =
   | Lassign (id, e) ->
     let e = f e in
     Lassign (id, e)
+  | LJsx_container_element (name, children) ->
+    LJsx_container_element (name, List.map f children)
 (* | Lsend (k, met, obj, args, loc) ->
    let met = f met in
    let obj = f obj in
@@ -392,6 +396,7 @@ let rec eq_approx (l1 : t) (l2 : t) =
   | Lletrec _ | Lswitch _ | Lstaticcatch _ | Ltrywith _
   | Lfor (_, _, _, _, _) ->
     false
+  | LJsx_container_element _ -> false
 
 and eq_option l1 l2 =
   match l1 with
@@ -444,6 +449,9 @@ let global_module ?(dynamic_import = false) id =
   Lglobal_module (id, dynamic_import)
 let const ct : t = Lconst ct
 
+let jsx_container_element name children : t =
+  LJsx_container_element (name, children)
+
 let function_ ~attr ~arity ~params ~body : t =
   Lfunction {arity; params; body; attr}
 

compiler/core/lam.mli

@@ -75,6 +75,7 @@ and t = private
   | Lwhile of t * t
   | Lfor of ident * t * t * Asttypes.direction_flag * t
   | Lassign of ident * t
+  | LJsx_container_element of (* name *) string * (* children *) t list
 
 (* | Lsend of Lambda.meth_kind * t * t * t list * Location.t *)
 (* | Levent of t * Lambda.lambda_event
@@ -161,3 +162,5 @@ val for_ : ident -> t -> t -> Asttypes.direction_flag -> t -> t
 (**************************************************************)
 
 val eq_approx : t -> t -> bool
+
+val jsx_container_element : string -> t list -> t

compiler/core/lam_analysis.ml

@@ -128,6 +128,10 @@ let rec no_side_effects (lam : Lam.t) : bool =
       } ->
     no_side_effects arg
   | Lapply _ -> false
+  | LJsx_container_element (name, children) ->
+    List.fold_left
+      (fun acc child -> acc || no_side_effects child)
+      false children
 (* we need purity analysis .. *)
 
 (*
@@ -180,6 +184,8 @@ let rec size (lam : Lam.t) =
     | Lwhile _ -> really_big ()
     | Lfor _ -> really_big ()
     | Lassign (_, v) -> 1 + size v
+    | LJsx_container_element (_, children) ->
+      Ext_list.fold_left children 1 (fun acc x -> size x + acc)
     (* This is side effectful,  be careful *)
     (* | Lsend _  ->  really_big () *)
   with Too_big_to_inline -> 1000

compiler/core/lam_arity_analysis.ml

@@ -132,6 +132,7 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) : Lam_arity.t =
   | Lsequence (_, l2) -> get_arity meta l2
   | Lstaticraise _ (* since it will not be in tail position *) -> Lam_arity.na
   | Lwhile _ | Lfor _ | Lassign _ -> Lam_arity.non_function_arity_info
+  | LJsx_container_element _ -> Lam_arity.non_function_arity_info
 
 and all_lambdas meta (xs : Lam.t list) =
   match xs with

compiler/core/lam_bounded_vars.ml

@@ -155,6 +155,8 @@ let rewrite (map : _ Hash_ident.t) (lam : Lam.t) : Lam.t =
       let l2 = aux l2 in
       Lam.while_ l1 l2
     | Lassign (v, l) -> Lam.assign v (aux l)
+    | LJsx_container_element (tag, children) ->
+      Lam.jsx_container_element tag (Ext_list.map children aux)
   in
   aux lam
 

compiler/core/lam_check.ml

@@ -87,6 +87,7 @@ let check file lam =
     | Lifthenelse (e1, e2, e3) -> check_list [e1; e2; e3] cxt
     | Lsequence (e1, e2) -> check_list [e1; e2] cxt
     | Lassign (_id, e) -> check_staticfails e cxt
+    | LJsx_container_element (_tag, children) -> check_list children cxt
   in
   let rec iter_list xs = Ext_list.iter xs iter
   and iter_list_snd : 'a. ('a * Lam.t) list -> unit =
@@ -149,6 +150,7 @@ let check file lam =
     | Lassign (id, e) ->
       use id;
       iter e
+    | LJsx_container_element (_tag, children) -> iter_list children
   in
   check_staticfails lam Set_int.empty;
   iter lam;

compiler/core/lam_closure.ml

@@ -137,6 +137,8 @@ let free_variables (export_idents : Set_ident.t) (params : stats Map_ident.t)
     | Lassign (id, e) ->
       used top id;
       iter top e
+    | LJsx_container_element (_, children) ->
+      List.iter (fun child -> iter sink_pos child) children
   in
   iter Lam_var_stats.fresh_env lam;
   !fv

compiler/core/lam_compile.ml

@@ -1822,6 +1822,16 @@ let compile output_prefix =
     | Ltrywith (lam, id, catch) ->
       (* generate documentation *)
       compile_trywith lam id catch lambda_cxt
+    | LJsx_container_element (name, children) ->
+      Js_output.make []
+        ~value:
+          {
+            expression_desc =
+              Jsx_container_element
+                (* Not sure how to proceed here *)
+                (name, []);
+            comment = None;
+          }
   in
 
   (compile_recursive_lets, compile_lambda)

compiler/core/lam_convert.ml

@@ -108,6 +108,7 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t) : bool =
     | Lifthenelse (e1, e2, e3) -> hit e1 || hit e2 || hit e3
     | Lsequence (e1, e2) -> hit e1 || hit e2
     | Lwhile (e1, e2) -> hit e1 || hit e2
+    | LJsx_container_element (_, children) -> hit_list children
   in
   hit l
 
@@ -506,6 +507,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     | Lfor (id, from_, to_, dir, loop) ->
       Lam.for_ id (convert_aux from_) (convert_aux to_) dir (convert_aux loop)
     | Lassign (id, body) -> Lam.assign id (convert_aux body)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (List.map convert_aux children)
   and convert_let (kind : Lam_compat.let_kind) id (e : Lambda.lambda) body :
       Lam.t =
     match (kind, e) with

compiler/core/lam_exit_count.ml

@@ -97,6 +97,7 @@ let count_helper (lam : Lam.t) : collection =
       count l2;
       count l3
     | Lassign (_, l) -> count l
+    | LJsx_container_element (_, children) -> List.iter count children
   and count_default sw =
     match sw.sw_failaction with
     | None -> ()

compiler/core/lam_free_variables.ml

@@ -86,6 +86,7 @@ let pass_free_variables (l : Lam.t) : Set_ident.t =
     | Lwhile (e1, e2) ->
       free e1;
       free e2
+    | LJsx_container_element (_, children) -> free_list children
   in
   free l;
   !fv

compiler/core/lam_hit.ml

@@ -56,6 +56,7 @@ let hit_variables (fv : Set_ident.t) (l : t) : bool =
     | Lifthenelse (e1, e2, e3) -> hit e1 || hit e2 || hit e3
     | Lsequence (e1, e2) -> hit e1 || hit e2
     | Lwhile (e1, e2) -> hit e1 || hit e2
+    | LJsx_container_element (_, children) -> hit_list children
   in
   hit l
 
@@ -91,5 +92,6 @@ let hit_variable (fv : Ident.t) (l : t) : bool =
     | Lifthenelse (e1, e2, e3) -> hit e1 || hit e2 || hit e3
     | Lsequence (e1, e2) -> hit e1 || hit e2
     | Lwhile (e1, e2) -> hit e1 || hit e2
+    | LJsx_container_element (_, children) -> hit_list children
   in
   hit l

compiler/core/lam_iter.ml

@@ -80,6 +80,7 @@ let inner_iter (l : t) (f : t -> unit) : unit =
     f e2;
     f e3
   | Lassign (_id, e) -> f e
+  | LJsx_container_element (name, children) -> List.iter f children
 
 let inner_exists (l : t) (f : t -> bool) : bool =
   match l with
@@ -113,3 +114,4 @@ let inner_exists (l : t) (f : t -> bool) : bool =
   | Lwhile (e1, e2) -> f e1 || f e2
   | Lfor (_v, e1, e2, _dir, e3) -> f e1 || f e2 || f e3
   | Lassign (_id, e) -> f e
+  | LJsx_container_element (name, children) -> Ext_list.exists children f

compiler/core/lam_pass_alpha_conversion.ml

@@ -119,6 +119,8 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refsimpl *)
       Lam.assign v (simpl l)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (Ext_list.map children simpl)
   in
 
   simpl lam

compiler/core/lam_pass_collect.ml

@@ -157,5 +157,6 @@ let collect_info (meta : Lam_stats.t) (lam : Lam.t) =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refcollect *)
       collect l
+    | LJsx_container_element (_, children) -> List.iter collect children
   in
   collect lam

compiler/core/lam_pass_count.ml

@@ -186,6 +186,7 @@ let collect_occurs lam : occ_tbl =
     | Lsequence (l1, l2) ->
       count bv l1;
       count bv l2
+    | LJsx_container_element (_, children) -> List.iter (count bv) children
   and count_default bv sw =
     match sw.sw_failaction with
     | None -> ()

compiler/core/lam_pass_deep_flatten.ml

@@ -266,5 +266,7 @@ let deep_flatten (lam : Lam.t) : Lam.t =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refaux *)
       Lam.assign v (aux l)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (Ext_list.map children aux)
   in
   aux lam

compiler/core/lam_pass_eliminate_ref.ml

@@ -98,3 +98,5 @@ let rec eliminate_ref id (lam : Lam.t) =
     Lam.for_ v (eliminate_ref id e1) (eliminate_ref id e2) dir
       (eliminate_ref id e3)
   | Lassign (v, e) -> Lam.assign v (eliminate_ref id e)
+  | LJsx_container_element (tag, children) ->
+    Lam.jsx_container_element tag (Ext_list.map children (eliminate_ref id))

compiler/core/lam_pass_exits.ml

@@ -56,6 +56,7 @@ and no_bounded_variables (l : Lam.t) =
   | Ltrywith _ -> false
   | Llet _ -> false
   | Lletrec (decl, body) -> decl = [] && no_bounded_variables body
+  | LJsx_container_element _ -> false
 
 (*
    TODO: 
@@ -233,6 +234,8 @@ let subst_helper (subst : subst_tbl) (query : int -> int) (lam : Lam.t) : Lam.t
     | Lfor (v, l1, l2, dir, l3) ->
       Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
     | Lassign (v, l) -> Lam.assign v (simplif l)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (List.map simplif children)
   in
   simplif lam
 

compiler/core/lam_pass_lets_dce.ml

@@ -201,6 +201,8 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
     | Lfor (v, l1, l2, dir, l3) ->
       Lam.for_ v (simplif l1) (simplif l2) dir (simplif l3)
     | Lassign (v, l) -> Lam.assign v (simplif l)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (Ext_list.map children simplif)
   in
   simplif lam
 

compiler/core/lam_pass_remove_alias.ml

@@ -265,5 +265,7 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
       (* Lalias-bound variables are never assigned, so don't increase
          v's refsimpl *)
       Lam.assign v (simpl l)
+    | LJsx_container_element (name, children) ->
+      Lam.jsx_container_element name (Ext_list.map children simpl)
   in
   simpl lam

compiler/core/lam_print.ml

@@ -410,6 +410,7 @@ let lambda ppf v =
         lam hi lam body
     | Lassign (id, expr) ->
       fprintf ppf "@[<2>(assign@ %a@ %a)@]" Ident.print id lam expr
+    | LJsx_container_element _ -> fprintf ppf "todo"
   and sequence ppf = function
     | Lsequence (l1, l2) -> fprintf ppf "%a@ %a" sequence l1 sequence l2
     | l -> lam ppf l

compiler/core/lam_scc.ml

@@ -61,6 +61,7 @@ let hit_mask (mask : Hash_set_ident_mask.t) (l : Lam.t) : bool =
     | Lifthenelse (e1, e2, e3) -> hit e1 || hit e2 || hit e3
     | Lsequence (e1, e2) -> hit e1 || hit e2
     | Lwhile (e1, e2) -> hit e1 || hit e2
+    | LJsx_container_element (_, children) -> hit_list children
   in
   hit l
 

compiler/core/lam_subst.ml

@@ -67,6 +67,8 @@ let subst (s : Lam.t Map_ident.t) lam =
     | Lfor (v, e1, e2, dir, e3) ->
       Lam.for_ v (subst_aux e1) (subst_aux e2) dir (subst_aux e3)
     | Lassign (id, e) -> Lam.assign id (subst_aux e)
+    | LJsx_container_element (tag, children) ->
+      Lam.jsx_container_element tag (Ext_list.map children subst_aux)
   and subst_decl (id, exp) = (id, subst_aux exp)
   and subst_case (key, case) = (key, subst_aux case)
   and subst_strcase (key, case) = (key, subst_aux case)