prop punning conversion

Author: nojaf

compiler/ml/ast_mapper_from0.ml

@@ -310,6 +310,10 @@ module E = struct
     in
     visit e
 
+  let skip_last_two_elements elements =
+    let length = List.length elements in
+    List.filteri (fun i _ -> i < length - 2) elements
+
   let map sub e =
     let {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = e in
     let open Exp in
@@ -330,10 +334,35 @@ module E = struct
         (map_opt (sub.expr sub) def)
         (sub.pat sub p) (sub.expr sub e)
     | Pexp_function _ -> assert false
-    | Pexp_apply ({pexp_desc = Pexp_ident tag_name}, _args)
+    | Pexp_apply ({pexp_desc = Pexp_ident tag_name}, args)
       when has_jsx_attribute () ->
       let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "JSX") in
-      jsx_unary_element ~loc ~attrs tag_name []
+      let props =
+        args
+        (* The last args are children and unit *)
+        |> skip_last_two_elements
+        |> List.filter_map (fun (lbl, e) ->
+               match (lbl, e) with
+               | ( Asttypes.Noloc.Labelled name,
+                   {
+                     pexp_desc = Pexp_ident {txt = Longident.Lident v};
+                     pexp_loc = name_loc;
+                   } )
+                 when name = v ->
+                 Some
+                   (Parsetree.JSXPropPunning
+                      (false, {txt = name; loc = name_loc}))
+               | ( Asttypes.Noloc.Optional name,
+                   {
+                     pexp_desc = Pexp_ident {txt = Longident.Lident v};
+                     pexp_loc = name_loc;
+                   } )
+                 when name = v ->
+                 Some
+                   (Parsetree.JSXPropPunning (true, {txt = name; loc = name_loc}))
+               | _ -> None)
+      in
+      jsx_unary_element ~loc ~attrs tag_name props
     | Pexp_apply (e, l) ->
       let e =
         match (e.pexp_desc, l) with

compiler/ml/ast_mapper_to0.ml

@@ -284,6 +284,29 @@ module E = struct
   let jsx_attr sub =
     sub.attribute sub (Location.mknoloc "JSX", Parsetree.PStr [])
 
+  let offset_position (pos : Lexing.position) (offset : int) : Lexing.position =
+    if offset <= 0 then pos
+    else
+      let open Lexing in
+      let rec aux pos offset =
+        if offset <= 0 then pos
+        else if offset <= pos.pos_cnum - pos.pos_bol then
+          (* We're on the same line *)
+          {pos with pos_cnum = pos.pos_cnum - offset}
+        else
+          (* Move to previous line and continue *)
+          let remaining = offset - (pos.pos_cnum - pos.pos_bol) in
+          aux
+            {
+              pos with
+              pos_lnum = pos.pos_lnum - 1;
+              pos_cnum = pos.pos_bol;
+              pos_bol = max 0 (pos.pos_bol - remaining);
+            }
+            remaining
+      in
+      aux pos offset
+
   (* Value expressions for the core language *)
 
   let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
@@ -426,24 +449,45 @@ module E = struct
 
       {mapped with pexp_attributes = jsx_attr sub :: attrs}
     | Pexp_jsx_unary_element
-        {
-          jsx_unary_element_tag_name = tag_name;
-          jsx_unary_element_props = _props;
-        } ->
+        {jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props}
+      ->
       let tag_ident = map_loc sub tag_name in
+      let props =
+        props
+        |> List.map (function
+             | JSXPropPunning (is_optional, name) ->
+               let ident =
+                 ident ~loc:name.loc
+                   {txt = Longident.Lident name.txt; loc = name.loc}
+               in
+               let label =
+                 if is_optional then Asttypes.Noloc.Optional name.txt
+                 else Asttypes.Noloc.Labelled name.txt
+               in
+               (label, ident)
+             | _ -> failwith "todo")
+      in
       let children_expr =
-        Ast_helper0.Exp.construct ~loc {txt = Lident "()"; loc} None
+        let loc =
+          {
+            loc_ghost = true;
+            loc_start = offset_position loc.loc_end 2;
+            loc_end = offset_position loc.loc_end 1;
+          }
+        in
+        Ast_helper0.Exp.construct ~loc {txt = Lident "[]"; loc} None
       in
       let unit_expr =
         Ast_helper0.Exp.construct ~loc:!Ast_helper0.default_loc
           {txt = Lident "()"; loc = !Ast_helper0.default_loc}
           None
       in
       apply ~loc ~attrs:(jsx_attr sub :: attrs) (ident tag_ident)
-        [
-          (Asttypes.Noloc.Labelled "children", children_expr);
-          (Asttypes.Noloc.Nolabel, unit_expr);
-        ]
+        (props
+        @ [
+            (Asttypes.Noloc.Labelled "children", children_expr);
+            (Asttypes.Noloc.Nolabel, unit_expr);
+          ])
     | Pexp_jsx_container_element _ ->
       failwith "TODO: Pexp_jsx_container_element 1"
 end