Bump the internal AST to 5.2

The current, internal AST is 4.14. With this change it is now 5.2. The
most notable changes are the representation of functions and locally
opening modules for type definitions.

Signed-off-by: Patrick Ferris <patrick@sirref.org>

ast/ast_helper_lite.ml

@@ -17,7 +17,7 @@
 open Stdlib0
 module Location = Astlib.Location
 module Longident = Astlib.Longident
-open Astlib.Ast_500
+open Astlib.Ast_502
 
 [@@@warning "-9"]
 
@@ -121,7 +121,7 @@ module Typ = struct
         | Ptyp_class (longident, lst) ->
             Ptyp_class (longident, List.map loop lst)
         | Ptyp_alias (core_type, string) ->
-            check_variable var_names t.ptyp_loc string;
+            check_variable var_names t.ptyp_loc string.txt;
             Ptyp_alias (loop core_type, string)
         | Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
             Ptyp_variant
@@ -135,6 +135,7 @@ module Typ = struct
             Ptyp_package
               (longident, List.map (fun (n, typ) -> (n, loop typ)) lst)
         | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg)
+        | Ptyp_open (l, ct) -> Ptyp_open (l, loop ct)
       in
       { t with ptyp_desc = desc }
     and loop_row_field field =
@@ -201,8 +202,20 @@ module Exp = struct
   let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
   let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
   let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
-  let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d))
-  let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a)
+
+  let function_ ?loc ?attrs ?loc_location cases =
+    let loc_locations =
+      match loc_location with Some l -> l | None -> !default_loc
+    in
+    mk ?loc ?attrs
+      (Pexp_function ([], None, Pfunction_cases (cases, loc_locations, [])))
+
+  let fun_ ?loc ?attrs a b c d =
+    let pparam_desc = Pparam_val (a, b, c) in
+    let body = Pfunction_body d in
+    let pparam_loc = match loc with Some loc -> loc | None -> Location.none in
+    mk ?loc ?attrs (Pexp_function ([ { pparam_loc; pparam_desc } ], None, body))
+
   let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b))
   let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
   let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b))
@@ -423,8 +436,14 @@ module Incl = struct
 end
 
 module Vb = struct
-  let mk ?(loc = !default_loc) ?(attrs = []) pat expr =
-    { pvb_pat = pat; pvb_expr = expr; pvb_attributes = attrs; pvb_loc = loc }
+  let mk ?(loc = !default_loc) ?(attrs = []) ?value_constraint pat expr =
+    {
+      pvb_pat = pat;
+      pvb_expr = expr;
+      pvb_attributes = attrs;
+      pvb_loc = loc;
+      pvb_constraint = value_constraint;
+    }
 end
 
 module Ci = struct
@@ -440,6 +459,17 @@ module Ci = struct
     }
 end
 
+let constructor ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
+    ?(args = Pcstr_tuple []) ?res name =
+  {
+    pcd_name = name;
+    pcd_vars = vars;
+    pcd_args = args;
+    pcd_res = res;
+    pcd_loc = loc;
+    pcd_attributes = attrs;
+  }
+
 module Type = struct
   let mk ?(loc = !default_loc) ?(attrs = []) ?(params = []) ?(cstrs = [])
       ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name =

ast/ast_helper_lite.mli

@@ -15,7 +15,7 @@
 
 (** Copy of Ast_helper from OCaml 4.14 with docstring related stuff removed *)
 
-open Astlib.Ast_500
+open Astlib.Ast_502
 open Asttypes
 open Parsetree
 
@@ -72,7 +72,7 @@ module Typ : sig
     ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type
 
   val class_ : ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
-  val alias : ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
+  val alias : ?loc:loc -> ?attrs:attrs -> core_type -> str -> core_type
 
   val variant :
     ?loc:loc ->
@@ -151,7 +151,8 @@ module Exp : sig
     expression ->
     expression
 
-  val function_ : ?loc:loc -> ?attrs:attrs -> case list -> expression
+  val function_ :
+    ?loc:loc -> ?attrs:attrs -> ?loc_location:loc -> case list -> expression
 
   val apply :
     ?loc:loc ->
@@ -466,7 +467,13 @@ end
 
 (** Value bindings *)
 module Vb : sig
-  val mk : ?loc:loc -> ?attrs:attrs -> pattern -> expression -> value_binding
+  val mk :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    ?value_constraint:value_constraint ->
+    pattern ->
+    expression ->
+    value_binding
 end
 
 (** {1 Class language} *)

ast/import.ml

@@ -6,7 +6,7 @@
 
 (*$ open Ast_cinaps_helpers $*)
 
-module Js = Versions.OCaml_500
+module Js = Versions.OCaml_502
 module Ocaml = Versions.OCaml_current
 
 module Select_ast (Ocaml : Versions.OCaml_version) = struct

astlib/pprintast.ml

@@ -21,7 +21,7 @@
 (* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
 (* TODO more fine-grained precedence pretty-printing *)
 
-open Ast_414
+open Ast_502
 open Asttypes
 open Format
 open Location
@@ -56,7 +56,7 @@ let varify_type_constructors var_names t =
       | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o)
       | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst)
       | Ptyp_alias (core_type, string) ->
-          check_variable var_names t.ptyp_loc string;
+          check_variable var_names t.ptyp_loc string.txt;
           Ptyp_alias (loop core_type, string)
       | Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
           Ptyp_variant
@@ -69,6 +69,7 @@ let varify_type_constructors var_names t =
       | Ptyp_package (longident, lst) ->
           Ptyp_package (longident, List.map (fun (n, typ) -> (n, loop typ)) lst)
       | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg)
+      | Ptyp_open (s, ct) -> Ptyp_open (s, loop ct)
     in
     { t with ptyp_desc = desc }
   and loop_row_field field =
@@ -220,12 +221,15 @@ let is_simple_construct : construct -> bool = function
 
 let pp = fprintf
 
-type ctxt = { pipe : bool; semi : bool; ifthenelse : bool }
+type ctxt = { pipe : bool; semi : bool; ifthenelse : bool; functionrhs : bool }
+
+let reset_ctxt =
+  { pipe = false; semi = false; ifthenelse = false; functionrhs = false }
 
-let reset_ctxt = { pipe = false; semi = false; ifthenelse = false }
 let under_pipe ctxt = { ctxt with pipe = true }
 let under_semi ctxt = { ctxt with semi = true }
 let under_ifthenelse ctxt = { ctxt with ifthenelse = true }
+let under_functionrhs ctxt = { ctxt with functionrhs = true }
 (*
 let reset_semi ctxt = { ctxt with semi=false }
 let reset_ifthenelse ctxt = { ctxt with ifthenelse=false }
@@ -368,7 +372,7 @@ and core_type ctxt f x =
         pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
           (type_with_label ctxt) (l, ct1) (core_type ctxt) ct2
     | Ptyp_alias (ct, s) ->
-        pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar s
+        pp f "@[<2>%a@;as@;%a@]" (core_type1 ctxt) ct tyvar_loc s
     | Ptyp_poly ([], ct) -> core_type ctxt f ct
     | Ptyp_poly (sl, ct) ->
         pp f "@[<2>%a%a@]"
@@ -456,6 +460,8 @@ and core_type1 ctxt f x =
         pp f "@[<hov2>%a#%a@]"
           (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
           l longident_loc li
+    | Ptyp_open (li, ct) ->
+        pp f "@[<hov2>%a.(%a)@]" longident_loc li (core_type ctxt) ct
     | Ptyp_package (lid, cstrs) -> (
         let aux f (s, ct) =
           pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct
@@ -690,7 +696,7 @@ and expression ctxt f x =
       (attributes ctxt) x.pexp_attributes
   else
     match x.pexp_desc with
-    | Pexp_function _ | Pexp_fun _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
+    | Pexp_function _ | Pexp_match _ | Pexp_try _ | Pexp_sequence _
     | Pexp_newtype _
       when ctxt.pipe || ctxt.semi ->
         paren true (expression reset_ctxt) f x
@@ -700,12 +706,30 @@ and expression ctxt f x =
     | Pexp_letop _
       when ctxt.semi ->
         paren true (expression reset_ctxt) f x
-    | Pexp_fun (l, e0, p, e) ->
-        pp f "@[<2>fun@;%a->@;%a@]" (label_exp ctxt) (l, e0, p)
-          (expression ctxt) e
     | Pexp_newtype (lid, e) ->
         pp f "@[<2>fun@;(type@;%s)@;->@;%a@]" lid.txt (expression ctxt) e
-    | Pexp_function l -> pp f "@[<hv>function%a@]" (case_list ctxt) l
+    | Pexp_function (params, c, body) -> (
+        match (params, c) with
+        (* Omit [fun] if there are no params. *)
+        | [], None ->
+            (* If function cases are a direct body of a function,
+               the function node should be wrapped in parens so
+               it doesn't become part of the enclosing function. *)
+            let should_paren =
+              match body with
+              | Pfunction_cases _ -> ctxt.functionrhs
+              | Pfunction_body _ -> false
+            in
+            let ctxt' = if should_paren then reset_ctxt else ctxt in
+            pp f "@[<2>%a@]" (paren should_paren (function_body ctxt')) body
+        | [], Some c ->
+            pp f "@[<2>(%a@;%a)@]" (function_body ctxt) body
+              (type_constraint ctxt) c
+        | _ :: _, _ ->
+            pp f "@[<2>fun@;%a@]"
+              (fun f () ->
+                function_params_then_body ctxt f params c body ~delimiter:"->")
+              ())
     | Pexp_match (e, l) ->
         pp f "@[<hv0>@[<hv0>@[<2>match %a@]@ with@]%a@]" (expression reset_ctxt)
           e (case_list ctxt) l
@@ -834,6 +858,35 @@ and expression ctxt f x =
     | Pexp_unreachable -> pp f "."
     | _ -> expression1 ctxt f x
 
+and function_param ctxt f param =
+  match param.pparam_desc with
+  | Pparam_val (a, b, c) -> label_exp ctxt f (a, b, c)
+  | Pparam_newtype ty -> pp f "(type %a)@;" protect_ident ty.txt
+
+and function_body ctxt f function_body =
+  match function_body with
+  | Pfunction_body body -> expression ctxt f body
+  | Pfunction_cases (cases, _, attrs) ->
+      pp f "@[<hv>function%a%a@]" (item_attributes ctxt) attrs (case_list ctxt)
+        cases
+
+and type_constraint ctxt f constraint_ =
+  match constraint_ with
+  | Pconstraint ty -> pp f ":@;%a" (core_type ctxt) ty
+  | Pcoerce (ty1, ty2) ->
+      pp f "%a:>@;%a"
+        (option ~first:":@;" (core_type ctxt))
+        ty1 (core_type ctxt) ty2
+
+and function_params_then_body ctxt f params constraint_ body ~delimiter =
+  pp f "%a%a%s@;%a"
+    (list (function_param ctxt) ~sep:"")
+    params
+    (option (type_constraint ctxt))
+    constraint_ delimiter
+    (function_body (under_functionrhs ctxt))
+    body
+
 and expression1 ctxt f x =
   if x.pexp_attributes <> [] then expression ctxt f x
   else
@@ -1043,6 +1096,7 @@ and class_field ctxt f x =
             pvb_expr = e;
             pvb_attributes = [];
             pvb_loc = Location.none;
+            pvb_constraint = None;
           }
       in
       pp f "@[<2>method%s %a%a@]%a" (override ovf) private_flag pf
@@ -1283,6 +1337,7 @@ and module_expr ctxt f x =
     | Pmod_apply (me1, me2) ->
         pp f "(%a)(%a)" (module_expr ctxt) me1 (module_expr ctxt) me2
         (* Cf: #7200 *)
+    | Pmod_apply_unit me1 -> pp f "(%a)()" (module_expr ctxt) me1
     | Pmod_unpack e -> pp f "(val@ %a)" (expression ctxt) e
     | Pmod_extension e -> extension ctxt f e
 
@@ -1314,12 +1369,8 @@ and binding ctxt f { pvb_pat = p; pvb_expr = x; _ } =
     if x.pexp_attributes <> [] then pp f "=@;%a" (expression ctxt) x
     else
       match x.pexp_desc with
-      | Pexp_fun (label, eo, p, e) ->
-          if label = Nolabel then
-            pp f "%a@ %a" (simple_pattern ctxt) p pp_print_pexp_function e
-          else
-            pp f "%a@ %a" (label_exp ctxt) (label, eo, p) pp_print_pexp_function
-              e
+      | Pexp_function (params, c, body) ->
+          function_params_then_body ctxt f params c body ~delimiter:"="
       | Pexp_newtype (str, e) ->
           pp f "(type@ %s)@ %a" str.txt pp_print_pexp_function e
       | _ -> pp f "=@;%a" (expression ctxt) x

astlib/pprintast.mli

@@ -13,7 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Ast_414
+open Ast_502
 
 type space_formatter = (unit, Format.formatter, unit) format
 

bench/vendored/ppx_sexp_conv.v0.15.1/expander/conversion.ml

@@ -49,7 +49,7 @@ module Lambda = struct
   let maybe_apply_generic ~loc ~binds maybe_arg cases =
     let expr =
       match maybe_arg with
-      | None -> pexp_function ~loc cases
+      | None -> pexp_function_cases ~loc cases
       | Some arg -> pexp_match ~loc arg cases
     in
     with_let ~loc ~binds expr

bench/vendored/ppx_sexp_conv.v0.15.1/expander/expand_of_sexp.ml

@@ -186,6 +186,7 @@ module Str_generate_of_sexp = struct
     | { ptyp_desc = Ptyp_class (_, _); _ }
     | { ptyp_desc = Ptyp_alias (_, _); _ }
     | { ptyp_desc = Ptyp_package _; _ }
+    | { ptyp_desc = Ptyp_open _; _ }
     | { ptyp_desc = Ptyp_extension _; _ } ->
       Location.raise_errorf ~loc "Type unsupported for ppx [of_sexp] conversion"
 
@@ -841,7 +842,7 @@ module Str_generate_of_sexp = struct
       [%expr
         let rec [%p Fresh_name.pattern fresh_iter] =
           [%e
-            pexp_function
+            pexp_function_cases
               ~loc
               [ [%pat?
                        Sexplib0.Sexp.List

bench/vendored/ppx_sexp_conv.v0.15.1/expander/expand_sexp_of.ml

@@ -82,6 +82,7 @@ module Str_generate_sexp_of = struct
     | { ptyp_desc = Ptyp_class (_, _); _ }
     | { ptyp_desc = Ptyp_alias (_, _); _ }
     | { ptyp_desc = Ptyp_package _; _ }
+    | { ptyp_desc = Ptyp_open _; _ }
     | { ptyp_desc = Ptyp_extension _; _ } ->
       Location.raise_errorf ~loc "Type unsupported for ppx [sexp_of] conversion"
 

bench/vendored/ppx_sexp_conv.v0.15.1/expander/helpers.ml

@@ -139,7 +139,7 @@ let fresh_lambda ~loc apply =
 let rec is_value_expression expr =
   match expr.pexp_desc with
   (* Syntactic values. *)
-  | Pexp_ident _ | Pexp_constant _ | Pexp_function _ | Pexp_fun _ | Pexp_lazy _ -> true
+  | Pexp_ident _ | Pexp_constant _ | Pexp_function _ | Pexp_lazy _ -> true
   (* Type-only wrappers; we check their contents. *)
   | Pexp_constraint (expr, (_ : core_type))
   | Pexp_coerce (expr, (_ : core_type option), (_ : core_type))

bench/vendored/ppx_sexp_conv.v0.15.1/expander/ppx_sexp_conv_grammar.ml

@@ -218,6 +218,7 @@ let rec grammar_of_type core_type ~rec_flag ~tags_of_doc_comments =
             grammar_of_polymorphic_variant ~loc ~rec_flag ~tags_of_doc_comments rows)
        | Ptyp_poly _ -> unsupported ~loc "explicitly polymorphic types"
        | Ptyp_package _ -> unsupported ~loc "first-class module types"
+       | Ptyp_open _ -> unsupported ~loc "locally opened modules"
        | Ptyp_extension _ -> unsupported ~loc "unexpanded ppx extensions")
   in
   grammar_of_type_tags core_type grammar ~tags_of_doc_comments

examples/simple-deriver/ppx_deriving_accessors.ml

@@ -16,6 +16,7 @@ let accessor_impl (ld : label_declaration) =
                { loc; txt = lident ld.pld_name.txt });
         pvb_attributes = [];
         pvb_loc = loc;
+        pvb_constraint = None;
       };
     ]