Skip to content

Commit 375f001

Browse files
hhugohhugo
committed
support for metaocaml
1 parent d48e27f commit 375f001

17 files changed

Lines changed: 122 additions & 45 deletions

‎lib/Cmts.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -360,6 +360,10 @@ let relocate_ext_cmts (t : t) src (pre, pld) ~whole_loc =
360360
when List.is_empty pexp_attributes
361361
&& Source.extension_using_sugar ~name:pre ~payload:e1.pexp_loc ->
362362
()
363+
| PStr [{pstr_desc= Pstr_eval (_, _); pstr_loc= _}]
364+
when String.is_prefix ~prefix:"metaocaml." pre.txt
365+
&& Location.is_none pre.loc ->
366+
()
363367
| PStr [{pstr_desc= Pstr_eval _; pstr_loc; _}] ->
364368
let kwd_loc =
365369
match Source.loc_of_first_token_at src whole_loc LBRACKETPERCENT with

‎lib/Conf.ml‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -263,7 +263,8 @@ let default =
263263
; ocaml_version= elt Ocaml_version.Releases.v4_04_0
264264
; quiet= elt false
265265
; disable_conf_attrs= elt false
266-
; version_check= elt true } }
266+
; version_check= elt true
267+
; metaocaml= elt false } }
267268

268269
module V = struct
269270
let v0_12 = Version.make ~major:0 ~minor:12 ~patch:None
@@ -1454,6 +1455,12 @@ module Operational = struct
14541455
(fun conf elt -> update conf ~f:(fun f -> {f with version_check= elt}))
14551456
(fun conf -> conf.opr_opts.version_check)
14561457

1458+
let metaocaml =
1459+
let doc = "Enable metaocaml" in
1460+
Decl.flag ~default ~names:["metaocaml"] ~doc ~kind
1461+
(fun conf elt -> update conf ~f:(fun f -> {f with metaocaml= elt}))
1462+
(fun conf -> conf.opr_opts.metaocaml)
1463+
14571464
let options : Store.t =
14581465
Store.
14591466
[ elt comment_check
@@ -1464,7 +1471,8 @@ module Operational = struct
14641471
; elt ocaml_version
14651472
; elt quiet
14661473
; elt disable_conf_attrs
1467-
; elt version_check ]
1474+
; elt version_check
1475+
; elt metaocaml ]
14681476
end
14691477

14701478
let options = Operational.options @ Formatting.options @ options

‎lib/Conf_t.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,8 @@ type opr_opts =
130130
; ocaml_version: Ocaml_version.t elt
131131
; quiet: bool elt
132132
; disable_conf_attrs: bool elt
133-
; version_check: bool elt }
133+
; version_check: bool elt
134+
; metaocaml: bool elt }
134135

135136
type t =
136137
{ fmt_opts: fmt_opts

‎lib/Conf_t.mli‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,8 @@ type opr_opts =
133133
(** Version of OCaml syntax of the output. *)
134134
; quiet: bool elt
135135
; disable_conf_attrs: bool elt
136-
; version_check: bool elt }
136+
; version_check: bool elt
137+
; metaocaml: bool elt }
137138

138139
type t =
139140
{ fmt_opts: fmt_opts

‎lib/Extended_ast.ml‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -237,8 +237,8 @@ module Parse = struct
237237
in
238238
Ast_mapper.{default_mapper with expr; pat; binding_op}
239239

240-
let ast (type a) (fg : a t) ~ocaml_version ~preserve_beginend ~input_name
241-
str : a =
240+
let ast (type a) (fg : a t) ~ocaml_version ~metaocaml ~preserve_beginend
241+
~input_name str : a =
242242
map fg (normalize_mapper ~ocaml_version ~preserve_beginend)
243243
@@
244244
let lexbuf = Lexing.from_string str in
@@ -247,13 +247,13 @@ module Parse = struct
247247
in
248248
Location.init_info lexbuf input_name ;
249249
match fg with
250-
| Structure -> Parse.implementation ~ocaml_version lexbuf
251-
| Signature -> Parse.interface ~ocaml_version lexbuf
252-
| Use_file -> Parse.use_file ~ocaml_version lexbuf
253-
| Core_type -> Parse.core_type ~ocaml_version lexbuf
254-
| Module_type -> Parse.module_type ~ocaml_version lexbuf
255-
| Expression -> Parse.expression ~ocaml_version lexbuf
256-
| Repl_file -> Toplevel_lexer.repl_file ~ocaml_version lexbuf
250+
| Structure -> Parse.implementation ~ocaml_version ~metaocaml lexbuf
251+
| Signature -> Parse.interface ~ocaml_version ~metaocaml lexbuf
252+
| Use_file -> Parse.use_file ~ocaml_version ~metaocaml lexbuf
253+
| Core_type -> Parse.core_type ~ocaml_version ~metaocaml lexbuf
254+
| Module_type -> Parse.module_type ~ocaml_version ~metaocaml lexbuf
255+
| Expression -> Parse.expression ~ocaml_version ~metaocaml lexbuf
256+
| Repl_file -> Toplevel_lexer.repl_file ~ocaml_version ~metaocaml lexbuf
257257
| Documentation ->
258258
let pos = (Location.curr lexbuf).loc_start in
259259
let pos = {pos with pos_fname= input_name} in

‎lib/Extended_ast.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ module Parse : sig
3535
val ast :
3636
'a t
3737
-> ocaml_version:Ocaml_version.t
38+
-> metaocaml:bool
3839
-> preserve_beginend:bool
3940
-> input_name:string
4041
-> string

‎lib/Fmt_ast.ml‎

Lines changed: 37 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -613,7 +613,7 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) =
613613
| _, PPat (({ppat_loc; _} as pat), _), (Pld _ | Top)
614614
when Source.extension_using_sugar ~name:ext ~payload:ppat_loc ->
615615
fmt_pattern c ~ext (sub_pat ~ctx pat)
616-
| _ ->
616+
| _ -> (
617617
let box =
618618
if c.conf.fmt_opts.ocp_indent_compat.v then
619619
match pld with
@@ -623,12 +623,40 @@ let rec fmt_extension_aux c ctx ~key (ext, pld) =
623623
hvbox c.conf.fmt_opts.stritem_extension_indent.v
624624
else Fn.id
625625
in
626-
box
627-
(wrap (str "[") (str "]")
628-
( str (Ext.Key.to_string key)
629-
$ fmt_str_loc c ext
630-
$ fmt_payload c (Pld pld) pld
631-
$ fmt_if (Exposed.Right.payload pld) (str " ") ) )
626+
let is_metaocaml_sugar =
627+
if
628+
String.is_prefix ~prefix:"metaocaml." ext.txt
629+
&& Location.is_none ext.loc
630+
then
631+
match pld with
632+
| PStr [({pstr_desc= Pstr_eval (e, []); _} as pstr)] ->
633+
let node =
634+
match ext.txt with
635+
| "metaocaml.escape" -> `Escape
636+
| "metaocaml.bracket" -> `Bracket
637+
| _ -> assert false
638+
in
639+
Some (node, e, Str pstr)
640+
| _ -> assert false
641+
else None
642+
in
643+
match is_metaocaml_sugar with
644+
| Some (`Escape, e, ctx) ->
645+
let parens =
646+
match e.pexp_desc with Pexp_ident _ -> false | _ -> true
647+
in
648+
box (str ".~" $ fmt_expression c ~parens (sub_exp ~ctx e))
649+
| Some (`Bracket, e, ctx) ->
650+
box
651+
(wrap (str ".< ") (str " >.")
652+
(fmt_expression c (sub_exp ~ctx e)) )
653+
| None ->
654+
box
655+
(wrap (str "[") (str "]")
656+
( str (Ext.Key.to_string key)
657+
$ fmt_str_loc c ext
658+
$ fmt_payload c (Pld pld) pld
659+
$ fmt_if (Exposed.Right.payload pld) (str " ") ) ) )
632660

633661
and fmt_extension = fmt_extension_aux ~key:Ext.Key.Regular
634662

@@ -2974,7 +3002,8 @@ and fmt_class_signature c ~ctx ~pro ~epi ?ext self_ fields =
29743002
in
29753003
let ast x = Ctf x in
29763004
let cmts_within =
2977-
if List.is_empty fields then (* Side effect order is important. *)
3005+
if List.is_empty fields then
3006+
(* Side effect order is important. *)
29783007
Cmts.fmt_within ~pro:noop c (Ast.location ctx)
29793008
else noop
29803009
in

‎lib/Parse_with_comments.ml‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -85,7 +85,10 @@ let parse ?(disable_w50 = false) ?(disable_deprecated = false) parse fragment
8585
else not conf.opr_opts.quiet.v )
8686
~f:(fun () ->
8787
let ocaml_version = conf.opr_opts.ocaml_version.v in
88-
let ast = parse fragment ~ocaml_version ~input_name source in
88+
let metaocaml = conf.opr_opts.metaocaml.v in
89+
let ast =
90+
parse fragment ~ocaml_version ~metaocaml ~input_name source
91+
in
8992
Warnings.check_fatal () ;
9093
let comments =
9194
let mk_cmt = function
@@ -103,9 +106,10 @@ let parse ?(disable_w50 = false) ?(disable_deprecated = false) parse fragment
103106
in
104107
match List.rev !w50 with [] -> t | w50 -> raise (Warning50 w50)
105108

106-
let parse_ast (conf : Conf.t) fg ~ocaml_version ~input_name s =
109+
let parse_ast (conf : Conf.t) fg ~ocaml_version ~metaocaml ~input_name s =
107110
let preserve_beginend = Poly.(conf.fmt_opts.exp_grouping.v = `Preserve) in
108-
Extended_ast.Parse.ast fg ~ocaml_version ~preserve_beginend ~input_name s
111+
Extended_ast.Parse.ast fg ~ocaml_version ~metaocaml ~preserve_beginend
112+
~input_name s
109113

110114
(** [is_repl_block x] returns whether [x] is a list of REPL phrases and
111115
outputs of the form:

‎lib/Parse_with_comments.mli‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ val parse :
3131
-> ?disable_deprecated:bool
3232
-> ( 'b
3333
-> ocaml_version:Ocaml_version.t
34+
-> metaocaml:bool
3435
-> input_name:string
3536
-> string
3637
-> 'a )
@@ -57,6 +58,7 @@ val parse_ast :
5758
Conf.t
5859
-> 'a Extended_ast.t
5960
-> ocaml_version:Ocaml_version.t
61+
-> metaocaml:bool
6062
-> input_name:string
6163
-> string
6264
-> 'a

‎lib/Std_ast.ml‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -56,19 +56,19 @@ let map (type a) (x : a t) (m : Ast_mapper.mapper) : a -> a =
5656
| Documentation -> Fn.id
5757

5858
module Parse = struct
59-
let ast (type a) (fg : a t) ~ocaml_version ~input_name str : a =
59+
let ast (type a) (fg : a t) ~ocaml_version ~metaocaml ~input_name str : a =
6060
let lexbuf = Lexing.from_string str in
6161
let ocaml_version =
6262
Some Ocaml_version.(major ocaml_version, minor ocaml_version)
6363
in
6464
Location.init_info lexbuf input_name ;
6565
match fg with
66-
| Structure -> Parse.implementation ~ocaml_version lexbuf
67-
| Signature -> Parse.interface ~ocaml_version lexbuf
68-
| Use_file -> Parse.use_file ~ocaml_version lexbuf
69-
| Core_type -> Parse.core_type ~ocaml_version lexbuf
70-
| Module_type -> Parse.module_type ~ocaml_version lexbuf
71-
| Expression -> Parse.expression ~ocaml_version lexbuf
66+
| Structure -> Parse.implementation ~ocaml_version ~metaocaml lexbuf
67+
| Signature -> Parse.interface ~ocaml_version ~metaocaml lexbuf
68+
| Use_file -> Parse.use_file ~ocaml_version ~metaocaml lexbuf
69+
| Core_type -> Parse.core_type ~ocaml_version ~metaocaml lexbuf
70+
| Module_type -> Parse.module_type ~ocaml_version ~metaocaml lexbuf
71+
| Expression -> Parse.expression ~ocaml_version ~metaocaml lexbuf
7272
| Repl_file -> ()
7373
| Documentation -> ()
7474
end

0 commit comments

Comments
 (0)