Upgrade internal AST to 4.11

Signed-off-by: Nathan Rebours <[email protected]>

ast/ast.ml

@@ -35,6 +35,24 @@ open Import
    - removing the extra values at the end of the file
    - replacing app [type ...] by [and ...] to make everything one recursive block
    - adding [@@deriving_inline traverse][@@@end] at the end
+
+   To update it to a newer OCaml version, create a new module with the above from the
+   latest compiler and add the following module definitions and opens to get it to
+   compile:
+   [{
+    module Ast = Versions.OCaml_4xx
+    open Ast.Ast
+    module Location   = struct
+      include Ocaml_common.Location
+      include Location_helper
+    end
+    module Longident = Ocaml_common.Longident
+   }]
+
+   Once you have generated the inlined derived traversal classes by running
+   [{ dune build @lint }] you can replace the above mentioned module definitions by a
+   [open Import] and update [Import] so that the [Js] module points to
+   [Versions.OCaml_4xx].
 *)
 
 (* Source code locations (ranges of positions), used in parsetree. *)
@@ -115,9 +133,11 @@ and constant = Parsetree.constant =
   *)
   | Pconst_char of char
   (* 'c' *)
-  | Pconst_string of string * string option
+  | Pconst_string of string * location * string option
   (* "constant"
      {delim|other constant|delim}
+
+     The location span the content of the string, without the delimiters.
   *)
   | Pconst_float of string * char option
   (* 3.4 2e5 1.4e-4
@@ -1097,9 +1117,10 @@ class virtual map =
             let a = self#string a in
             let b = self#option self#char b in Pconst_integer (a, b)
         | Pconst_char a -> let a = self#char a in Pconst_char a
-        | Pconst_string (a, b) ->
+        | Pconst_string (a, b, c) ->
             let a = self#string a in
-            let b = self#option self#string b in Pconst_string (a, b)
+            let b = self#location b in
+            let c = self#option self#string c in Pconst_string (a, b, c)
         | Pconst_float (a, b) ->
             let a = self#string a in
             let b = self#option self#char b in Pconst_float (a, b)
@@ -1951,7 +1972,8 @@ class virtual iter =
         match x with
         | Pconst_integer (a, b) -> (self#string a; self#option self#char b)
         | Pconst_char a -> self#char a
-        | Pconst_string (a, b) -> (self#string a; self#option self#string b)
+        | Pconst_string (a, b, c) ->
+            (self#string a; self#location b; self#option self#string c)
         | Pconst_float (a, b) -> (self#string a; self#option self#char b)
     method attribute : attribute -> unit=
       fun { attr_name; attr_payload; attr_loc } ->
@@ -2591,9 +2613,10 @@ class virtual ['acc] fold =
               let acc = self#string a acc in
               let acc = self#option self#char b acc in acc
           | Pconst_char a -> self#char a acc
-          | Pconst_string (a, b) ->
+          | Pconst_string (a, b, c) ->
               let acc = self#string a acc in
-              let acc = self#option self#string b acc in acc
+              let acc = self#location b acc in
+              let acc = self#option self#string c acc in acc
           | Pconst_float (a, b) ->
               let acc = self#string a acc in
               let acc = self#option self#char b acc in acc
@@ -3468,10 +3491,11 @@ class virtual ['acc] fold_map =
               ((Pconst_integer (a, b)), acc)
           | Pconst_char a ->
               let (a, acc) = self#char a acc in ((Pconst_char a), acc)
-          | Pconst_string (a, b) ->
+          | Pconst_string (a, b, c) ->
               let (a, acc) = self#string a acc in
-              let (b, acc) = self#option self#string b acc in
-              ((Pconst_string (a, b)), acc)
+              let (b, acc) = self#location b acc in
+              let (c, acc) = self#option self#string c acc in
+              ((Pconst_string (a, b, c)), acc)
           | Pconst_float (a, b) ->
               let (a, acc) = self#string a acc in
               let (b, acc) = self#option self#char b acc in
@@ -4688,9 +4712,11 @@ class virtual ['ctx] map_with_context =
               let a = self#string ctx a in
               let b = self#option self#char ctx b in Pconst_integer (a, b)
           | Pconst_char a -> let a = self#char ctx a in Pconst_char a
-          | Pconst_string (a, b) ->
+          | Pconst_string (a, b, c) ->
               let a = self#string ctx a in
-              let b = self#option self#string ctx b in Pconst_string (a, b)
+              let b = self#location ctx b in
+              let c = self#option self#string ctx c in
+              Pconst_string (a, b, c)
           | Pconst_float (a, b) ->
               let a = self#string ctx a in
               let b = self#option self#char ctx b in Pconst_float (a, b)
@@ -5747,10 +5773,11 @@ class virtual ['res] lift =
             self#constr "Pconst_integer" [a; b]
         | Pconst_char a ->
             let a = self#char a in self#constr "Pconst_char" [a]
-        | Pconst_string (a, b) ->
+        | Pconst_string (a, b, c) ->
             let a = self#string a in
-            let b = self#option self#string b in
-            self#constr "Pconst_string" [a; b]
+            let b = self#location b in
+            let c = self#option self#string c in
+            self#constr "Pconst_string" [a; b; c]
         | Pconst_float (a, b) ->
             let a = self#string a in
             let b = self#option self#char b in

ast/ast_helper_lite.ml

@@ -20,7 +20,7 @@ open Ocaml_common
 module Location = Location
 module Longident = Longident
 
-open Migrate_parsetree.Ast_410
+open Migrate_parsetree.Ast_411
 
 [@@@warning "-9"]
 open Asttypes
@@ -47,7 +47,8 @@ module Const = struct
   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 string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter)
+  let string ?quotation_delimiter ?(loc= !default_loc) s =
+    Pconst_string (s, loc, quotation_delimiter)
 end
 
 module Attr = struct

ast/ast_helper_lite.mli

@@ -16,7 +16,7 @@
 (** Copy of Ast_helper from OCaml 4.10 with docstring related stuff removed *)
 
 open Ocaml_common
-open Migrate_parsetree.Ast_410
+open Migrate_parsetree.Ast_411
 
 open Asttypes
 open Parsetree
@@ -42,7 +42,7 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
 
 module Const : sig
   val char : char -> constant
-  val string : ?quotation_delimiter:string -> string -> 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

ast/import.ml

@@ -4,7 +4,7 @@
    It must be opened in all modules, especially the ones coming from the compiler.
 *)
 
-module Js    = Versions.OCaml_410
+module Js    = Versions.OCaml_411
 module Ocaml = Versions.OCaml_current
 
 module Select_ast(Ocaml : Versions.OCaml_version) = struct

ast/location_error.ml

@@ -46,7 +46,7 @@ let of_exn exn =
 let to_extension (error : t) =
   let open Parsetree in
   let open Ast_helper in
-  let mk_string_constant x = Str.eval (Exp.constant (Pconst_string (x, None))) in
+  let mk_string_constant x = Str.eval (Exp.constant (Const.string x)) in
   match error_type_of_t error with
   | `Old_error old_error ->
     let rec extension_of_old_error ({loc; msg; if_highlight = _; sub} : old_t) =

ast/pprintast.ml

@@ -222,9 +222,9 @@ let longident_loc f x = pp f "%a" longident x.txt
 let constant f = function
   | Pconst_char i ->
       pp f "%C"  i
-  | Pconst_string (i, None) ->
+  | Pconst_string (i, _, None) ->
       pp f "%S" i
-  | Pconst_string (i, Some delim) ->
+  | Pconst_string (i, _, Some delim) ->
       pp f "{%s|%s|%s}" delim i delim
   | Pconst_integer (i, None) ->
       paren (first_is '-' i) (fun f -> pp f "%s") f i

src/ast_builder.ml

@@ -28,15 +28,15 @@ module Default = struct
 
   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, None))
+  let estring ~loc t = pexp_constant ~loc (Pconst_string (t, loc, None))
   let efloat ~loc t = pexp_constant ~loc (Pconst_float (t, None))
   let eint32 ~loc t = pexp_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
   let eint64 ~loc t = pexp_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))
   let enativeint ~loc t = pexp_constant ~loc (Pconst_integer (Nativeint.to_string t, Some 'n'))
 
   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, None))
+  let pstring ~loc t = ppat_constant ~loc (Pconst_string (t, loc, None))
   let pfloat ~loc t = ppat_constant ~loc (Pconst_float (t, None))
   let pint32 ~loc t = ppat_constant ~loc (Pconst_integer (Int32.to_string t, Some 'l'))
   let pint64 ~loc t = ppat_constant ~loc (Pconst_integer (Int64.to_string t, Some 'L'))

src/ast_pattern.ml

@@ -160,11 +160,11 @@ let pack3 t = map t ~f:(fun f x y z -> f (x, y, z))
 include Ast_pattern_generated
 
 let echar      t = pexp_constant (pconst_char   t     )
-let estring    t = pexp_constant (pconst_string t drop)
+let estring    t = pexp_constant (pconst_string t drop drop)
 let efloat     t = pexp_constant (pconst_float  t drop)
 
 let pchar      t = ppat_constant (pconst_char   t     )
-let pstring    t = ppat_constant (pconst_string t drop)
+let pstring    t = ppat_constant (pconst_string t drop drop)
 let pfloat     t = ppat_constant (pconst_float  t drop)
 
 let int'       (T f) = T (fun ctx loc x k -> f ctx loc (int_of_string       x) k)

src/reconcile.ml

@@ -98,7 +98,8 @@ module Replacements = struct
          String.(<>) repl.stop .pos_fname input_name then
         Location.raise_errorf ~loc:(Location.in_file input_filename)
           "ppxlib_driver: the rewriting contains parts from another file.\n\
-           It is too complicated to reconcile it with the source";
+           It is too complicated to reconcile it with the source: %s or %s and %s"
+           repl.start.pos_fname repl.stop.pos_fname input_name;
       assert (repl.start.pos_cnum <= repl.stop.pos_cnum));
     let repls =
       List.sort repls ~cmp:(fun  a b ->

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

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