From d974c176f52e88a0c38aed67be1677d34e9fde6d Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Fri, 3 Apr 2026 15:02:12 +0200 Subject: [PATCH] Add MetaOCaml support Add a --metaocaml flag to enable MetaOCaml syntax (brackets .< >., escape .~, run .!) in the lexer and formatter. Lexer changes: - Split symbolchar into symbolcharnodot/symbolchar to avoid capturing MetaOCaml tokens as operator characters - Gate .~ (escape) and >. (bracket close) behind the metaocaml flag; .< (bracket open) is always lexed as METAOCAML_BRACKET_OPEN - Add symbolchars sub-lexer for consuming remaining operator chars after >. when metaocaml is disabled - Thread ~metaocaml through parse.ml to set lex_metaocaml ref Formatter changes: - Detect metaocaml.bracket and metaocaml.escape extension nodes (synthetic, with ghost loc) and render them with sugar syntax (.< expr >. and .~expr) instead of [%metaocaml.bracket ...] - Parenthesize .~ argument unless it is a simple identifier - Skip comment relocation for metaocaml extension nodes in Cmts Configuration: - Add metaocaml boolean to opr_opts (Conf_t), default false - Wire --metaocaml/--no-metaocaml flag through Conf and CLI - Thread ~metaocaml through Extended_ast, Std_ast, Parse_with_comments, Toplevel_lexer --- doc/manpage_ocamlformat.mld | 6 +++++ lib/Cmts.ml | 16 ++++++++++++ lib/Conf.ml | 12 +++++++-- lib/Conf_t.ml | 3 ++- lib/Conf_t.mli | 3 ++- lib/Extended_ast.ml | 18 +++++++------- lib/Extended_ast.mli | 1 + lib/Fmt_ast.ml | 42 ++++++++++++++++++++++++++------ lib/Parse_with_comments.ml | 9 ++++--- lib/Parse_with_comments.mli | 2 ++ lib/Std_ast.ml | 16 ++++++------ lib/Std_ast.mli | 1 + lib/Toplevel_lexer.mli | 1 + lib/Toplevel_lexer.mll | 4 +-- test/cli/print_config.t | 3 +++ tools/printast/printast.ml | 25 +++++++++++-------- vendor/parser-extended/lexer.mll | 22 +++++++++++++---- vendor/parser-extended/parse.ml | 3 ++- vendor/parser-standard/lexer.mll | 21 ++++++++++++---- vendor/parser-standard/parse.ml | 3 ++- 20 files changed, 156 insertions(+), 55 deletions(-) diff --git a/doc/manpage_ocamlformat.mld b/doc/manpage_ocamlformat.mld index b8e2466594..7429d8b3f3 100644 --- a/doc/manpage_ocamlformat.mld +++ b/doc/manpage_ocamlformat.mld @@ -589,6 +589,9 @@ OPTIONS Emit a warning if the formatted output exceeds the margin. The flag is unset by default. + --metaocaml + Enable MetaOCaml support. The flag is unset by default. + -n N, --max-iters=N Fail if output of formatting does not stabilize within N iterations. May be set in .ocamlformat. The default value is 10. @@ -615,6 +618,9 @@ OPTIONS --no-margin-check Unset margin-check. + --no-metaocaml + Unset metaocaml. + --no-quiet Unset quiet. diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 955f369dda..15c50ce90b 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -350,6 +350,22 @@ let relocate_ext_cmts (t : t) src (_pre, pld) ~whole_loc = ; pstr_loc } ] when Source.is_quoted_string src pstr_loc -> () + | PStr + [ { pstr_desc= + Pstr_eval + ( { pexp_desc= Pexp_sequence (e1, _) + ; pexp_loc= _ + ; pexp_loc_stack= _ + ; pexp_attributes } + , [] ) + ; pstr_loc= _ } ] + when List.is_empty pexp_attributes + && Source.extension_using_sugar ~name:pre ~payload:e1.pexp_loc -> + () + | PStr [{pstr_desc= Pstr_eval (_, _); pstr_loc= _}] + when String.is_prefix ~prefix:"metaocaml." pre.txt + && Location.is_none pre.loc -> + () | PStr [{pstr_desc= Pstr_eval _; pstr_loc; _}] -> let kwd_loc = match Source.loc_of_first_token_at src whole_loc LBRACKETPERCENT with diff --git a/lib/Conf.ml b/lib/Conf.ml index b914234da4..1b6a82da9e 100644 --- a/lib/Conf.ml +++ b/lib/Conf.ml @@ -269,7 +269,8 @@ let default = ; ocaml_version= elt (Ocaml_version.v ~patch:0 5 4) ; quiet= elt false ; disable_conf_attrs= elt false - ; version_check= elt true } } + ; version_check= elt true + ; metaocaml= elt false } } module V = struct let v0_12 = Version.make ~major:0 ~minor:12 ~patch:None @@ -1496,6 +1497,12 @@ module Operational = struct (fun conf elt -> update conf ~f:(fun f -> {f with version_check= elt})) (fun conf -> conf.opr_opts.version_check) + let metaocaml = + let doc = "Enable MetaOCaml support." in + Decl.flag ~default ~names:["metaocaml"] ~doc ~kind + (fun conf elt -> update conf ~f:(fun f -> {f with metaocaml= elt})) + (fun conf -> conf.opr_opts.metaocaml) + let options : Store.t = Store. [ elt comment_check @@ -1506,7 +1513,8 @@ module Operational = struct ; elt ocaml_version ; elt quiet ; elt disable_conf_attrs - ; elt version_check ] + ; elt version_check + ; elt metaocaml ] end let options = Operational.options @ Formatting.options @ options diff --git a/lib/Conf_t.ml b/lib/Conf_t.ml index c332d45cfc..9461dae2e7 100644 --- a/lib/Conf_t.ml +++ b/lib/Conf_t.ml @@ -132,7 +132,8 @@ type opr_opts = ; ocaml_version: Ocaml_version.t elt ; quiet: bool elt ; disable_conf_attrs: bool elt - ; version_check: bool elt } + ; version_check: bool elt + ; metaocaml: bool elt } type t = { fmt_opts: fmt_opts diff --git a/lib/Conf_t.mli b/lib/Conf_t.mli index 42a059b513..7b23502344 100644 --- a/lib/Conf_t.mli +++ b/lib/Conf_t.mli @@ -135,7 +135,8 @@ type opr_opts = (** Version of OCaml syntax of the output. *) ; quiet: bool elt ; disable_conf_attrs: bool elt - ; version_check: bool elt } + ; version_check: bool elt + ; metaocaml: bool elt } type t = { fmt_opts: fmt_opts diff --git a/lib/Extended_ast.ml b/lib/Extended_ast.ml index 42c62d77cf..9348ef0cfd 100644 --- a/lib/Extended_ast.ml +++ b/lib/Extended_ast.ml @@ -344,7 +344,7 @@ module Parse = struct in Ast_mapper.{default_mapper with expr; pat; binding_op; value_bindings} - let ast (type a) (fg : a t) ~ocaml_version ~preserve_beginend + let ast (type a) (fg : a t) ~ocaml_version ~metaocaml ~preserve_beginend ~prefer_let_puns ~input_name str : a = map fg (normalize_mapper ~ocaml_version ~preserve_beginend ~prefer_let_puns) @@ -355,14 +355,14 @@ module Parse = struct in Location.init_info lexbuf input_name ; match fg with - | Structure -> Parse.implementation ~ocaml_version lexbuf - | Signature -> Parse.interface ~ocaml_version lexbuf - | Use_file -> Parse.use_file ~ocaml_version lexbuf - | Core_type -> Parse.core_type ~ocaml_version lexbuf - | Module_type -> Parse.module_type ~ocaml_version lexbuf - | Expression -> Parse.expression ~ocaml_version lexbuf - | Pattern -> Parse.pattern ~ocaml_version lexbuf - | Repl_file -> Toplevel_lexer.repl_file ~ocaml_version lexbuf + | Structure -> Parse.implementation ~ocaml_version ~metaocaml lexbuf + | Signature -> Parse.interface ~ocaml_version ~metaocaml lexbuf + | Use_file -> Parse.use_file ~ocaml_version ~metaocaml lexbuf + | Core_type -> Parse.core_type ~ocaml_version ~metaocaml lexbuf + | Module_type -> Parse.module_type ~ocaml_version ~metaocaml lexbuf + | Expression -> Parse.expression ~ocaml_version ~metaocaml lexbuf + | Pattern -> Parse.pattern ~ocaml_version ~metaocaml lexbuf + | Repl_file -> Toplevel_lexer.repl_file ~ocaml_version ~metaocaml lexbuf | Documentation -> let pos = (Location.curr lexbuf).loc_start in let pos = {pos with pos_fname= input_name} in diff --git a/lib/Extended_ast.mli b/lib/Extended_ast.mli index bf4b0c145f..6866be1743 100644 --- a/lib/Extended_ast.mli +++ b/lib/Extended_ast.mli @@ -36,6 +36,7 @@ module Parse : sig val ast : 'a t -> ocaml_version:Ocaml_version.t + -> metaocaml:bool -> preserve_beginend:bool -> prefer_let_puns:bool option -> input_name:string diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 62ecceced4..e55de59fbc 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -636,7 +636,7 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) = | _, PPat (({ppat_loc; _} as pat), _), (Pld _ | Top) when Source.extension_using_sugar ~name:ext ~payload:ppat_loc -> fmt_pattern c ~ext (sub_pat ~ctx pat) - | _ -> + | _ -> ( let box = if c.conf.fmt_opts.ocp_indent_compat.v then match pld with @@ -646,12 +646,40 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) = hvbox c.conf.fmt_opts.stritem_extension_indent.v else Fn.id in - box - (wrap (str "[") (str "]") - ( str (Ext.Key.to_string key) - $ fmt_str_loc c ext - $ fmt_payload c (Pld pld) pld - $ fmt_if (Exposed.Right.payload pld) (str " ") ) ) + let is_metaocaml_sugar = + if + String.is_prefix ~prefix:"metaocaml." ext.txt + && Location.is_none ext.loc + then + match pld with + | PStr [({pstr_desc= Pstr_eval (e, []); _} as pstr)] -> + let node = + match ext.txt with + | "metaocaml.escape" -> `Escape + | "metaocaml.bracket" -> `Bracket + | _ -> assert false + in + Some (node, e, Str pstr) + | _ -> assert false + else None + in + match is_metaocaml_sugar with + | Some (`Escape, e, ctx) -> + let parens = + match e.pexp_desc with Pexp_ident _ -> false | _ -> true + in + box (str ".~" $ fmt_expression c ~parens (sub_exp ~ctx e)) + | Some (`Bracket, e, ctx) -> + box + (wrap (str ".< ") (str " >.") + (fmt_expression c (sub_exp ~ctx e)) ) + | None -> + box + (wrap (str "[") (str "]") + ( str (Ext.Key.to_string key) + $ fmt_str_loc c ext + $ fmt_payload c (Pld pld) pld + $ fmt_if (Exposed.Right.payload pld) (str " ") ) ) ) and fmt_extension = fmt_extension_aux ~key:Ext.Key.Regular diff --git a/lib/Parse_with_comments.ml b/lib/Parse_with_comments.ml index 4a1c48a5bc..06002b8023 100644 --- a/lib/Parse_with_comments.ml +++ b/lib/Parse_with_comments.ml @@ -85,7 +85,10 @@ let parse ?(disable_w50 = false) ?(disable_deprecated = false) parse fragment else not conf.opr_opts.quiet.v ) ~f:(fun () -> let ocaml_version = conf.opr_opts.ocaml_version.v in - let ast = parse fragment ~ocaml_version ~input_name source in + let metaocaml = conf.opr_opts.metaocaml.v in + let ast = + parse fragment ~ocaml_version ~metaocaml ~input_name source + in Warnings.check_fatal () ; let comments = let mk_cmt = function @@ -104,7 +107,7 @@ let parse ?(disable_w50 = false) ?(disable_deprecated = false) parse fragment in match List.rev !w50 with [] -> t | w50 -> raise (Warning50 w50) -let parse_ast (conf : Conf.t) fg ~ocaml_version ~input_name s = +let parse_ast (conf : Conf.t) fg ~ocaml_version ~metaocaml ~input_name s = let preserve_beginend = Poly.(conf.fmt_opts.exp_grouping.v = `Preserve) in let prefer_let_puns = match conf.fmt_opts.letop_punning.v with @@ -112,7 +115,7 @@ let parse_ast (conf : Conf.t) fg ~ocaml_version ~input_name s = | `Never -> Some false | `Preserve -> None in - Extended_ast.Parse.ast fg ~ocaml_version ~preserve_beginend + Extended_ast.Parse.ast fg ~ocaml_version ~metaocaml ~preserve_beginend ~prefer_let_puns ~input_name s (** [is_repl_block x] returns whether [x] is a list of REPL phrases and diff --git a/lib/Parse_with_comments.mli b/lib/Parse_with_comments.mli index f2fc03ce2b..0669e77855 100644 --- a/lib/Parse_with_comments.mli +++ b/lib/Parse_with_comments.mli @@ -31,6 +31,7 @@ val parse : -> ?disable_deprecated:bool -> ( 'b -> ocaml_version:Ocaml_version.t + -> metaocaml:bool -> input_name:string -> string -> 'a ) @@ -57,6 +58,7 @@ val parse_ast : Conf.t -> 'a Extended_ast.t -> ocaml_version:Ocaml_version.t + -> metaocaml:bool -> input_name:string -> string -> 'a diff --git a/lib/Std_ast.ml b/lib/Std_ast.ml index c00c34ca0e..5aeb7069d6 100644 --- a/lib/Std_ast.ml +++ b/lib/Std_ast.ml @@ -59,20 +59,20 @@ let map (type a) (x : a t) (m : Ast_mapper.mapper) : a -> a = | Documentation -> Fn.id module Parse = struct - let ast (type a) (fg : a t) ~ocaml_version ~input_name str : a = + let ast (type a) (fg : a t) ~ocaml_version ~metaocaml ~input_name str : a = let lexbuf = Lexing.from_string str in let ocaml_version = Some Ocaml_version.(major ocaml_version, minor ocaml_version) in Location.init_info lexbuf input_name ; match fg with - | Structure -> Parse.implementation ~ocaml_version lexbuf - | Signature -> Parse.interface ~ocaml_version lexbuf - | Use_file -> Parse.use_file ~ocaml_version lexbuf - | Core_type -> Parse.core_type ~ocaml_version lexbuf - | Module_type -> Parse.module_type ~ocaml_version lexbuf - | Expression -> Parse.expression ~ocaml_version lexbuf - | Pattern -> Parse.pattern ~ocaml_version lexbuf + | Structure -> Parse.implementation ~ocaml_version ~metaocaml lexbuf + | Signature -> Parse.interface ~ocaml_version ~metaocaml lexbuf + | Use_file -> Parse.use_file ~ocaml_version ~metaocaml lexbuf + | Core_type -> Parse.core_type ~ocaml_version ~metaocaml lexbuf + | Module_type -> Parse.module_type ~ocaml_version ~metaocaml lexbuf + | Expression -> Parse.expression ~ocaml_version ~metaocaml lexbuf + | Pattern -> Parse.pattern ~ocaml_version ~metaocaml lexbuf | Repl_file -> () | Documentation -> () end diff --git a/lib/Std_ast.mli b/lib/Std_ast.mli index bc0646da38..5213e58f30 100644 --- a/lib/Std_ast.mli +++ b/lib/Std_ast.mli @@ -37,6 +37,7 @@ module Parse : sig val ast : 'a t -> ocaml_version:Ocaml_version.t + -> metaocaml:bool -> input_name:string -> string -> 'a diff --git a/lib/Toplevel_lexer.mli b/lib/Toplevel_lexer.mli index d7f3b4cbd1..eb769d3292 100644 --- a/lib/Toplevel_lexer.mli +++ b/lib/Toplevel_lexer.mli @@ -11,5 +11,6 @@ val repl_file : ocaml_version:(int * int) option + -> metaocaml:bool -> Lexing.lexbuf -> Parsetree.repl_phrase list diff --git a/lib/Toplevel_lexer.mll b/lib/Toplevel_lexer.mll index 8b18db7f6f..b74ec39837 100644 --- a/lib/Toplevel_lexer.mll +++ b/lib/Toplevel_lexer.mll @@ -52,7 +52,7 @@ and phrase buf = parse | _ as c { Buffer.add_char buf c; phrase buf lexbuf } { -let repl_file ~ocaml_version lx = +let repl_file ~ocaml_version ~metaocaml lx = let x = token lx in let open Ocamlformat_parser_extended.Parsetree in List.fold_left (fun acc -> function @@ -61,7 +61,7 @@ let repl_file ~ocaml_version lx = let filename = (Location.curr lx).loc_start.pos_fname in Lexing.set_filename cmd_lexbuf filename ; Lexing.set_position cmd_lexbuf pos_start ; - { prepl_phrase= Parse.toplevel_phrase ~ocaml_version cmd_lexbuf + { prepl_phrase= Parse.toplevel_phrase ~ocaml_version ~metaocaml cmd_lexbuf ; prepl_output= "" } :: acc | `Output ("", _) -> acc diff --git a/test/cli/print_config.t b/test/cli/print_config.t index 46cb289268..c8078f68b2 100644 --- a/test/cli/print_config.t +++ b/test/cli/print_config.t @@ -22,6 +22,7 @@ No redundant values: quiet=false disable-conf-attrs=false version-check=true + metaocaml=false assignment-operator=end-line (profile conventional (file .ocamlformat:1)) break-before-in=fit-or-vertical (profile conventional (file .ocamlformat:1)) break-cases=fit (profile conventional (file .ocamlformat:1)) @@ -103,6 +104,7 @@ Redundant values from the conventional profile: quiet=false disable-conf-attrs=false version-check=true + metaocaml=false assignment-operator=end-line (profile conventional (file .ocamlformat:1)) break-before-in=fit-or-vertical (profile conventional (file .ocamlformat:1)) break-cases=fit (profile conventional (file .ocamlformat:1)) @@ -184,6 +186,7 @@ Redundant values from the ocamlformat profile: quiet=false disable-conf-attrs=false version-check=true + metaocaml=false assignment-operator=end-line (profile ocamlformat (file .ocamlformat:1)) break-before-in=fit-or-vertical (profile ocamlformat (file .ocamlformat:1)) break-cases=nested (profile ocamlformat (file .ocamlformat:1)) diff --git a/tools/printast/printast.ml b/tools/printast/printast.ml index 509917d82d..2ee87df97a 100644 --- a/tools/printast/printast.ml +++ b/tools/printast/printast.ml @@ -3,22 +3,26 @@ open Ocamlformat_lib let ocaml_version = Ocaml_version.sys_version -let extended_ast ppf syntax ~input_name content = +let extended_ast ppf syntax ~input_name ~metaocaml content = let open Extended_ast in let (Any kind) = of_syntax syntax in - Parse.ast kind ~ocaml_version ~preserve_beginend:true ~prefer_let_puns:None + Parse.ast kind ~ocaml_version ~metaocaml ~preserve_beginend:true ~prefer_let_puns:None ~input_name content |> Printast.ast kind ppf -let std_ast ppf syntax ~input_name content = +let std_ast ppf syntax ~input_name ~metaocaml content = let open Std_ast in let (Any kind) = of_syntax syntax in - Parse.ast kind ~ocaml_version ~input_name content |> Printast.ast kind ppf + Parse.ast kind ~ocaml_version ~metaocaml ~input_name content + |> Printast.ast kind ppf let get_arg () = - let std = ref false and input = ref None in - let opts = [("-std", Arg.Set std, "Use the standard parser")] in - let usage = "printast [-std] " in + let std = ref false and input = ref None and metaocaml = ref false in + let opts = + [ ("-std", Arg.Set std, "Use the standard parser") + ; ("-metaocaml", Arg.Set metaocaml, "Enable metaocaml syntax") ] + in + let usage = "printast [-std] [-metaocaml] " in Arg.parse opts (fun inp -> input := Some inp) usage ; let input = match !input with @@ -27,13 +31,14 @@ let get_arg () = Printf.eprintf "Not enough argument\n" ; exit 2 and parse_and_print = if !std then std_ast else extended_ast in - (parse_and_print, input) + (parse_and_print, input, !metaocaml) let () = - let parse_and_print, inputf = get_arg () in + let parse_and_print, inputf, metaocaml = get_arg () in let syntax = Option.value ~default:Syntax.Use_file (Syntax.of_fname inputf) in Printf.printf "Reading %S\n" inputf ; let content = In_channel.read_all inputf in - parse_and_print Format.std_formatter syntax ~input_name:inputf content + parse_and_print Format.std_formatter syntax ~input_name:inputf ~metaocaml + content diff --git a/vendor/parser-extended/lexer.mll b/vendor/parser-extended/lexer.mll index 3f4e8722a7..74bf6ff79c 100644 --- a/vendor/parser-extended/lexer.mll +++ b/vendor/parser-extended/lexer.mll @@ -389,6 +389,8 @@ let update_loc lexbuf file line absolute chars = let preprocessor = ref None +let lex_metaocaml = ref false + let escaped_newlines = ref false type comment = [ `Comment of string | `Docstring of string ] @@ -501,8 +503,10 @@ let delim_ext = (lowercase | uppercase | utf8)* rejected by the delimiter validation function, we accept them temporarily to have the same error message for ascii and non-ascii uppercase letters *) -let symbolchar = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let symbolcharnodot = + ['!' '$' '%' '&' '*' '+' '-' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let symbolchar = symbolcharnodot | '.' + let dotsymbolchar = ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|'] let symbolchar_or_hash = @@ -552,7 +556,8 @@ rule token = parse | "~" { TILDE } | ".~" - { error lexbuf + { if !lex_metaocaml then METAOCAML_ESCAPE + else error lexbuf (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) } | "~" (identstart identchar * as name) ':' { check_label_name lexbuf name; @@ -741,12 +746,16 @@ rule token = parse | "+=" { PLUSEQ } | "-" { MINUS } | "-." { MINUSDOT } - + | ".<" { METAOCAML_BRACKET_OPEN } + | ">." { if !lex_metaocaml then METAOCAML_BRACKET_CLOSE + else INFIXOP0 (">." ^ symbolchars lexbuf) } | "!" symbolchar_or_hash + as op { PREFIXOP op } | ['~' '?'] symbolchar_or_hash + as op { PREFIXOP op } - | ['=' '<' '>' '|' '&' '$'] symbolchar * as op + | ['=' '<' '|' '&' '$'] symbolchar * as op + { INFIXOP0 op } + | ['>'] symbolcharnodot symbolchar * as op { INFIXOP0 op } | ['@' '^'] symbolchar * as op { INFIXOP1 op } @@ -768,6 +777,9 @@ rule token = parse | (_ as illegal_char) { error lexbuf (Illegal_character illegal_char) } +and symbolchars = parse + | symbolchar * as op { op } + and directive = parse | ([' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']* ("\"" ([^ '\010' '\013' '\"' ] * as _name) "\"") as directive) diff --git a/vendor/parser-extended/parse.ml b/vendor/parser-extended/parse.ml index 1db1dd9b5a..02af088755 100644 --- a/vendor/parser-extended/parse.ml +++ b/vendor/parser-extended/parse.ml @@ -42,12 +42,13 @@ let maybe_skip_phrase lexbuf = type 'a parser = Lexing.position -> 'a Parser.MenhirInterpreter.checkpoint -let wrap (parser : 'a parser) ~ocaml_version lexbuf : 'a = +let wrap (parser : 'a parser) ~ocaml_version ~metaocaml lexbuf : 'a = try Docstrings.init (); let keyword_edition = Some (ocaml_version, []) in + Lexer.lex_metaocaml := metaocaml; Lexer.init ?keyword_edition (); let open Parser.MenhirInterpreter in let rec fix_resume = function diff --git a/vendor/parser-standard/lexer.mll b/vendor/parser-standard/lexer.mll index 62ed045e0d..e73a7fb8ca 100644 --- a/vendor/parser-standard/lexer.mll +++ b/vendor/parser-standard/lexer.mll @@ -384,6 +384,8 @@ let update_loc lexbuf file line absolute chars = let preprocessor = ref None +let lex_metaocaml = ref false + let escaped_newlines = ref false let handle_docstrings = ref true @@ -495,8 +497,9 @@ let delim_ext = (lowercase | uppercase | utf8)* rejected by the delimiter validation function, we accept them temporarily to have the same error message for ascii and non-ascii uppercase letters *) -let symbolchar = - ['!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let symbolcharnodot = + ['!' '$' '%' '&' '*' '+' '-' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +let symbolchar = symbolcharnodot | '.' let dotsymbolchar = ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|'] let symbolchar_or_hash = @@ -546,7 +549,8 @@ rule token = parse | "~" { TILDE } | ".~" - { error lexbuf + { if !lex_metaocaml then METAOCAML_ESCAPE + else error lexbuf (Reserved_sequence (".~", Some "is reserved for use in MetaOCaml")) } | "~" (identstart identchar * as name) ':' { check_label_name lexbuf name; @@ -732,12 +736,16 @@ rule token = parse | "+=" { PLUSEQ } | "-" { MINUS } | "-." { MINUSDOT } - + | ".<" { METAOCAML_BRACKET_OPEN } + | ">." { if !lex_metaocaml then METAOCAML_BRACKET_CLOSE + else INFIXOP0 (">." ^ symbolchars lexbuf) } | "!" symbolchar_or_hash + as op { PREFIXOP op } | ['~' '?'] symbolchar_or_hash + as op { PREFIXOP op } - | ['=' '<' '>' '|' '&' '$'] symbolchar * as op + | ['=' '<' '|' '&' '$'] symbolchar * as op + { INFIXOP0 op } + | ['>'] symbolcharnodot symbolchar * as op { INFIXOP0 op } | ['@' '^'] symbolchar * as op { INFIXOP1 op } @@ -759,6 +767,9 @@ rule token = parse | (_ as illegal_char) { error lexbuf (Illegal_character illegal_char) } +and symbolchars = parse + | symbolchar * as op { op } + and directive = parse | ([' ' '\t']* (['0'-'9']+ as _num) [' ' '\t']* ("\"" ([^ '\010' '\013' '\"' ] * as _name) "\"") as directive) diff --git a/vendor/parser-standard/parse.ml b/vendor/parser-standard/parse.ml index 1db1dd9b5a..02af088755 100644 --- a/vendor/parser-standard/parse.ml +++ b/vendor/parser-standard/parse.ml @@ -42,12 +42,13 @@ let maybe_skip_phrase lexbuf = type 'a parser = Lexing.position -> 'a Parser.MenhirInterpreter.checkpoint -let wrap (parser : 'a parser) ~ocaml_version lexbuf : 'a = +let wrap (parser : 'a parser) ~ocaml_version ~metaocaml lexbuf : 'a = try Docstrings.init (); let keyword_edition = Some (ocaml_version, []) in + Lexer.lex_metaocaml := metaocaml; Lexer.init ?keyword_edition (); let open Parser.MenhirInterpreter in let rec fix_resume = function