Merge pull request #558 from patricoferris/5.3-bump

5.3 AST bump

Author: patricoferris

CHANGES.md

@@ -1,6 +1,8 @@
 unreleased
 ----------
 
+- Bump ppxlib's AST to 5.3.0 (#558, @patricoferris)
+
 - Fix 5.2 -> 5.3 migration of constants. Those used to always have a `none`
   location which can lead to unhelpful error messages.
   (#569, @NathanReb)

ast/ast.ml

@@ -17,7 +17,7 @@
 open Stdlib0
 module Location = Astlib.Location
 module Longident = Astlib.Longident
-open Astlib.Ast_502
+open Astlib.Ast_503
 
 [@@@warning "-9"]
 
@@ -52,16 +52,20 @@ let protect_ref =
 let with_default_loc l f = protect_ref (R (default_loc, l)) f
 
 module Const = struct
-  let integer ?suffix i = Pconst_integer (i, suffix)
-  let int ?suffix i = integer ?suffix (Int.to_string i)
-  let int32 ?(suffix = 'l') i = integer ~suffix (Int32.to_string i)
-  let int64 ?(suffix = 'L') i = integer ~suffix (Int64.to_string i)
-  let nativeint ?(suffix = 'n') i = integer ~suffix (Nativeint.to_string i)
-  let float ?suffix f = Pconst_float (f, suffix)
-  let char c = Pconst_char c
+  let mk ?(loc = !default_loc) pconst_desc = { pconst_desc; pconst_loc = loc }
+  let integer ?loc ?suffix i = mk ?loc (Pconst_integer (i, suffix))
+  let int ?loc ?suffix i = integer ?loc ?suffix (Int.to_string i)
+  let int32 ?loc ?(suffix = 'l') i = integer ?loc ~suffix (Int32.to_string i)
+  let int64 ?loc ?(suffix = 'L') i = integer ?loc ~suffix (Int64.to_string i)
+
+  let nativeint ?loc ?(suffix = 'n') i =
+    integer ?loc ~suffix (Nativeint.to_string i)
+
+  let float ?loc ?suffix f = mk ?loc (Pconst_float (f, suffix))
+  let char ?loc c = mk ?loc (Pconst_char c)
 
   let string ?quotation_delimiter ?(loc = !default_loc) s =
-    Pconst_string (s, loc, quotation_delimiter)
+    mk ~loc (Pconst_string (s, loc, quotation_delimiter))
 end
 
 module Attr = struct

ast/ast_helper_lite.ml

@@ -15,7 +15,7 @@
 
 (** Copy of Ast_helper from OCaml 4.14 with docstring related stuff removed *)
 
-open Astlib.Ast_502
+open Astlib.Ast_503
 open Asttypes
 open Parsetree
 
@@ -38,14 +38,15 @@ val with_default_loc : loc -> (unit -> 'a) -> 'a
 (** {1 Constants} *)
 
 module Const : sig
-  val char : char -> constant
+  val mk : ?loc:loc -> constant_desc -> constant
+  val char : ?loc:loc -> char -> constant
   val string : ?quotation_delimiter:string -> ?loc:loc -> string -> constant
-  val integer : ?suffix:char -> string -> constant
-  val int : ?suffix:char -> int -> constant
-  val int32 : ?suffix:char -> int32 -> constant
-  val int64 : ?suffix:char -> int64 -> constant
-  val nativeint : ?suffix:char -> nativeint -> constant
-  val float : ?suffix:char -> string -> constant
+  val integer : ?loc:loc -> ?suffix:char -> string -> constant
+  val int : ?loc:loc -> ?suffix:char -> int -> constant
+  val int32 : ?loc:loc -> ?suffix:char -> int32 -> constant
+  val int64 : ?loc:loc -> ?suffix:char -> int64 -> constant
+  val nativeint : ?loc:loc -> ?suffix:char -> nativeint -> constant
+  val float : ?loc:loc -> ?suffix:char -> string -> constant
 end
 
 (** {1 Attributes} *)

ast/ast_helper_lite.mli

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

ast/import.ml

@@ -47,7 +47,12 @@ let of_extension (extension : Ast.extension) =
     | {
         pstr_desc =
           Pstr_eval
-            ({ pexp_desc = Pexp_constant (Pconst_string (msg, _, _)); _ }, []);
+            ( {
+                pexp_desc =
+                  Pexp_constant { pconst_desc = Pconst_string (msg, _, _); _ };
+                _;
+              },
+              [] );
         _;
       } ->
         msg

ast/location_error.ml

@@ -21,7 +21,7 @@
 (* Extensive Rewrite: Hongbo Zhang: University of Pennsylvania *)
 (* TODO more fine-grained precedence pretty-printing *)
 
-open Ast_502
+open Ast_503
 open Asttypes
 open Format
 open Location
@@ -310,7 +310,8 @@ let rec longident f = function
 
 let longident_loc f x = pp f "%a" longident x.txt
 
-let constant f = function
+let constant f c =
+  match c.pconst_desc with
   | Pconst_char i -> pp f "%C" i
   | Pconst_string (i, _, None) -> pp f "%S" i
   | Pconst_string (i, _, Some delim) -> pp f "{%s|%s|%s}" delim i delim

astlib/pprintast.ml

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

astlib/pprintast.mli

@@ -98,33 +98,57 @@ module Default = struct
     failwith
       "Ppxlib.Ast_builder.nonrec_type_declaration: don't use this function"
 
-  let eint ~loc t = pexp_constant ~loc (Pconst_integer (Int.to_string t, None))
-  let echar ~loc t = pexp_constant ~loc (Pconst_char t)
-  let estring ~loc t = pexp_constant ~loc (Pconst_string (t, loc, None))
-  let efloat ~loc t = pexp_constant ~loc (Pconst_float (t, None))
+  let eint ~loc t =
+    pexp_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int.to_string t, None))
+
+  let echar ~loc t =
+    pexp_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_char t)
+
+  let estring ~loc t =
+    pexp_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_string (t, loc, None))
+
+  let efloat ~loc t =
+    pexp_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_float (t, None))
 
   let eint32 ~loc t =
-    pexp_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
+    pexp_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int32.to_string t, Some 'l'))
 
   let eint64 ~loc t =
-    pexp_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))
+    pexp_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int64.to_string t, Some 'L'))
 
   let enativeint ~loc t =
-    pexp_constant ~loc (Pconst_integer (Nativeint.to_string t, Some 'n'))
+    pexp_constant ~loc
+      (Ast_helper.Const.mk ~loc
+      @@ Pconst_integer (Nativeint.to_string t, Some 'n'))
+
+  let pint ~loc t =
+    ppat_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int.to_string t, None))
+
+  let pchar ~loc t =
+    ppat_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_char t)
+
+  let pstring ~loc t =
+    ppat_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_string (t, loc, None))
 
-  let pint ~loc t = ppat_constant ~loc (Pconst_integer (Int.to_string t, None))
-  let pchar ~loc t = ppat_constant ~loc (Pconst_char t)
-  let pstring ~loc t = ppat_constant ~loc (Pconst_string (t, loc, None))
-  let pfloat ~loc t = ppat_constant ~loc (Pconst_float (t, None))
+  let pfloat ~loc t =
+    ppat_constant ~loc (Ast_helper.Const.mk ~loc @@ Pconst_float (t, None))
 
   let pint32 ~loc t =
-    ppat_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
+    ppat_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int32.to_string t, Some 'l'))
 
   let pint64 ~loc t =
-    ppat_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))
+    ppat_constant ~loc
+      (Ast_helper.Const.mk ~loc @@ Pconst_integer (Int64.to_string t, Some 'L'))
 
   let pnativeint ~loc t =
-    ppat_constant ~loc (Pconst_integer (Nativeint.to_string t, Some 'n'))
+    ppat_constant ~loc
+      (Ast_helper.Const.mk ~loc
+      @@ Pconst_integer (Nativeint.to_string t, Some 'n'))
 
   let ebool ~loc t =
     pexp_construct ~loc (Located.lident ~loc (Bool.to_string t)) None

src/ast_builder.ml

@@ -680,11 +680,11 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
               match expr with
               | None -> super#expression base_ctxt e
               | Some e -> self#expression base_ctxt e))
-      | Pexp_constant (Pconst_integer (s, Some c)) -> (
+      | Pexp_constant { pconst_desc = Pconst_integer (s, Some c); _ } -> (
           try expand_constant Integer c s
           with exn when embed_errors ->
             return (exn_to_error_extension EC.expression e exn))
-      | Pexp_constant (Pconst_float (s, Some c)) -> (
+      | Pexp_constant { pconst_desc = Pconst_float (s, Some c); _ } -> (
           try expand_constant Float c s
           with exn when embed_errors ->
             return (exn_to_error_extension EC.expression e exn))

src/context_free.ml

@@ -20,7 +20,13 @@ let doc_comment_from_attribue (attr : attribute) =
             {
               pstr_desc =
                 Pstr_eval
-                  ({ pexp_desc = Pexp_constant (Pconst_string (s, _, _)); _ }, _);
+                  ( {
+                      pexp_desc =
+                        Pexp_constant
+                          { pconst_desc = Pconst_string (s, _, _); _ };
+                      _;
+                    },
+                    _ );
               _;
             };
           ] ->
@@ -245,7 +251,12 @@ let floating_comment s =
           pstr_desc =
             Pstr_eval
               ( {
-                  pexp_desc = Pexp_constant (Pconst_string (s, loc, None));
+                  pexp_desc =
+                    Pexp_constant
+                      {
+                        pconst_desc = Pconst_string (s, loc, None);
+                        pconst_loc = loc;
+                      };
                   pexp_loc = loc;
                   pexp_loc_stack = [];
                   pexp_attributes = [];

src/gen/gen_ast_builder.ml

@@ -205,6 +205,10 @@ class lift_simple_val =
         ~lift_record:super#module_expr ~desc:mod_.pmod_desc
         ~attrs:mod_.pmod_attributes mod_
 
+    method! constant c =
+      self#lift_record_with_desc ~lift_desc:self#constant_desc
+        ~lift_record:super#constant ~desc:c.pconst_desc ~attrs:[] c
+
     method! structure_item stri = self#structure_item_desc stri.pstr_desc
     method! signature_item sigi = self#signature_item_desc sigi.psig_desc
 

src/pp_ast.ml

@@ -20,7 +20,9 @@ let get_odoc_contents_if_comment = function
               pstr_desc =
                 Pstr_eval
                   ( {
-                      pexp_desc = Pexp_constant (Pconst_string (text, loc, _));
+                      pexp_desc =
+                        Pexp_constant
+                          { pconst_desc = Pconst_string (text, loc, _); _ };
                       _;
                     },
                     _ );
@@ -43,7 +45,13 @@ let prettify_odoc_attributes =
           let open Ast_builder.Default in
           let loc = Location.none in
           let delim = Some (Common.valid_string_constant_delimiter txt) in
-          let expr = pexp_constant ~loc (Pconst_string (txt, loc, delim)) in
+          let expr =
+            pexp_constant ~loc
+              {
+                pconst_desc = Pconst_string (txt, loc, delim);
+                pconst_loc = loc;
+              }
+          in
           { attr with attr_payload = PStr [ pstr_eval ~loc expr [] ] }
       | None -> attr
   end

src/utils.ml

@@ -89,7 +89,12 @@ let () =
           (Extension.declare "foo" Expression Ast_pattern.__
              (fun ~loc ~path:_ _payload ->
                {
-                 pexp_desc = Pexp_constant (Pconst_string ("foo", loc, None));
+                 pexp_desc =
+                   Pexp_constant
+                     {
+                       pconst_desc = Pconst_string ("foo", loc, None);
+                       pconst_loc = loc;
+                     };
                  pexp_loc = loc;
                  pexp_attributes = [];
                  pexp_loc_stack = [];

test/deriving/inline/foo-deriver/ppx_foo_deriver.ml

@@ -8,7 +8,9 @@ let print_string s ~loc =
     mk_expression ~loc (Pexp_ident { txt = Lident "print_endline"; loc })
   in
   let string_exp =
-    mk_expression ~loc (Pexp_constant (Pconst_string (s, loc, None)))
+    mk_expression ~loc
+      (Pexp_constant
+         { pconst_desc = Pconst_string (s, loc, None); pconst_loc = loc })
   in
   mk_expression ~loc (Pexp_apply (print_exp, [ (Nolabel, string_exp) ]))
 

test/driver/standalone_run_as_ppx/print_stuff.ml

@@ -7,7 +7,7 @@ open Ppxlib
 
 let expr_description ~loc ~error expr =
   match expr.pexp_desc with
-  | Pexp_constant (Pconst_integer _) ->
+  | Pexp_constant { pconst_desc = Pconst_integer _; _ } ->
     Ast_builder.Default.estring ~loc "Payload is an integer"
   | Pexp_extension _ ->
     Ast_builder.Default.estring ~loc "Payload is an extension point"

test/expansion_inside_payloads/test.ml

@@ -1,5 +1,9 @@
 (cram
  (package ppxlib-tools)
+ ; Migrations sometimes make subtle differences in the output.
+ ; For example, locations that are marked "ghost".
+ (enabled_if
+  (>= %{ocaml_version} "5.3.0"))
  (deps
   %{bin:ppxlib-pp-ast}
   (package ppxlib)))

test/ppxlib-pp-ast/dune

@@ -65,7 +65,11 @@ Now how it's printed with the flag:
               ; ppat_attributes = __attrs
               }
           ; pvb_expr =
-              { pexp_desc = Pexp_constant (Pconst_integer ( "2", None))
+              { pexp_desc =
+                  Pexp_constant
+                    { pconst_desc = Pconst_integer ( "2", None)
+                    ; pconst_loc = l1c8..9
+                    }
               ; pexp_loc = l1c8..9
               ; pexp_loc_stack = __lstack
               ; pexp_attributes = __attrs
@@ -189,7 +193,25 @@ original form as opposed to the default, condensed one shown above:
               ; ppat_attributes = __attrs
               }
           ; pvb_expr =
-              { pexp_desc = Pexp_constant (Pconst_integer ( "2", None))
+              { pexp_desc =
+                  Pexp_constant
+                    { pconst_desc = Pconst_integer ( "2", None)
+                    ; pconst_loc =
+                        { loc_start =
+                            { pos_fname = "test.ml"
+                            ; pos_lnum = 1
+                            ; pos_bol = 0
+                            ; pos_cnum = 8
+                            }
+                        ; loc_end =
+                            { pos_fname = "test.ml"
+                            ; pos_lnum = 1
+                            ; pos_bol = 0
+                            ; pos_cnum = 9
+                            }
+                        ; loc_ghost = false
+                        }
+                    }
               ; pexp_loc =
                   { loc_start =
                       { pos_fname = "test.ml"