Skip to content

Commit 65ff8de

Browse files
andreypoppandreypopp
committed
Test merlin parser as well
1 parent 58c8ab4 commit 65ff8de

File tree

11 files changed

+109
-18
lines changed

11 files changed

+109
-18
lines changed

‎mlx/jsx_helper.ml

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,14 @@ let mkjsxexp ~loc e =
2222
{ e with pexp_attributes = [ attr ] }
2323

2424
let make_jsx_element ~loc ~tag ~props ~children () =
25-
let tag = mkexp ~loc (Pexp_ident tag) in
25+
let tag =
26+
match tag with
27+
| `Value (loc, txt) ->
28+
mkexp ~loc (Pexp_ident { loc = make_loc loc; txt })
29+
| `Module (loc, txt) ->
30+
let txt = Longident.Ldot (txt, "createElement") in
31+
mkexp ~loc (Pexp_ident { loc = make_loc loc; txt })
32+
in
2633
let props =
2734
List.map
2835
(function

‎mlx/lexer.mll

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -415,12 +415,16 @@ rule token = parse
415415
{ warn_latin1 lexbuf; LIDENT name }
416416
| "<" (lowercase identchar * as name)
417417
{ JSX_LIDENT name }
418+
| "<" "/" (lowercase identchar * as name)
419+
{ JSX_LIDENT_E name }
418420
| uppercase identchar * as name
419421
{ UIDENT name } (* No capitalized keywords *)
420422
| uppercase_latin1 identchar_latin1 * as name
421423
{ warn_latin1 lexbuf; UIDENT name }
422424
| "<" (uppercase identchar * as name)
423425
{ JSX_UIDENT name }
426+
| "<" "/" (uppercase identchar * as name)
427+
{ JSX_UIDENT_E name }
424428
| int_literal as lit { INT (lit, None) }
425429
| (int_literal as lit) (literal_modifier as modif)
426430
{ INT (lit, Some modif) }

‎mlx/parser.mly

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -713,6 +713,7 @@ let mk_directive ~loc name arg =
713713
%token LET "let"
714714
%token <string> LIDENT "lident" (* just an example *)
715715
%token <string> JSX_LIDENT "<lident" (* just an example *)
716+
%token <string> JSX_LIDENT_E "</lident" (* just an example *)
716717
%token LPAREN "("
717718
%token LBRACKETAT "[@"
718719
%token LBRACKETATAT "[@@"
@@ -765,6 +766,7 @@ let mk_directive ~loc name arg =
765766
%token TYPE "type"
766767
%token <string> UIDENT "UIdent" (* just an example *)
767768
%token <string> JSX_UIDENT "<UIdent" (* just an example *)
769+
%token <string> JSX_UIDENT_E "</UIdent" (* just an example *)
768770
%token UNDERSCORE "_"
769771
%token VAL "val"
770772
%token VIRTUAL "virtual"
@@ -2502,10 +2504,10 @@ simple_expr:
25022504
{ unclosed "(" $loc($3) ")" $loc($8) }
25032505
;
25042506
jsx_element:
2505-
tag=mkrhs(jsx_longident) props=llist(jsx_prop) SLASHGREATER {
2507+
tag=jsx_longident(JSX_UIDENT, JSX_LIDENT) props=llist(jsx_prop) SLASHGREATER {
25062508
Jsx_helper.make_jsx_element () ~loc:$loc(tag) ~tag ~props ~children:None }
2507-
| tag=mkrhs(jsx_longident) props=llist(jsx_prop)
2508-
GREATER children=llist(simple_expr) LESSSLASH mkrhs(val_longident) GREATER {
2509+
| tag=jsx_longident(JSX_UIDENT, JSX_LIDENT) props=llist(jsx_prop)
2510+
GREATER children=llist(simple_expr) jsx_longident(JSX_UIDENT_E, JSX_LIDENT_E) GREATER {
25092511
let children =
25102512
let children, loc = mktailexp $loc(children) children in
25112513
mkexp ~loc children
@@ -3649,15 +3651,16 @@ mk_longident(prefix,final):
36493651
| final { Lident $1 }
36503652
| prefix DOT final { Ldot($1,$3) }
36513653
;
3652-
jsx_longident:
3653-
| id = JSX_LIDENT { Lident id }
3654-
| prefix = JSX_UIDENT DOT id = val_longident {
3654+
jsx_longident(uident, lident):
3655+
| id = uident { `Module ($sloc, Lident id) }
3656+
| id = lident { `Value ($sloc, Lident id) }
3657+
| prefix = uident DOT id = val_longident {
36553658
let rec rebase = function
36563659
| Lident id -> Ldot (Lident prefix, id)
36573660
| Ldot (prefix', id) -> Ldot (rebase prefix', id)
36583661
| Lapply _ -> assert false
36593662
in
3660-
rebase id }
3663+
`Value ($sloc, rebase id) }
36613664
;
36623665
val_longident:
36633666
mk_longident(mod_longident, val_ident) { $1 }

‎ocamlmerlin_mlx/dune

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,13 @@
22
(name ocamlmerlin_mlx)
33
(package mlx)
44
(public_name ocamlmerlin-mlx)
5+
(modules ocamlmerlin_mlx)
6+
(libraries ocamlmerlin_mlx_lib))
7+
8+
(library
9+
(name ocamlmerlin_mlx_lib)
10+
(package mlx)
11+
(modules :standard \ ocamlmerlin_mlx)
512
(flags
613
:standard
714
-w=-9-67-69

‎ocamlmerlin_mlx/lexer_raw.mll

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -445,6 +445,8 @@ rule token state = parse
445445
{ warn_latin1 lexbuf; return (LIDENT name) }
446446
| "<" (lowercase identchar * as name)
447447
{ return (JSX_LIDENT name) }
448+
| "<" "/" (lowercase identchar * as name)
449+
{ return (JSX_LIDENT_E name) }
448450
| uppercase identchar * as name
449451
{ (* Capitalized keywords for OUnit *)
450452
return (try Hashtbl.find state.keywords name
@@ -456,6 +458,8 @@ rule token state = parse
456458
{ warn_latin1 lexbuf; return (UIDENT name) }
457459
| "<" (uppercase identchar * as name)
458460
{ return (JSX_UIDENT name) }
461+
| "<" "/" (uppercase identchar * as name)
462+
{ return (JSX_UIDENT_E name) }
459463
| int_literal as lit { return (INT (lit, None)) }
460464
| (int_literal as lit) (literal_modifier as modif)
461465
{ return (INT (lit, Some modif)) }

‎ocamlmerlin_mlx/ocamlmerlin_mlx.ml

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,7 @@
1+
open Merlin_kernel
2+
open Merlin_extend
13
open Merlin_extend.Extend_protocol.Reader
4+
open Ocamlmerlin_mlx_lib
25

36
let parse_string filename str =
47
let src = Msource.make str in
@@ -18,7 +21,7 @@ module Mlx_reader = struct
1821

1922
let load buffer = buffer
2023

21-
let parse { text; path } =
24+
let parse { text; path; _ } =
2225
let res = parse_string path text in
2326
match res.parsetree with
2427
| `Interface intf -> Signature intf

‎ocamlmerlin_mlx/parser_raw.mly

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -801,6 +801,7 @@ let expr_of_lwt_bindings ~loc lbs body =
801801
%token LET [@symbol "let"]
802802
%token <string> LIDENT [@cost 2] [@recovery "_"][@printer Printf.sprintf "LIDENT(%S)"]
803803
%token <string> JSX_LIDENT [@cost 2] [@recovery "_"][@printing Printf.specific "JSX_LIDENT(%S)"]
804+
%token <string> JSX_LIDENT_E [@cost 2] [@recovery "_"][@printing Printf.specific "JSX_LIDENT_E(%S)"]
804805
%token LPAREN [@symbol ")"]
805806
%token LBRACKETAT [@symbol "[@"]
806807
%token LBRACKETATAT [@symbol "[@@"]
@@ -854,6 +855,7 @@ let expr_of_lwt_bindings ~loc lbs body =
854855
%token TYPE [@symbol "type"]
855856
%token <string> UIDENT [@cost 2][@recovery "_"][@printer Printf.sprintf "UIDENT(%S)"]
856857
%token <string> JSX_UIDENT [@cost 2][@recovery "_"][@printer Printf.sprintf "JSX_UIDENT(%S)"]
858+
%token <string> JSX_UIDENT_E [@cost 2][@recovery "_"][@printer Printf.sprintf "JSX_UIDENT_E(%S)"]
857859
%token UNDERSCORE [@symbol "_"]
858860
%token VAL [@symbol "val"]
859861
%token VIRTUAL [@symbol "virtual"]
@@ -2675,10 +2677,10 @@ let_pattern [@recovery default_pattern ()]:
26752677
*)
26762678
;
26772679
jsx_element:
2678-
tag=mkrhs(jsx_longident) props=llist(jsx_prop) SLASHGREATER {
2680+
tag=jsx_longident(JSX_UIDENT, JSX_LIDENT) props=llist(jsx_prop) SLASHGREATER {
26792681
Jsx_helper.make_jsx_element () ~loc:$loc(tag) ~tag ~props ~children:None }
2680-
| tag=mkrhs(jsx_longident) props=llist(jsx_prop)
2681-
GREATER children=llist(simple_expr) LESSSLASH mkrhs(val_longident) GREATER {
2682+
| tag=jsx_longident(JSX_UIDENT, JSX_LIDENT) props=llist(jsx_prop)
2683+
GREATER children=llist(simple_expr) jsx_longident(JSX_UIDENT_E, JSX_LIDENT_E) GREATER {
26822684
let children =
26832685
let children, loc = mktailexp $loc(children) children in
26842686
mkexp ~loc children
@@ -3834,15 +3836,16 @@ mk_longident(prefix,final):
38343836
val_longident:
38353837
mk_longident(mod_longident, val_ident) { $1 }
38363838
;
3837-
jsx_longident:
3838-
| id = JSX_LIDENT { Lident id }
3839-
| prefix = JSX_UIDENT DOT id = val_longident {
3839+
jsx_longident(uident, lident):
3840+
| id = uident { `Module ($sloc, Lident id) }
3841+
| id = lident { `Value ($sloc, Lident id) }
3842+
| prefix = uident DOT id = val_longident {
38403843
let rec rebase = function
38413844
| Lident id -> Ldot (Lident prefix, id)
38423845
| Ldot (prefix', id) -> Ldot (rebase prefix', id)
38433846
| Lapply _ -> assert false
38443847
in
3845-
rebase id }
3848+
`Value ($sloc, rebase id) }
38463849
;
38473850
label_longident:
38483851
mk_longident(mod_longident, LIDENT) { $1 }

‎test/dune

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,10 @@
11
(cram
2-
(deps (package mlx) ./mlx))
2+
(deps
3+
(package mlx)
4+
./mlx
5+
./mlx_merlin.exe))
6+
7+
(executable
8+
(name mlx_merlin)
9+
(libraries ocamlmerlin_mlx_lib))
310

‎test/mlx

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
11
#!/bin/bash
22

3-
mlx-pp -print-ml | ocamlformat - --impl --enable-outside-detected-project
3+
STDIN=$(cat)
4+
5+
echo "BATCH"
6+
echo "$STDIN" | mlx-pp -print-ml | ocamlformat - --impl --enable-outside-detected-project
7+
8+
echo "MERLIN"
9+
echo "$STDIN" | ./mlx_merlin.exe | ocamlformat - --impl --enable-outside-detected-project

‎test/mlx.t

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,30 @@
11

22
$ echo 'let _ = <div />' | ./mlx
3+
BATCH
4+
let _ = div () [@JSX]
5+
MERLIN
36
let _ = div () [@JSX]
47

58
$ echo 'let _ = <div>hello world</div>' | ./mlx
9+
BATCH
10+
let _ = div () ~children:[ hello; world ] [@JSX]
11+
MERLIN
612
let _ = div () ~children:[ hello; world ] [@JSX]
713

814
$ echo 'let _ = <div attr with_value=1 />' | ./mlx
15+
BATCH
16+
let _ = div () ~attr ~with_value:1 [@JSX]
17+
MERLIN
918
let _ = div () ~attr ~with_value:1 [@JSX]
19+
20+
$ echo 'let _ = <Hello attr with_value=1 />' | ./mlx
21+
BATCH
22+
let _ = Hello.createElement () ~attr ~with_value:1 [@JSX]
23+
MERLIN
24+
let _ = Hello.createElement () ~attr ~with_value:1 [@JSX]
25+
26+
$ echo 'let _ = <Hello>world</Hello>' | ./mlx
27+
BATCH
28+
let _ = Hello.createElement () ~children:[ world ] [@JSX]
29+
MERLIN
30+
let _ = Hello.createElement () ~children:[ world ] [@JSX]

‎test/mlx_merlin.ml

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
open Merlin_kernel
2+
open Ocamlmerlin_mlx_lib
3+
4+
let parse_string filename str =
5+
let src = Msource.make str in
6+
let cfg = Mconfig.initial in
7+
let cfg =
8+
{
9+
cfg with
10+
Merlin_kernel.Mconfig.query = { cfg.query with filename };
11+
(* override this so we don't try to run any extensions *)
12+
merlin = { cfg.merlin with extension_to_reader = [] };
13+
}
14+
in
15+
Mreader.parse cfg (src, None)
16+
17+
let () =
18+
let str = In_channel.input_all stdin in
19+
let res = parse_string "*stdin*" str in
20+
let () = List.iter (fun exn -> raise exn) res.lexer_errors in
21+
let () = List.iter (fun exn -> raise exn) res.parser_errors in
22+
match res.parsetree with
23+
| `Implementation str ->
24+
Format.printf "%a@." Ocaml_parsing.Pprintast.structure str
25+
| `Interface str ->
26+
Format.printf "%a@." Ocaml_parsing.Pprintast.signature str

0 commit comments

Comments
 (0)