Add MetaOCaml support

hhugo · hhugo · commit d974c176f52e · 2026-04-03T15:02:50.000+02:00
Add a --metaocaml flag to enable MetaOCaml syntax (brackets .&lt; &gt;.,
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 &gt;. (bracket close) behind the metaocaml flag;
  .&lt; (bracket open) is always lexed as METAOCAML_BRACKET_OPEN
- Add symbolchars sub-lexer for consuming remaining operator chars
  after &gt;. 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
  (.&lt; expr &gt;. 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
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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,15 +107,15 @@ 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
     | `Always -> Some true
     | `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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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] <file>" 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] <file>" 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
diff --git a/vendor/parser-extended/parse.ml b/vendor/parser-extended/parse.ml
diff --git a/vendor/parser-standard/lexer.mll b/vendor/parser-standard/lexer.mll
diff --git a/vendor/parser-standard/parse.ml b/vendor/parser-standard/parse.ml
