@@ -1354,6 +1354,13 @@ module Labeled_tuples = struct
1354
1354
labeled_components, ptyp_attributes
1355
1355
| _ -> Desugaring_error. raise typ.ptyp_loc Malformed
1356
1356
1357
+ (* We wrap labeled tuple expressions in an additional extension node
1358
+ so that tools that inspect the OCaml syntax tree are less likely
1359
+ to treat a labeled tuple as a regular tuple.
1360
+ *)
1361
+ let labeled_tuple_extension_node_name =
1362
+ Embedded_name. of_feature feature [] |> Embedded_name. to_string
1363
+
1357
1364
let expr_of ~loc el =
1358
1365
match check_for_any_label el with
1359
1366
| No_labels el -> Ast_helper.Exp. tuple ~loc el
@@ -1362,15 +1369,21 @@ module Labeled_tuples = struct
1362
1369
Expression. make_entire_jane_syntax ~loc feature (fun () ->
1363
1370
let names = List. map (fun (label , _ ) -> string_of_label label) el in
1364
1371
Expression. make_jane_syntax feature names
1365
- @@ Ast_helper.Exp. tuple (List. map snd el))
1372
+ @@ Ast_helper.Exp. apply
1373
+ (Ast_helper.Exp. extension
1374
+ (Location. mknoloc labeled_tuple_extension_node_name, PStr [] ))
1375
+ [Nolabel , Ast_helper.Exp. tuple (List. map snd el)])
1366
1376
1367
1377
(* Returns remaining unconsumed attributes *)
1368
1378
let of_expr expr =
1369
1379
let labels, pexp_attributes =
1370
1380
expand_labeled_tuple_extension expr.pexp_loc expr.pexp_attributes
1371
1381
in
1372
1382
match expr.pexp_desc with
1373
- | Pexp_tuple components ->
1383
+ | Pexp_apply
1384
+ ( { pexp_desc = Pexp_extension (name, PStr [] ) },
1385
+ [(Nolabel , { pexp_desc = Pexp_tuple components; _ })] )
1386
+ when String. equal name.txt labeled_tuple_extension_node_name ->
1374
1387
if List. length labels <> List. length components
1375
1388
then Desugaring_error. raise expr.pexp_loc Malformed ;
1376
1389
let labeled_components =
0 commit comments