Skip to content

Commit d6c9fa8

Browse files
nojafnojaf
committed
Initial container element mapping.
1 parent 63fc87b commit d6c9fa8

File tree

2 files changed

+99
-75
lines changed

2 files changed

+99
-75
lines changed

‎compiler/ml/ast_mapper_from0.ml‎

Lines changed: 46 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -310,9 +310,45 @@ module E = struct
310310
in
311311
visit e
312312

313-
let skip_last_two_elements elements =
314-
let length = List.length elements in
315-
List.filteri (fun i _ -> i < length - 2) elements
313+
let try_map_jsx_prop (sub : mapper) (lbl : Asttypes.Noloc.arg_label)
314+
(e : expression) : Parsetree.jsx_prop option =
315+
match (lbl, e) with
316+
| Asttypes.Noloc.Labelled "_spreadProps", expr ->
317+
Some (Parsetree.JSXPropSpreading (Location.none, sub.expr sub expr))
318+
| ( Asttypes.Noloc.Labelled name,
319+
{pexp_desc = Pexp_ident {txt = Longident.Lident v}; pexp_loc = name_loc}
320+
)
321+
when name = v ->
322+
Some (Parsetree.JSXPropPunning (false, {txt = name; loc = name_loc}))
323+
| ( Asttypes.Noloc.Optional name,
324+
{pexp_desc = Pexp_ident {txt = Longident.Lident v}; pexp_loc = name_loc}
325+
)
326+
when name = v ->
327+
Some (Parsetree.JSXPropPunning (true, {txt = name; loc = name_loc}))
328+
| Asttypes.Noloc.Labelled name, exp ->
329+
Some
330+
(Parsetree.JSXPropValue
331+
({txt = name; loc = Location.none}, false, sub.expr sub exp))
332+
| Asttypes.Noloc.Optional name, exp ->
333+
Some
334+
(Parsetree.JSXPropValue
335+
({txt = name; loc = Location.none}, true, sub.expr sub exp))
336+
| _ -> None
337+
338+
let extract_props_and_children (sub : mapper) items =
339+
let rec visit props items =
340+
match items with
341+
| [] | [_] -> (List.rev props, None)
342+
| [(Asttypes.Noloc.Labelled "children", children_expr); _] ->
343+
( List.rev props,
344+
Some (Parsetree.JSXChildrenItems (map_jsx_list sub children_expr)) )
345+
| (lbl, e) :: rest -> (
346+
match try_map_jsx_prop sub lbl e with
347+
| Some prop -> visit (prop :: props) rest
348+
| None -> visit props rest)
349+
in
350+
let props, children = visit [] items in
351+
(props, children)
316352

317353
let map sub e =
318354
let {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = e in
@@ -335,47 +371,14 @@ module E = struct
335371
(sub.pat sub p) (sub.expr sub e)
336372
| Pexp_function _ -> assert false
337373
| Pexp_apply ({pexp_desc = Pexp_ident tag_name}, args)
338-
when has_jsx_attribute () ->
374+
when has_jsx_attribute () -> (
339375
let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "JSX") in
340-
let props =
341-
args
342-
(* The last args are children and unit *)
343-
|> skip_last_two_elements
344-
|> List.filter_map (fun (lbl, e) ->
345-
match (lbl, e) with
346-
| Asttypes.Noloc.Labelled "_spreadProps", expr ->
347-
Some
348-
(Parsetree.JSXPropSpreading (Location.none, sub.expr sub expr))
349-
| ( Asttypes.Noloc.Labelled name,
350-
{
351-
pexp_desc = Pexp_ident {txt = Longident.Lident v};
352-
pexp_loc = name_loc;
353-
} )
354-
when name = v ->
355-
Some
356-
(Parsetree.JSXPropPunning
357-
(false, {txt = name; loc = name_loc}))
358-
| ( Asttypes.Noloc.Optional name,
359-
{
360-
pexp_desc = Pexp_ident {txt = Longident.Lident v};
361-
pexp_loc = name_loc;
362-
} )
363-
when name = v ->
364-
Some
365-
(Parsetree.JSXPropPunning (true, {txt = name; loc = name_loc}))
366-
| Asttypes.Noloc.Labelled name, exp ->
367-
Some
368-
(Parsetree.JSXPropValue
369-
( {txt = name; loc = Location.none},
370-
false,
371-
sub.expr sub exp ))
372-
| Asttypes.Noloc.Optional name, exp ->
373-
Some
374-
(Parsetree.JSXPropValue
375-
({txt = name; loc = Location.none}, true, sub.expr sub exp))
376-
| _ -> None)
377-
in
378-
jsx_unary_element ~loc ~attrs tag_name props
376+
let props, children = extract_props_and_children sub args in
377+
match children with
378+
| None -> jsx_unary_element ~loc ~attrs tag_name props
379+
| Some children ->
380+
jsx_container_element ~loc ~attrs tag_name props Lexing.dummy_pos
381+
children None)
379382
| Pexp_apply (e, l) ->
380383
let e =
381384
match (e.pexp_desc, l) with

‎compiler/ml/ast_mapper_to0.ml‎

Lines changed: 53 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -307,6 +307,42 @@ module E = struct
307307
in
308308
aux pos offset
309309

310+
let jsx_unit_expr =
311+
Ast_helper0.Exp.construct ~loc:!Ast_helper0.default_loc
312+
{txt = Lident "()"; loc = !Ast_helper0.default_loc}
313+
None
314+
315+
let map_jsx_props sub props =
316+
props
317+
|> List.map (function
318+
| JSXPropPunning (is_optional, name) ->
319+
let ident =
320+
Exp.ident ~loc:name.loc
321+
{txt = Longident.Lident name.txt; loc = name.loc}
322+
in
323+
let label =
324+
if is_optional then Asttypes.Noloc.Optional name.txt
325+
else Asttypes.Noloc.Labelled name.txt
326+
in
327+
(label, ident)
328+
| JSXPropValue (name, is_optional, value) ->
329+
let label =
330+
if is_optional then Asttypes.Noloc.Optional name.txt
331+
else Asttypes.Noloc.Labelled name.txt
332+
in
333+
(label, sub.expr sub value)
334+
| JSXPropSpreading (_, value) ->
335+
(Asttypes.Noloc.Labelled "_spreadProps", sub.expr sub value))
336+
337+
let map_jsx_children sub loc children =
338+
let xs =
339+
match children with
340+
| JSXChildrenSpreading e -> [e]
341+
| JSXChildrenItems xs -> xs
342+
in
343+
let list_expr = Ast_helper.Exp.make_list_expression loc xs None in
344+
sub.expr sub list_expr
345+
310346
(* Value expressions for the core language *)
311347

312348
let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} =
@@ -439,41 +475,13 @@ module E = struct
439475
This is not the case in the old AST. There it is from >...</
440476
*)
441477
let loc = {loc with loc_start = o; loc_end = c} in
442-
let xs =
443-
match children with
444-
| JSXChildrenSpreading e -> [e]
445-
| JSXChildrenItems xs -> xs
446-
in
447-
let list_expr = Ast_helper.Exp.make_list_expression loc xs None in
448-
let mapped = sub.expr sub list_expr in
449-
478+
let mapped = map_jsx_children sub loc children in
450479
{mapped with pexp_attributes = jsx_attr sub :: attrs}
451480
| Pexp_jsx_unary_element
452481
{jsx_unary_element_tag_name = tag_name; jsx_unary_element_props = props}
453482
->
454483
let tag_ident = map_loc sub tag_name in
455-
let props =
456-
props
457-
|> List.map (function
458-
| JSXPropPunning (is_optional, name) ->
459-
let ident =
460-
ident ~loc:name.loc
461-
{txt = Longident.Lident name.txt; loc = name.loc}
462-
in
463-
let label =
464-
if is_optional then Asttypes.Noloc.Optional name.txt
465-
else Asttypes.Noloc.Labelled name.txt
466-
in
467-
(label, ident)
468-
| JSXPropValue (name, is_optional, value) ->
469-
let label =
470-
if is_optional then Asttypes.Noloc.Optional name.txt
471-
else Asttypes.Noloc.Labelled name.txt
472-
in
473-
(label, sub.expr sub value)
474-
| JSXPropSpreading (_, value) ->
475-
(Asttypes.Noloc.Labelled "_spreadProps", sub.expr sub value))
476-
in
484+
let props = map_jsx_props sub props in
477485
let children_expr =
478486
let loc =
479487
{
@@ -495,8 +503,21 @@ module E = struct
495503
(Asttypes.Noloc.Labelled "children", children_expr);
496504
(Asttypes.Noloc.Nolabel, unit_expr);
497505
])
498-
| Pexp_jsx_container_element _ ->
499-
failwith "TODO: Pexp_jsx_container_element 1"
506+
| Pexp_jsx_container_element
507+
{
508+
jsx_container_element_tag_name_start = tag_name;
509+
jsx_container_element_props = props;
510+
jsx_container_element_children = children;
511+
} ->
512+
let tag_ident = map_loc sub tag_name in
513+
let props = map_jsx_props sub props in
514+
let children_expr = map_jsx_children sub loc children in
515+
apply ~loc ~attrs:(jsx_attr sub :: attrs) (ident tag_ident)
516+
(props
517+
@ [
518+
(Asttypes.Noloc.Labelled "children", children_expr);
519+
(Asttypes.Noloc.Nolabel, jsx_unit_expr);
520+
])
500521
end
501522

502523
module P = struct

0 commit comments

Comments
 (0)