mlx lexer hack around [< and >] tokens

Author: andreypopp

mlx/lexer.mll

@@ -558,7 +558,6 @@ rule token = parse
   | "|]" { BARRBRACKET }
   | ">"  { GREATER }
   | "/>" { SLASHGREATER }
-  | ">]" { GREATERRBRACKET }
   | "}"  { RBRACE }
   | ">}" { GREATERRBRACE }
   | "[@" { LBRACKETAT }
@@ -805,6 +804,28 @@ and skip_hash_bang = parse
 
   and docstring = Docstrings.docstring
 
+  let token_with_comments lexbuf =
+    match token_with_comments lexbuf with
+    | LBRACKETLESS ->
+      (* Check if the next character (if any) could start an identifier.
+         UIDENT starts with A-Z, LIDENT starts with a-z or _ *)
+      let should_split =
+        lexbuf.Lexing.lex_curr_pos < lexbuf.Lexing.lex_buffer_len &&
+        begin
+          let next = Bytes.get lexbuf.Lexing.lex_buffer lexbuf.Lexing.lex_curr_pos in
+          next >= 'A' && next <= 'Z' || next >= 'a' && next <= 'z' || next = '_'
+        end
+      in
+      if should_split then begin
+        (* Backtrack one character to before the "<" so it will be lexed separately *)
+        lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+        let lex_curr_p = lexbuf.lex_curr_p in
+        lexbuf.lex_curr_p <- { lex_curr_p with pos_cnum = lex_curr_p.pos_cnum - 1 };
+        LBRACKET
+      end else
+        LBRACKETLESS
+    | tok -> tok
+
   let token lexbuf =
     let post_pos = lexeme_end_p lexbuf in
     let attach lines docs pre_pos =

ocamlmerlin_mlx/ocaml/preprocess/lexer_raw.mll

@@ -590,7 +590,6 @@ rule token state = parse
   | "|]" { return BARRBRACKET }
   | ">"  { return GREATER }
   | "/>" { return SLASHGREATER }
-  | ">]" { return GREATERRBRACKET }
   | "}"  { return RBRACE }
   | ">}" { return GREATERRBRACE }
   | "[@" { return LBRACKETAT }
@@ -825,6 +824,28 @@ and skip_sharp_bang state = parse
   (* preprocessor support not implemented, not compatible with monadic
      interface *)
 
+  let token state lexbuf =
+    match token state lexbuf with
+    | Return LBRACKETLESS ->
+      (* Check if the next character (if any) could start an identifier.
+         UIDENT starts with A-Z, LIDENT starts with a-z or _ *)
+      let should_split =
+        lexbuf.Lexing.lex_curr_pos < lexbuf.Lexing.lex_buffer_len &&
+        begin
+          let next = Bytes.get lexbuf.Lexing.lex_buffer lexbuf.Lexing.lex_curr_pos in
+          next >= 'A' && next <= 'Z' || next >= 'a' && next <= 'z' || next = '_'
+        end
+      in
+      if should_split then begin
+        (* Backtrack one character to before the "<" so it will be lexed separately *)
+        lexbuf.Lexing.lex_curr_pos <- lexbuf.Lexing.lex_curr_pos - 1;
+        let lex_curr_p = lexbuf.lex_curr_p in
+        lexbuf.lex_curr_p <- { lex_curr_p with pos_cnum = lex_curr_p.pos_cnum - 1 };
+        Return LBRACKET
+      end else
+        Return LBRACKETLESS
+    | tok -> tok
+
   let rec token_without_comments state lexbuf =
     token state lexbuf >>= function
     | COMMENT _ ->

test/example/main.mlx

@@ -17,6 +17,7 @@ let div ~children () = Element ("div", children)
 let text s = Text s
 
 let () = 
+  let _ = [<div>(text "title")</div>; <div>(text "content")</div>] in
   print_endline (render (
     <div>
       <div>(text "title")</div>

test/mlx.t

@@ -116,13 +116,27 @@ Some tests for prop expressions:
   MERLIN
   let _ = element () ~children:[] ~prop:!?ref [@JSX]
 
-TODO: fix the following parse error, where [< is treated as LBRACKETLESS:
+We have a lexer hack to parse [<element and [<Element as JSX:
   $ echo 'let _ = [<element />]' | ./mlx
   BATCH
-  File "*stdin*", line 1, characters 8-10:
-  Error: Syntax error
-  
+  let _ = [ (element () ~children:[] [@JSX]) ]
   MERLIN
-  File "*stdin*", line 1, characters 18-20
-  Error: Syntax error
-  
+  let _ = [ (element () ~children:[] [@JSX]) ]
+
+  $ echo 'let _ = [<M.element />]' | ./mlx
+  BATCH
+  let _ = [ (M.element () ~children:[] [@JSX]) ]
+  MERLIN
+  let _ = [ (M.element () ~children:[] [@JSX]) ]
+
+  $ echo 'let _ = [<element> 1 </element>]' | ./mlx
+  BATCH
+  let _ = [ (element () ~children:[ 1 ] [@JSX]) ]
+  MERLIN
+  let _ = [ (element () ~children:[ 1 ] [@JSX]) ]
+
+  $ echo 'let _ = [<M.element> 1 </M.element>]' | ./mlx
+  BATCH
+  let _ = [ (M.element () ~children:[ 1 ] [@JSX]) ]
+  MERLIN
+  let _ = [ (M.element () ~children:[ 1 ] [@JSX]) ]