Merge 5.2.0minus-1 (#106)

* Import ocaml sources for ocaml-flambda/flambda-backend@69c04271e0

* Automatic merges

* Commit merge conflicts

* Resolve conflicts

* Resolve type errors

* Bump magic numbers

* Promote failing tests

* Format code

src/analysis/ast_iterators.ml

@@ -131,7 +131,7 @@ let iter_on_defs ~uid_to_locs_tbl =
       (fun sub ({ exp_extra; _ } as expr) ->
         List.iter exp_extra ~f:(fun (exp_extra, _loc, _attr) ->
             match exp_extra with
-            | Texp_newtype' (typ_id, typ_name, _, uid) ->
+            | Texp_newtype (typ_id, typ_name, _, uid) ->
               log "Found newtype %s wit id %a (%a)\n%!" typ_name.txt Logger.fmt
                 (Fun.flip Ident.print_with_scope typ_id) Logger.fmt (fun fmt ->
                   Location.print_loc fmt typ_name.loc);

src/analysis/construct.ml

@@ -397,7 +397,10 @@ module Gen = struct
             List.map args_combinations ~f:(function
               | [] -> None
               | [ e ] -> Some e
-              | l -> Some (Ast_helper.Exp.tuple l))
+              | l ->
+                Some
+                  (Ast_helper.Exp.tuple
+                     (List.map l ~f:(fun exp -> (None, exp)))))
           in
           Btype.backtrack snap;
           List.filter_map exps ~f:(fun exp ->
@@ -536,8 +539,7 @@ module Gen = struct
             |> Util.combinations
           in
           List.map choices ~f:(fun choice ->
-              Jane_syntax.Labeled_tuples.expr_of choice
-                ~loc:!Ast_helper.default_loc)
+              Ast_helper.Exp.tuple choice ~loc:!Ast_helper.default_loc)
         | Tunboxed_tuple types ->
           let choices =
             List.map types ~f:(fun (lbl, ty) ->

src/analysis/destruct.ml

@@ -585,8 +585,7 @@ module Conv = struct
       | Tpat_alias (p, _, _, _, _) -> loop p
       | Tpat_tuple lst ->
         let lst = List.map ~f:(fun (lbl, p) -> (lbl, loop p)) lst in
-        Jane_syntax.Labeled_tuples.pat_of (lst, Closed)
-          ~loc:!Ast_helper.default_loc
+        mkpat (Ppat_tuple (lst, Closed))
       | Tpat_unboxed_tuple lst ->
         let lst = List.map ~f:(fun (lbl, p, _sort) -> (lbl, loop p)) lst in
         mkpat (Ppat_unboxed_tuple (lst, Closed))
@@ -598,7 +597,9 @@ module Conv = struct
           match List.map ~f:loop lst with
           | [] -> None
           | [ p ] -> Some ([], p)
-          | lst -> Some ([], mkpat (Ppat_tuple lst))
+          | lst ->
+            let lst = List.map lst ~f:(fun pat -> (None, pat)) in
+            Some ([], mkpat (Ppat_tuple (lst, Closed)))
         in
         mkpat (Ppat_construct (lid, arg))
       | Tpat_variant (label, p_opt, _row_desc) ->

src/analysis/ptyp_of_type.ml

@@ -66,7 +66,7 @@ and core_type type_expr =
     let labeled_type_exprs =
       List.map ~f:(fun (lbl, ty) -> (lbl, core_type ty)) type_exprs
     in
-    Jane_syntax.Labeled_tuples.typ_of ~loc:!default_loc labeled_type_exprs
+    Typ.tuple ~loc:!default_loc labeled_type_exprs
   | Tunboxed_tuple type_exprs ->
     let labeled_type_exprs =
       List.map ~f:(fun (lbl, ty) -> (lbl, core_type ty)) type_exprs

src/analysis/syntax_doc.ml

@@ -184,7 +184,7 @@ let get_syntax_doc cursor_loc node : syntax_info =
     :: ( _,
          Value_binding
            { vb_expr =
-               { exp_extra = [ (Texp_newtype' (_, loc, _, _), _, _) ];
+               { exp_extra = [ (Texp_newtype (_, loc, _, _), _, _) ];
                  exp_loc;
                  _
                };

src/ocaml/merlin_specific/browse_raw.ml

@@ -288,7 +288,7 @@ let of_exp_extra (exp, _, _) =
   | Texp_constraint (ct, _) -> option_fold of_core_type ct
   | Texp_coerce (cto, ct) -> of_core_type ct ** option_fold of_core_type cto
   | Texp_poly cto -> option_fold of_core_type cto
-  | Texp_stack | Texp_newtype' _ | Texp_newtype _ -> id_fold
+  | Texp_stack | Texp_newtype _ -> id_fold
 let of_expression e = app (Expression e) ** list_fold of_exp_extra e.exp_extra
 
 let of_pat_extra (pat, _, _) =
@@ -828,17 +828,16 @@ let expression_paths { Typedtree.exp_desc; exp_extra; _ } =
        need to be retrieved here. *)
     | Texp_function { params; _ } ->
       List.concat_map params ~f:(fun { fp_newtypes; _ } ->
-          List.concat_map fp_newtypes ~f:(function
-            | Newtype _ -> [] (* shouldn't happen *)
-            | Newtype' (id, label_loc, _, _) ->
+          List.concat_map fp_newtypes
+            ~f:(fun (id, (label_loc : _ Location.loc), _, _) ->
               let path = Path.Pident id in
               let lid = Longident.Lident label_loc.txt in
               [ (mkloc path label_loc.loc, Some lid) ]))
     | _ -> []
   in
   List.fold_left ~init exp_extra ~f:(fun acc (extra, _, _) ->
       match extra with
-      | Texp_newtype' (id, label_loc, _, _) ->
+      | Texp_newtype (id, label_loc, _, _) ->
         let path = Path.Pident id in
         let lid = Longident.Lident label_loc.txt in
         (mkloc path label_loc.loc, Some lid) :: acc

src/ocaml/parsing/ast_helper.ml

@@ -105,7 +105,8 @@ module Typ = struct
             Ptyp_var x
         | Ptyp_arrow (label,core_type,core_type',modes,modes') ->
             Ptyp_arrow(label, loop core_type, loop core_type', modes, modes')
-        | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
+        | Ptyp_tuple lst ->
+            Ptyp_tuple (List.map (fun (l, t) -> l, loop t) lst)
         | Ptyp_unboxed_tuple lst ->
           Ptyp_unboxed_tuple (List.map (fun (l, t) -> l, loop t) lst)
         | Ptyp_constr( { txt = Longident.Lident s }, [])
@@ -173,7 +174,7 @@ module Pat = struct
   let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b))
   let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a)
   let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b))
-  let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a)
+  let tuple ?loc ?attrs a b = mk ?loc ?attrs (Ppat_tuple (a, b))
   let unboxed_tuple ?loc ?attrs a b = mk ?loc ?attrs (Ppat_unboxed_tuple (a, b))
   let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b))
   let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b))

src/ocaml/parsing/ast_helper.mli

@@ -76,7 +76,7 @@ module Typ :
     val var: ?loc:loc -> ?attrs:attrs -> string -> core_type
     val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type ->
       mode with_loc list -> mode with_loc list -> core_type
-    val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type
+    val tuple: ?loc:loc -> ?attrs:attrs -> (string option * core_type) list -> core_type
     val unboxed_tuple: ?loc:loc -> ?attrs:attrs
                        -> (string option * core_type) list -> core_type
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
@@ -117,7 +117,8 @@ module Pat:
     val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern
     val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
     val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
-    val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
+    val tuple: ?loc:loc -> ?attrs:attrs -> (string option * pattern) list ->
+      closed_flag -> pattern
     val unboxed_tuple: ?loc:loc -> ?attrs:attrs
                        -> (string option * pattern) list -> closed_flag
                        -> pattern
@@ -156,7 +157,7 @@ module Exp:
     val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list
                 -> expression
     val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
-    val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression
+    val tuple: ?loc:loc -> ?attrs:attrs -> (string option * expression) list -> expression
     val unboxed_tuple: ?loc:loc -> ?attrs:attrs
                        -> (string option * expression) list -> expression
     val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option

src/ocaml/parsing/ast_iterator.ml

@@ -56,6 +56,7 @@ type iterator = {
   module_declaration: iterator -> module_declaration -> unit;
   module_substitution: iterator -> module_substitution -> unit;
   module_expr: iterator -> module_expr -> unit;
+  module_expr_jane_syntax: iterator -> Jane_syntax.Module_expr.t -> unit;
   module_type: iterator -> module_type -> unit;
   module_type_declaration: iterator -> module_type_declaration -> unit;
   module_type_jane_syntax: iterator -> Jane_syntax.Module_type.t -> unit;
@@ -147,7 +148,6 @@ module T = struct
 
   let iter_jst sub : Jane_syntax.Core_type.t -> _ = function
     | Jtyp_layout typ -> iter_jst_layout sub typ
-    | Jtyp_tuple lt_typ -> iter_labeled_tuple sub lt_typ
 
   let iter sub ({ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs}
                   as typ) =
@@ -164,7 +164,7 @@ module T = struct
     | Ptyp_arrow (_lab, t1, t2, m1, m2) ->
         sub.typ sub t1; sub.typ sub t2;
         sub.modes sub m1; sub.modes sub m2
-    | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl
+    | Ptyp_tuple tyl -> iter_labeled_tuple sub tyl
     | Ptyp_unboxed_tuple tyl -> iter_labeled_tuple sub tyl
     | Ptyp_constr (lid, tl) ->
         iter_loc sub lid; List.iter (sub.typ sub) tl
@@ -404,9 +404,27 @@ end
 module M = struct
   (* Value expressions for the module language *)
 
-  let iter sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} =
+  module I = Jane_syntax.Instances
+
+  let iter_instance _sub : I.instance -> _ = function
+    | _ ->
+        (* CR lmaurer: Implement this. Might want to change the [instance] type to have
+           Ids with locations in them rather than just raw strings. *)
+        ()
+
+  let iter_instance_expr sub : I.module_expr -> _ = function
+    | Imod_instance i -> iter_instance sub i
+
+  let iter_ext sub : Jane_syntax.Module_expr.t -> _ = function
+    | Emod_instance i -> iter_instance_expr sub i
+
+  let iter sub
+        ({pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} as expr) =
     sub.location sub loc;
     sub.attributes sub attrs;
+    match Jane_syntax.Module_expr.of_ast expr with
+    | Some ext -> sub.module_expr_jane_syntax sub ext
+    | None ->
     match desc with
     | Pmod_ident x -> iter_loc sub x
     | Pmod_structure str -> sub.structure sub str
@@ -543,7 +561,6 @@ module E = struct
     | Jexp_comprehension comp_exp -> iter_comp_exp sub comp_exp
     | Jexp_immutable_array iarr_exp -> iter_iarr_exp sub iarr_exp
     | Jexp_layout layout_exp -> iter_layout_exp sub layout_exp
-    | Jexp_tuple lt_exp -> iter_labeled_tuple sub lt_exp
 
   let iter sub
       ({pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} as expr)=
@@ -569,7 +586,7 @@ module E = struct
     | Pexp_match (e, pel) ->
         sub.expr sub e; sub.cases sub pel
     | Pexp_try (e, pel) -> sub.expr sub e; sub.cases sub pel
-    | Pexp_tuple el -> List.iter (sub.expr sub) el
+    | Pexp_tuple el -> iter_labeled_tuple sub el
     | Pexp_unboxed_tuple el -> iter_labeled_tuple sub el
     | Pexp_construct (lid, arg) ->
         iter_loc sub lid; iter_opt (sub.expr sub) arg
@@ -652,7 +669,6 @@ module P = struct
   let iter_jst sub : Jane_syntax.Pattern.t -> _ = function
     | Jpat_immutable_array iapat -> iter_iapat sub iapat
     | Jpat_layout (Lpat_constant _) -> iter_constant
-    | Jpat_tuple (ltpat, _) -> iter_labeled_tuple sub ltpat
 
   let iter sub
         ({ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} as pat) =
@@ -669,7 +685,7 @@ module P = struct
     | Ppat_alias (p, s) -> sub.pat sub p; iter_loc sub s
     | Ppat_constant _ -> iter_constant
     | Ppat_interval _ -> ()
-    | Ppat_tuple pl -> List.iter (sub.pat sub) pl
+    | Ppat_tuple (pl, _) -> iter_labeled_tuple sub pl
     | Ppat_unboxed_tuple (pl, _) -> iter_labeled_tuple sub pl
     | Ppat_construct (l, p) ->
         iter_loc sub l;
@@ -763,6 +779,7 @@ let default_iterator =
     structure_item = M.iter_structure_item;
     structure_item_jane_syntax = M.iter_structure_item_jst;
     module_expr = M.iter;
+    module_expr_jane_syntax = M.iter_ext;
     signature = (fun this l -> List.iter (this.signature_item this) l);
     signature_item = MT.iter_signature_item;
     signature_item_jane_syntax = MT.iter_signature_item_jst;

src/ocaml/parsing/ast_iterator.mli

@@ -59,6 +59,7 @@ type iterator = {
   module_declaration: iterator -> module_declaration -> unit;
   module_substitution: iterator -> module_substitution -> unit;
   module_expr: iterator -> module_expr -> unit;
+  module_expr_jane_syntax: iterator -> Jane_syntax.Module_expr.t -> unit;
   module_type: iterator -> module_type -> unit;
   module_type_declaration: iterator -> module_type_declaration -> unit;
   module_type_jane_syntax: iterator -> Jane_syntax.Module_type.t -> unit;