From 2e8573c7342a44bc2d55b1f9dd936e83a6ad9c48 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Tue, 15 Sep 2020 10:36:28 +0200 Subject: [PATCH] Upgrade internal AST to 4.11 Signed-off-by: Nathan Rebours --- ast/ast.ml | 55 ++++++++++++++----- ast/ast_helper_lite.ml | 5 +- ast/ast_helper_lite.mli | 4 +- ast/import.ml | 2 +- ast/location_error.ml | 2 +- ast/pprintast.ml | 4 +- src/ast_builder.ml | 4 +- src/ast_pattern.ml | 4 +- src/reconcile.ml | 3 +- .../inline/foo-deriver/ppx_foo_deriver.ml | 2 +- 10 files changed, 57 insertions(+), 28 deletions(-) diff --git a/ast/ast.ml b/ast/ast.ml index 04fbfba5f..85ec57fd0 100644 --- a/ast/ast.ml +++ b/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 diff --git a/ast/ast_helper_lite.ml b/ast/ast_helper_lite.ml index f774f7642..11c6bbfb1 100644 --- a/ast/ast_helper_lite.ml +++ b/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 diff --git a/ast/ast_helper_lite.mli b/ast/ast_helper_lite.mli index 55ad92104..99bdeef36 100644 --- a/ast/ast_helper_lite.mli +++ b/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 diff --git a/ast/import.ml b/ast/import.ml index e44789fde..69b05888b 100644 --- a/ast/import.ml +++ b/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 diff --git a/ast/location_error.ml b/ast/location_error.ml index 4be933d10..4e2e484be 100644 --- a/ast/location_error.ml +++ b/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) = diff --git a/ast/pprintast.ml b/ast/pprintast.ml index 95d80f2db..429179851 100644 --- a/ast/pprintast.ml +++ b/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 diff --git a/src/ast_builder.ml b/src/ast_builder.ml index 4f4f09c6a..08fc38792 100644 --- a/src/ast_builder.ml +++ b/src/ast_builder.ml @@ -28,7 +28,7 @@ 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')) @@ -36,7 +36,7 @@ module Default = struct 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')) diff --git a/src/ast_pattern.ml b/src/ast_pattern.ml index 05c413247..c102125fa 100644 --- a/src/ast_pattern.ml +++ b/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) diff --git a/src/reconcile.ml b/src/reconcile.ml index 07b432bcd..7f9af0dcc 100644 --- a/src/reconcile.ml +++ b/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 -> diff --git a/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml b/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml index 8112d5ecf..426a7a7dd 100644 --- a/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml +++ 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 = [];