Labeled Tuples (#2009)

* Labeled tuples

* A couple minor error message improvements

* Turn on labeled tuples by default

* Delete some CRs in ocamldoc - we don't care about this tool

* Move source test to correct location

* Final nits

* Add test with attribute

* Add more attributes in tests

* Address review feedback about jane syntax attributes

* An additional test for reordering

---------

Co-authored-by: Ryan Tjoa <51928404+rtjoa@users.noreply.github.com>
Co-authored-by: Nick Roberts <nroberts@janestreet.com>

chamelon/compat.jst.ml

@@ -21,9 +21,16 @@ type texp_apply_identifier = apply_position * Locality.t
 let mkTexp_apply ?id:(pos, mode = (Default, Locality.legacy)) (exp, args) =
   Texp_apply (exp, args, pos, mode)
 
-type texp_tuple_identifier = Alloc.t
+type texp_tuple_identifier = string option list * Alloc.t
 
-let mkTexp_tuple ?id:(mode = Alloc.legacy) exps = Texp_tuple (exps, mode)
+let mkTexp_tuple ?id exps =
+  let labels, alloc =
+    match id with
+    | None -> (List.map (fun _ -> None) exps, Alloc.legacy)
+    | Some id -> id
+  in
+  let exps = List.combine labels exps in
+  Texp_tuple (exps, alloc)
 
 type texp_construct_identifier = Alloc.t option
 
@@ -115,7 +122,9 @@ let view_texp (e : expression_desc) =
   | Texp_apply (exp, args, pos, mode) -> Texp_apply (exp, args, (pos, mode))
   | Texp_construct (name, desc, args, mode) ->
       Texp_construct (name, desc, args, mode)
-  | Texp_tuple (args, mode) -> Texp_tuple (args, mode)
+  | Texp_tuple (args, mode) ->
+      let labels, args = List.split args in
+      Texp_tuple (args, (labels, mode))
   | Texp_function
       {
         arg_label;
@@ -161,6 +170,16 @@ type tpat_array_identifier = Asttypes.mutable_flag * Jkind.sort
 let mkTpat_array ?id:(mut, arg_sort = (Asttypes.Mutable, Jkind.Sort.value)) l =
   Tpat_array (mut, arg_sort, l)
 
+type tpat_tuple_identifier = string option list
+
+let mkTpat_tuple ?id pats =
+  let labels =
+    match id with
+    | None -> List.map (fun _ -> None) pats
+    | Some labels -> labels
+  in
+  Tpat_tuple (List.combine labels pats)
+
 type 'a matched_pattern_desc =
   | Tpat_var :
       Ident.t * string Location.loc * tpat_var_identifier
@@ -174,13 +193,19 @@ type 'a matched_pattern_desc =
   | Tpat_array :
       value general_pattern list * tpat_array_identifier
       -> value matched_pattern_desc
+  | Tpat_tuple :
+      value general_pattern list * tpat_tuple_identifier
+      -> value matched_pattern_desc
   | O : 'a pattern_desc -> 'a matched_pattern_desc
 
 let view_tpat (type a) (p : a pattern_desc) : a matched_pattern_desc =
   match p with
   | Tpat_var (ident, name, _uid, mode) -> Tpat_var (ident, name, mode)
   | Tpat_alias (p, ident, name, _uid, mode) -> Tpat_alias (p, ident, name, mode)
   | Tpat_array (mut, arg_sort, l) -> Tpat_array (l, (mut, arg_sort))
+  | Tpat_tuple pats ->
+      let labels, pats = List.split pats in
+      Tpat_tuple (pats, labels)
   | _ -> O p
 
 type tstr_eval_identifier = Jkind.sort

chamelon/compat.mli

@@ -81,6 +81,7 @@ val view_texp : expression_desc -> matched_expression_desc
 type tpat_var_identifier
 type tpat_alias_identifier
 type tpat_array_identifier
+type tpat_tuple_identifier
 
 val mkTpat_var :
   ?id:tpat_var_identifier -> Ident.t * string Location.loc -> value pattern_desc
@@ -93,6 +94,9 @@ val mkTpat_alias :
 val mkTpat_array :
   ?id:tpat_array_identifier -> value general_pattern list -> value pattern_desc
 
+val mkTpat_tuple :
+  ?id:tpat_tuple_identifier -> value general_pattern list -> value pattern_desc
+
 type 'a matched_pattern_desc =
   | Tpat_var :
       Ident.t * string Location.loc * tpat_var_identifier
@@ -106,6 +110,9 @@ type 'a matched_pattern_desc =
   | Tpat_array :
       value general_pattern list * tpat_array_identifier
       -> value matched_pattern_desc
+  | Tpat_tuple :
+      value general_pattern list * tpat_tuple_identifier
+      -> value matched_pattern_desc
   | O : 'a pattern_desc -> 'a matched_pattern_desc
 
 val view_tpat : 'a pattern_desc -> 'a matched_pattern_desc

chamelon/compat.upstream.ml

@@ -90,6 +90,10 @@ type tpat_array_identifier = unit
 
 let mkTpat_array ?id:(() = ()) l = Tpat_array l
 
+type tpat_tuple_identifier = unit
+
+let mkTpat_tuple ?id:(() = ()) l = Tpat_tuple l
+
 type 'a matched_pattern_desc =
   | Tpat_var :
       Ident.t * string Location.loc * tpat_var_identifier
@@ -103,13 +107,17 @@ type 'a matched_pattern_desc =
   | Tpat_array :
       value general_pattern list * tpat_array_identifier
       -> value matched_pattern_desc
+  | Tpat_tuple :
+      value general_pattern list * tpat_tuple_identifier
+      -> value matched_pattern_desc
   | O : 'a pattern_desc -> 'a matched_pattern_desc
 
 let view_tpat (type a) (p : a pattern_desc) : a matched_pattern_desc =
   match p with
   | Tpat_var (ident, name) -> Tpat_var (ident, name, ())
   | Tpat_alias (p, ident, name) -> Tpat_alias (p, ident, name, ())
   | Tpat_array l -> Tpat_array (l, ())
+  | Tpat_tuple l -> Tpat_tuple (l, ())
   | _ -> O p
 
 type tstr_eval_identifier = unit

chamelon/minimizer/flatteningmodules.ml

@@ -84,7 +84,8 @@ let rec replace_in_pat : type k. _ -> k general_pattern -> k general_pattern =
             ( replace_in_pat mod_name p,
               create_local (mod_name ^ "_" ^ Ident.name id),
               { str with txt = mod_name ^ "_" ^ str.txt } )
-      | O (Tpat_tuple vl) -> Tpat_tuple (List.map (replace_in_pat mod_name) vl)
+      | Tpat_tuple (vl, id) ->
+          mkTpat_tuple ~id (List.map (replace_in_pat mod_name) vl)
       | Tpat_array (vl, id) ->
           mkTpat_array ~id (List.map (replace_in_pat mod_name) vl)
       | O (Tpat_construct (a1, a2, vl, a3)) ->
@@ -104,7 +105,8 @@ let rec replace_in_pat : type k. _ -> k general_pattern -> k general_pattern =
       (* p) -> as_computation_pattern (replace_in_pat mod_name p) *)
       | O (Tpat_any | Tpat_constant _ | Tpat_variant _ | Tpat_exception _) ->
           pat.pat_desc
-      | O (Tpat_var _ | Tpat_alias _ | Tpat_array _) -> assert false);
+      | O (Tpat_var _ | Tpat_alias _ | Tpat_array _ | Tpat_tuple _) ->
+          assert false);
   }
 
 (** [add_module_name_mapper mod_name l] is a mapper which stores in [l] type and value variables defined

chamelon/minimizer/removedeadcode.ml

@@ -75,15 +75,16 @@ let rec var_from_pat pat_desc acc =
   match view_tpat pat_desc with
   | Tpat_var (id, _, _) -> id :: acc
   | Tpat_alias (pat, id, _, _) -> var_from_pat pat.pat_desc (id :: acc)
-  | O (Tpat_tuple vl) | Tpat_array (vl, _) | O (Tpat_construct (_, _, vl, _)) ->
+  | Tpat_tuple (vl, _) | Tpat_array (vl, _) | O (Tpat_construct (_, _, vl, _))
+    ->
       List.fold_left (fun l pat -> var_from_pat pat.pat_desc l) acc vl
   | O (Tpat_record (r, _)) ->
       List.fold_left (fun l (_, _, pat) -> var_from_pat pat.pat_desc l) acc r
   | O (Tpat_or (p1, p2, _)) ->
       var_from_pat p1.pat_desc (var_from_pat p2.pat_desc acc)
   | O (Tpat_lazy pat) -> var_from_pat pat.pat_desc acc
   | O (Tpat_any | Tpat_constant _ | Tpat_variant _) -> []
-  | O (Tpat_var _ | Tpat_alias _ | Tpat_array _) -> assert false
+  | O (Tpat_var _ | Tpat_alias _ | Tpat_array _ | Tpat_tuple _) -> assert false
 
 let rec rem_in_pat str pat should_remove =
   match view_tpat pat.pat_desc with
@@ -101,11 +102,12 @@ let rec rem_in_pat str pat should_remove =
           pat_desc =
             mkTpat_alias ~id:p_id (rem_in_pat str pat1 should_remove, id, a);
         }
-  | O (Tpat_tuple vl) ->
+  | Tpat_tuple (vl, id) ->
       {
         pat with
         pat_desc =
-          Tpat_tuple (List.map (fun pat -> rem_in_pat str pat should_remove) vl);
+          mkTpat_tuple ~id
+            (List.map (fun pat -> rem_in_pat str pat should_remove) vl);
       }
   | Tpat_array (vl, id) ->
       {
@@ -142,7 +144,7 @@ let rec rem_in_pat str pat should_remove =
   | O (Tpat_lazy pat) ->
       { pat with pat_desc = Tpat_lazy (rem_in_pat str pat should_remove) }
   | O (Tpat_any | Tpat_constant _ | Tpat_variant _) -> pat
-  | O (Tpat_var _ | Tpat_alias _ | Tpat_array _) -> assert false
+  | O (Tpat_var _ | Tpat_alias _ | Tpat_array _ | Tpat_tuple _) -> assert false
 
 let minimize should_remove map cur_name =
   let cur_str = Smap.find cur_name map in