diff --git a/CHANGES.md b/CHANGES.md index af7d19de1b..200b0ea21c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,12 @@ Items marked with an asterisk (\*) are changes that are likely to format existing code differently from the previous release when using the default profile. This started with version 0.26.0. +## unreleased + +### Changed + +- Compatible with OCaml 5.2.0 (#2510, @gpetiot, @Julow) + ## 0.26.1 (2023-09-15) ### Changed diff --git a/test/cli/repl_file_errors.t/run.t b/test/cli/repl_file_errors.t/run.t index e13ec8aa46..9a1251f904 100644 --- a/test/cli/repl_file_errors.t/run.t +++ b/test/cli/repl_file_errors.t/run.t @@ -5,25 +5,25 @@ Make sure the locations of errors in repl files are right. $ ocamlformat --repl-file line5.repl ocamlformat: ignoring "line5.repl" (syntax error) File "line5.repl", line 5, characters 12-12: - Error: Syntax error: a toplevel phrase must end with `;;`. expected. + Error: Syntax error: "a toplevel phrase must end with `;;`." expected. [1] $ ocamlformat --repl-file line6.repl ocamlformat: ignoring "line6.repl" (syntax error) File "line6.repl", line 6, characters 12-12: - Error: Syntax error: a toplevel phrase must end with `;;`. expected. + Error: Syntax error: "a toplevel phrase must end with `;;`." expected. [1] $ ocamlformat --repl-file line7.repl ocamlformat: ignoring "line7.repl" (syntax error) File "line7.repl", line 7, characters 12-12: - Error: Syntax error: a toplevel phrase must end with `;;`. expected. + Error: Syntax error: "a toplevel phrase must end with `;;`." expected. [1] $ ocamlformat --repl-file missing_semisemi.repl ocamlformat: ignoring "missing_semisemi.repl" (syntax error) File "missing_semisemi.repl", line 2, characters 10-10: - Error: Syntax error: a toplevel phrase must end with `;;`. expected. + Error: Syntax error: "a toplevel phrase must end with `;;`." expected. [1] $ ocamlformat --repl-file empty_line_begin.repl diff --git a/test/failing/tests/module.ml.broken-ref b/test/failing/tests/module.ml.broken-ref index 294f31cfe5..425a3b56e4 100644 --- a/test/failing/tests/module.ml.broken-ref +++ b/test/failing/tests/module.ml.broken-ref @@ -2,8 +2,8 @@ ocamlformat: ignoring "tests/module.ml" (syntax error) File "tests/module.ml", line 5, characters 18-22: 5 | include Foo with type t := t ^^^^ -Error: Syntax error: 'end' expected +Error: Syntax error: "end" expected File "tests/module.ml", line 3, characters 15-21: 3 | module G = struct ^^^^^^ - This 'struct' might be unmatched + This "struct" might be unmatched diff --git a/test/failing/tests/nesting.ml.broken-ref b/test/failing/tests/nesting.ml.broken-ref index 7e459c6352..0cd4dd5475 100644 --- a/test/failing/tests/nesting.ml.broken-ref +++ b/test/failing/tests/nesting.ml.broken-ref @@ -1,7 +1,7 @@ ocamlformat: ignoring "tests/nesting.ml" (syntax error) File "tests/nesting.ml", line 35, characters 0-0: -Error: Syntax error: 'end' expected +Error: Syntax error: "end" expected File "tests/nesting.ml", line 1, characters 11-17: 1 | module M = struct ^^^^^^ - This 'struct' might be unmatched + This "struct" might be unmatched diff --git a/test/failing/tests/never_align.ml.broken-ref b/test/failing/tests/never_align.ml.broken-ref index 84dc3cda67..2a58856f79 100644 --- a/test/failing/tests/never_align.ml.broken-ref +++ b/test/failing/tests/never_align.ml.broken-ref @@ -2,8 +2,8 @@ ocamlformat: ignoring "tests/never_align.ml" (syntax error) File "tests/never_align.ml", line 13, characters 4-5: 13 | b ^ -Error: Syntax error: '}' expected +Error: Syntax error: "}" expected File "tests/never_align.ml", line 11, characters 8-9: 11 | let _ = { ^ - This '{' might be unmatched + This "{" might be unmatched diff --git a/test/failing/tests/ppx_stritem_ext.ml.broken-ref b/test/failing/tests/ppx_stritem_ext.ml.broken-ref index 1dd9b07e85..c1fe6b1ac3 100644 --- a/test/failing/tests/ppx_stritem_ext.ml.broken-ref +++ b/test/failing/tests/ppx_stritem_ext.ml.broken-ref @@ -2,4 +2,4 @@ ocamlformat: ignoring "tests/ppx_stritem_ext.ml" (syntax error) File "tests/ppx_stritem_ext.ml", line 10, characters 11-14: 10 | module S = sig ^^^ -Error: Syntax error: struct expected. +Error: Syntax error: "struct" expected. diff --git a/test/unit/test_translation_unit.ml b/test/unit/test_translation_unit.ml index cd087b5bf8..8ed115e5fe 100644 --- a/test/unit/test_translation_unit.ml +++ b/test/unit/test_translation_unit.ml @@ -67,9 +67,9 @@ let test_parse_and_format_module_type = {|test_unit: ignoring "" (syntax error) File "", line 1, characters 3-3: -Error: Syntax error: 'end' expected +Error: Syntax error: "end" expected File "", line 1, characters 0-3: - This 'sig' might be unmatched + This "sig" might be unmatched |} ) ; make_test "full sig" diff --git a/vendor/ocaml-common/location.ml b/vendor/ocaml-common/location.ml index a336e89dcd..3bbeaa4732 100644 --- a/vendor/ocaml-common/location.ml +++ b/vendor/ocaml-common/location.ml @@ -147,7 +147,7 @@ let print_updating_num_loc_lines ppf f arg = pp_set_formatter_out_functions ppf out_functions let setup_colors () = - Misc.Color.setup !Clflags.color + Misc.Style.setup !Clflags.color (******************************************************************************) (* Printing locations, e.g. 'File "foo.ml", line 3, characters 10-12' *) diff --git a/vendor/ocaml-common/syntaxerr.ml b/vendor/ocaml-common/syntaxerr.ml index 6768e9302b..8a326c1104 100644 --- a/vendor/ocaml-common/syntaxerr.ml +++ b/vendor/ocaml-common/syntaxerr.ml @@ -15,6 +15,13 @@ (* Auxiliary type for reporting syntax errors *) +type invalid_package_type = + | Parameterized_types + | Constrained_types + | Private_types + | Not_with_type + | Neither_identifier_nor_with_type + type error = Unclosed of Location.t * string * Location.t * string | Expecting of Location.t * string @@ -23,7 +30,7 @@ type error = | Variable_in_scope of Location.t * string | Other of Location.t | Ill_formed_ast of Location.t * string - | Invalid_package_type of Location.t * string + | Invalid_package_type of Location.t * invalid_package_type | Removed_string_set of Location.t exception Error of error @@ -37,7 +44,7 @@ let location_of_error = function | Not_expecting (l, _) | Ill_formed_ast (l, _) | Invalid_package_type (l, _) - | Expecting (l, _) -> l + | Expecting (l, _) | Removed_string_set l -> l diff --git a/vendor/ocaml-common/syntaxerr.mli b/vendor/ocaml-common/syntaxerr.mli index 577d5360cd..a84bc6664c 100644 --- a/vendor/ocaml-common/syntaxerr.mli +++ b/vendor/ocaml-common/syntaxerr.mli @@ -20,6 +20,13 @@ *) +type invalid_package_type = + | Parameterized_types + | Constrained_types + | Private_types + | Not_with_type + | Neither_identifier_nor_with_type + type error = Unclosed of Location.t * string * Location.t * string | Expecting of Location.t * string @@ -28,7 +35,7 @@ type error = | Variable_in_scope of Location.t * string | Other of Location.t | Ill_formed_ast of Location.t * string - | Invalid_package_type of Location.t * string + | Invalid_package_type of Location.t * invalid_package_type | Removed_string_set of Location.t exception Error of error diff --git a/vendor/parser-extended/parse.ml b/vendor/parser-extended/parse.ml index 3f7382efe9..24095af723 100644 --- a/vendor/parser-extended/parse.ml +++ b/vendor/parser-extended/parse.ml @@ -138,6 +138,8 @@ let type_ident = wrap Parser.Incremental.parse_mty_longident (* Error reporting for Syntaxerr *) (* The code has been moved here so that one can reuse Pprintast.tyvar *) +module Style = Misc.Style + let prepare_error err = let open Syntaxerr in match err with @@ -146,37 +148,58 @@ let prepare_error err = ~loc:closing_loc ~sub:[ Location.msg ~loc:opening_loc - "This '%s' might be unmatched" opening + "This %a might be unmatched" Style.inline_code opening ] - "Syntax error: '%s' expected" closing + "Syntax error: %a expected" Style.inline_code closing | Expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s expected." nonterm + Location.errorf ~loc "Syntax error: %a expected." + Style.inline_code nonterm | Not_expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s not expected." nonterm + Location.errorf ~loc "Syntax error: %a not expected." + Style.inline_code nonterm | Applicative_path loc -> Location.errorf ~loc - "Syntax error: applicative paths of the form F(X).t \ - are not supported when the option -no-app-func is set." + "Syntax error: applicative paths of the form %a \ + are not supported when the option %a is set." + Style.inline_code "F(X).t" + Style.inline_code "-no-app-func" | Variable_in_scope (loc, var) -> Location.errorf ~loc "In this scoped type, variable %a \ - is reserved for the local type %s." - Pprintast.tyvar var var + is reserved for the local type %a." + (Style.as_inline_code Pprintast.tyvar) var + Style.inline_code var | Other loc -> Location.errorf ~loc "Syntax error" | Ill_formed_ast (loc, s) -> Location.errorf ~loc "broken invariant in parsetree: %s" s - | Invalid_package_type (loc, s) -> - Location.errorf ~loc "invalid package type: %s" s + | Invalid_package_type (loc, ipt) -> + let invalid ppf ipt = match ipt with + | Syntaxerr.Parameterized_types -> + Format.fprintf ppf "parametrized types are not supported" + | Constrained_types -> + Format.fprintf ppf "constrained types are not supported" + | Private_types -> + Format.fprintf ppf "private types are not supported" + | Not_with_type -> + Format.fprintf ppf "only %a constraints are supported" + Style.inline_code "with type t =" + | Neither_identifier_nor_with_type -> + Format.fprintf ppf + "only module type identifier and %a constraints are supported" + Style.inline_code "with type" + in + Location.errorf ~loc "invalid package type: %a" invalid ipt | Removed_string_set loc -> Location.errorf ~loc "Syntax error: strings are immutable, there is no assignment \ syntax for them.\n\ @{Hint@}: Mutable sequences of bytes are available in \ the Bytes module.\n\ - @{Hint@}: Did you mean to use 'Bytes.set'?" + @{Hint@}: Did you mean to use %a?" + Style.inline_code "Bytes.set" let () = Location.register_error_of_exn (function diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly index a7a060cee8..9477ea1df4 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -503,11 +503,11 @@ let package_type_of_module_type pmty = | Pwith_type (lid, ptyp) -> let loc = ptyp.ptype_loc in if ptyp.ptype_params <> [] then - err loc "parametrized types are not supported"; + err loc Syntaxerr.Parameterized_types; if ptyp.ptype_cstrs <> [] then - err loc "constrained types are not supported"; + err loc Syntaxerr.Constrained_types; if ptyp.ptype_private <> Public then - err loc "private types are not supported"; + err loc Syntaxerr.Private_types; (* restrictions below are checked by the 'with_constraint' rule *) assert (ptyp.ptype_kind = Ptype_abstract); @@ -519,15 +519,14 @@ let package_type_of_module_type pmty = in (lid, ty) | _ -> - err pmty.pmty_loc "only 'with type t =' constraints are supported" + err pmty.pmty_loc Not_with_type in match pmty with | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes) | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} -> (lid, List.map map_cstr cstrs, pmty.pmty_attributes) | _ -> - err pmty.pmty_loc - "only module type identifier and 'with type' constraints are supported" + err pmty.pmty_loc Neither_identifier_nor_with_type let mk_directive_arg ~loc k = { pdira_desc = k; diff --git a/vendor/parser-shims/dune b/vendor/parser-shims/dune index 06df67dded..27413b1f72 100644 --- a/vendor/parser-shims/dune +++ b/vendor/parser-shims/dune @@ -1,4 +1,6 @@ (library (name parser_shims) (public_name ocamlformat-lib.parser_shims) + (flags + (:standard -w -37 -w -38)) (libraries compiler-libs.common)) diff --git a/vendor/parser-shims/parser_shims.ml b/vendor/parser-shims/parser_shims.ml index 6f00d9be13..ca7749e61d 100644 --- a/vendor/parser-shims/parser_shims.ml +++ b/vendor/parser-shims/parser_shims.ml @@ -23,7 +23,17 @@ module Misc = struct module Color = struct include Color + external isatty : out_channel -> bool = "caml_sys_isatty" + + (* reasonable heuristic on whether colors should be enabled *) + let should_enable_color () = + let term = try Sys.getenv "TERM" with Not_found -> "" in + term <> "dumb" + && term <> "" + && isatty stderr + let default_setting = Auto + let enabled = ref true end module Error_style = struct @@ -31,10 +41,146 @@ module Misc = struct let default_setting = Contextual end + + module Style = struct + (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *) + type color = + | Black + | Red + | Green + | Yellow + | Blue + | Magenta + | Cyan + | White + + type style = + | FG of color (* foreground *) + | BG of color (* background *) + | Bold + | Reset + + let ansi_of_color = function + | Black -> "0" + | Red -> "1" + | Green -> "2" + | Yellow -> "3" + | Blue -> "4" + | Magenta -> "5" + | Cyan -> "6" + | White -> "7" + + let code_of_style = function + | FG c -> "3" ^ ansi_of_color c + | BG c -> "4" ^ ansi_of_color c + | Bold -> "1" + | Reset -> "0" + + let ansi_of_style_l l = + let s = match l with + | [] -> code_of_style Reset + | [s] -> code_of_style s + | _ -> String.concat ";" (List.map code_of_style l) + in + "\x1b[" ^ s ^ "m" + + type Format.stag += Style of style list + + type tag_style ={ + ansi: style list; + text_open:string; + text_close:string + } + + type styles = { + error: tag_style; + warning: tag_style; + loc: tag_style; + hint: tag_style; + inline_code: tag_style; + } + + let no_markup stl = { ansi = stl; text_close = ""; text_open = "" } + + let default_styles = { + warning = no_markup [Bold; FG Magenta]; + error = no_markup [Bold; FG Red]; + loc = no_markup [Bold]; + hint = no_markup [Bold; FG Blue]; + inline_code= { ansi=[Bold]; text_open = {|"|}; text_close = {|"|} } + } + + let cur_styles = ref default_styles + + (* map a tag to a style, if the tag is known. + @raise Not_found otherwise *) + let style_of_tag s = match s with + | Format.String_tag "error" -> (!cur_styles).error + | Format.String_tag "warning" ->(!cur_styles).warning + | Format.String_tag "loc" -> (!cur_styles).loc + | Format.String_tag "hint" -> (!cur_styles).hint + | Format.String_tag "inline_code" -> (!cur_styles).inline_code + | Style s -> no_markup s + | _ -> raise Not_found + + let as_inline_code printer ppf x = + Format.pp_open_stag ppf (Format.String_tag "inline_code"); + printer ppf x; + Format.pp_close_stag ppf () + + let inline_code ppf s = as_inline_code Format.pp_print_string ppf s + + (* either prints the tag of [s] or delegates to [or_else] *) + let mark_open_tag ~or_else s = + try + let style = style_of_tag s in + if !Color.enabled then ansi_of_style_l style.ansi else style.text_open + with Not_found -> or_else s + + let mark_close_tag ~or_else s = + try + let style = style_of_tag s in + if !Color.enabled then ansi_of_style_l [Reset] else style.text_close + with Not_found -> or_else s + + (* add tag handling to formatter [ppf] *) + let set_tag_handling ppf = + let open Format in + let functions = pp_get_formatter_stag_functions ppf () in + let functions' = {functions with + mark_open_stag=(mark_open_tag ~or_else:functions.mark_open_stag); + mark_close_stag=(mark_close_tag ~or_else:functions.mark_close_stag); + } in + pp_set_mark_tags ppf true; (* enable tags *) + pp_set_formatter_stag_functions ppf functions'; + () + + let setup = + let first = ref true in (* initialize only once *) + let formatter_l = + [Format.std_formatter; Format.err_formatter; Format.str_formatter] + in + let enable_color = function + | Color.Auto -> Color.should_enable_color () + | Color.Always -> true + | Color.Never -> false + in + fun o -> + if !first then ( + first := false; + Format.set_mark_tags true; + List.iter set_tag_handling formatter_l; + Color.enabled := (match o with + | Some s -> enable_color s + | None -> enable_color Color.default_setting) + ); + () + end end module Clflags = struct let include_dirs = ref ([] : string list)(* -I *) + let hidden_include_dirs = ref ([] : string list) let debug = ref false (* -g *) let unsafe = ref false (* -unsafe *) let absname = ref false (* -absname *) @@ -54,9 +200,23 @@ end module Load_path = struct type dir + type auto_include_callback = (dir -> string -> string option) -> string -> string - let init ~auto_include:_ _ = () - let get_paths () = [] + + type paths = {visible: string list; hidden: string list} + + let get_paths () = {visible= []; hidden= []} + + let init ~auto_include:_ ~visible:_ ~hidden:_ = () + let auto_include_otherlibs _ _ s = s end + +module Builtin_attributes = struct + type current_phase = Parser | Invariant_check + + let register_attr _ _ = () + + let mark_payload_attrs_used _ = () +end diff --git a/vendor/parser-shims/parser_shims.mli b/vendor/parser-shims/parser_shims.mli index a644b9fb5f..f83ad1e621 100644 --- a/vendor/parser-shims/parser_shims.mli +++ b/vendor/parser-shims/parser_shims.mli @@ -31,10 +31,22 @@ module Misc : sig val default_setting : setting (** @since ocaml-4.09 *) end + + module Style : sig + val as_inline_code: (Format.formatter -> 'a -> unit as 'printer) -> 'printer + (** @since ocaml-5.2 *) + + val inline_code: Format.formatter -> string -> unit + (** @since ocaml-5.2 *) + + val setup : Color.setting option -> unit + (** @since ocaml-5.2 *) + end end module Clflags : sig val include_dirs : string list ref + val hidden_include_dirs : string list ref val debug : bool ref val unsafe : bool ref val open_modules : string list ref @@ -54,9 +66,27 @@ end module Load_path : sig type dir + type auto_include_callback = (dir -> string -> string option) -> string -> string - val init : auto_include:auto_include_callback -> string list -> unit - val get_paths : unit -> string list + + type paths = {visible: string list; hidden: string list} + + val get_paths : unit -> paths + + val init : + auto_include:auto_include_callback + -> visible:string list + -> hidden:string list + -> unit + val auto_include_otherlibs : (string -> unit) -> auto_include_callback end + +module Builtin_attributes : sig + type current_phase = Parser | Invariant_check + + val register_attr : current_phase -> 'a -> unit + + val mark_payload_attrs_used : 'a -> unit +end diff --git a/vendor/parser-standard/ast_mapper.ml b/vendor/parser-standard/ast_mapper.ml index 7b399f07b1..ad79531e4f 100644 --- a/vendor/parser-standard/ast_mapper.ml +++ b/vendor/parser-standard/ast_mapper.ml @@ -865,11 +865,16 @@ module PpxContext = struct } let make ~tool_name () = + let Load_path.{ visible; hidden } = Load_path.get_paths () in let fields = [ lid "tool_name", make_string tool_name; - lid "include_dirs", make_list make_string !Clflags.include_dirs; - lid "load_path", make_list make_string (Load_path.get_paths ()); + lid "include_dirs", make_list make_string (!Clflags.include_dirs); + lid "hidden_include_dirs", + make_list make_string (!Clflags.hidden_include_dirs); + lid "load_path", + make_pair (make_list make_string) (make_list make_string) + (visible, hidden); lid "open_modules", make_list make_string !Clflags.open_modules; lid "for_package", make_option make_string !Clflags.for_package; lid "debug", make_bool !Clflags.debug; @@ -938,6 +943,8 @@ module PpxContext = struct tool_name_ref := get_string payload | "include_dirs" -> Clflags.include_dirs := get_list get_string payload + | "hidden_include_dirs" -> + Clflags.hidden_include_dirs := get_list get_string payload | "load_path" -> (* Duplicates Compmisc.auto_include, since we can't reference Compmisc from this module. *) @@ -948,7 +955,10 @@ module PpxContext = struct let alert = Location.auto_include_alert in Load_path.auto_include_otherlibs alert find_in_dir fn in - Load_path.init ~auto_include (get_list get_string payload) + let visible, hidden = + get_pair (get_list get_string) (get_list get_string) payload + in + Load_path.init ~auto_include ~visible ~hidden | "open_modules" -> Clflags.open_modules := get_list get_string payload | "for_package" -> diff --git a/vendor/parser-standard/parse.ml b/vendor/parser-standard/parse.ml index 3f7382efe9..24095af723 100644 --- a/vendor/parser-standard/parse.ml +++ b/vendor/parser-standard/parse.ml @@ -138,6 +138,8 @@ let type_ident = wrap Parser.Incremental.parse_mty_longident (* Error reporting for Syntaxerr *) (* The code has been moved here so that one can reuse Pprintast.tyvar *) +module Style = Misc.Style + let prepare_error err = let open Syntaxerr in match err with @@ -146,37 +148,58 @@ let prepare_error err = ~loc:closing_loc ~sub:[ Location.msg ~loc:opening_loc - "This '%s' might be unmatched" opening + "This %a might be unmatched" Style.inline_code opening ] - "Syntax error: '%s' expected" closing + "Syntax error: %a expected" Style.inline_code closing | Expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s expected." nonterm + Location.errorf ~loc "Syntax error: %a expected." + Style.inline_code nonterm | Not_expecting (loc, nonterm) -> - Location.errorf ~loc "Syntax error: %s not expected." nonterm + Location.errorf ~loc "Syntax error: %a not expected." + Style.inline_code nonterm | Applicative_path loc -> Location.errorf ~loc - "Syntax error: applicative paths of the form F(X).t \ - are not supported when the option -no-app-func is set." + "Syntax error: applicative paths of the form %a \ + are not supported when the option %a is set." + Style.inline_code "F(X).t" + Style.inline_code "-no-app-func" | Variable_in_scope (loc, var) -> Location.errorf ~loc "In this scoped type, variable %a \ - is reserved for the local type %s." - Pprintast.tyvar var var + is reserved for the local type %a." + (Style.as_inline_code Pprintast.tyvar) var + Style.inline_code var | Other loc -> Location.errorf ~loc "Syntax error" | Ill_formed_ast (loc, s) -> Location.errorf ~loc "broken invariant in parsetree: %s" s - | Invalid_package_type (loc, s) -> - Location.errorf ~loc "invalid package type: %s" s + | Invalid_package_type (loc, ipt) -> + let invalid ppf ipt = match ipt with + | Syntaxerr.Parameterized_types -> + Format.fprintf ppf "parametrized types are not supported" + | Constrained_types -> + Format.fprintf ppf "constrained types are not supported" + | Private_types -> + Format.fprintf ppf "private types are not supported" + | Not_with_type -> + Format.fprintf ppf "only %a constraints are supported" + Style.inline_code "with type t =" + | Neither_identifier_nor_with_type -> + Format.fprintf ppf + "only module type identifier and %a constraints are supported" + Style.inline_code "with type" + in + Location.errorf ~loc "invalid package type: %a" invalid ipt | Removed_string_set loc -> Location.errorf ~loc "Syntax error: strings are immutable, there is no assignment \ syntax for them.\n\ @{Hint@}: Mutable sequences of bytes are available in \ the Bytes module.\n\ - @{Hint@}: Did you mean to use 'Bytes.set'?" + @{Hint@}: Did you mean to use %a?" + Style.inline_code "Bytes.set" let () = Location.register_error_of_exn (function diff --git a/vendor/parser-standard/parser.mly b/vendor/parser-standard/parser.mly index a303e14725..3785f49787 100644 --- a/vendor/parser-standard/parser.mly +++ b/vendor/parser-standard/parser.mly @@ -595,11 +595,11 @@ let package_type_of_module_type pmty = | Pwith_type (lid, ptyp) -> let loc = ptyp.ptype_loc in if ptyp.ptype_params <> [] then - err loc "parametrized types are not supported"; + err loc Syntaxerr.Parameterized_types; if ptyp.ptype_cstrs <> [] then - err loc "constrained types are not supported"; + err loc Syntaxerr.Constrained_types; if ptyp.ptype_private <> Public then - err loc "private types are not supported"; + err loc Syntaxerr.Private_types; (* restrictions below are checked by the 'with_constraint' rule *) assert (ptyp.ptype_kind = Ptype_abstract); @@ -611,15 +611,14 @@ let package_type_of_module_type pmty = in (lid, ty) | _ -> - err pmty.pmty_loc "only 'with type t =' constraints are supported" + err pmty.pmty_loc Not_with_type in match pmty with | {pmty_desc = Pmty_ident lid} -> (lid, [], pmty.pmty_attributes) | {pmty_desc = Pmty_with({pmty_desc = Pmty_ident lid}, cstrs)} -> (lid, List.map map_cstr cstrs, pmty.pmty_attributes) | _ -> - err pmty.pmty_loc - "only module type identifier and 'with type' constraints are supported" + err pmty.pmty_loc Neither_identifier_nor_with_type let mk_directive_arg ~loc k = { pdira_desc = k;