Integrate LRgrep error messages

.github/workflows/fuzzy-ci.yml

@@ -95,7 +95,7 @@ jobs:
       - name: Install merlin dependencies
         run: |
           opam update
-          opam pin menhirLib 20230608 --no-action
+          opam pin menhirLib 20260209 --no-action
           opam install . --deps-only --yes
 
       - name: Install merlin

.github/workflows/main.yml

@@ -60,8 +60,8 @@ jobs:
 
       - name: Install dependencies
         run: |
-          opam pin menhirLib 20230608 --no-action
-          opam install menhir csexp alcotest yojson conf-jq ocamlfind --yes
+          opam pin menhirLib 20260209 --no-action
+          opam install menhir csexp alcotest yojson conf-jq ocamlfind lrgrep --yes
           opam install ppxlib ppx_string reason --yes
 
       - name: Build and test in release mode

CHANGES.md

@@ -1,3 +1,10 @@
+UNRELEASED
+==========
+Sat May 23 11:00:27 AM JST 2026
+
+  + merlin library
+    - Use LRgrep to specify & generate syntax error messages (#2072)
+
 merlin 5.7.1
 ============
 Thu Apr 30 14:15:42 CEST 2026

Makefile

@@ -27,3 +27,10 @@ bench:
 
 .PHONY: all build dev clean test promote bench bench
 .NOTPARALLEL:
+
+lrgrep-coverage:
+	lrgrep compile \
+		-g ./_build/default/src/ocaml/preprocess/parser_raw.cmly \
+		-s src/ocaml/preprocess/parse_errors.lrgrep \
+		-o /dev/null \
+		--cover-all --cover-report coverage.md

merlin-lib.opam

@@ -15,9 +15,10 @@ depends: [
   "dune" {>= "3.0.0"}
   "csexp" {>= "1.5.1"}
   "alcotest" {with-test & >= "1.3.0" }
-  "menhir"    {dev & >= "20230608"}
-  "menhirLib" {dev & >= "20230608"}
-  "menhirSdk" {dev & >= "20230608"}
+  "menhir"    {dev & >= "20260209"}
+  "menhirLib" {dev & >= "20260209"}
+  "menhirSdk" {dev & >= "20260209"}
+  "lrgrep"    {dev & >= "0.9"}
 ]
 synopsis:
   "Merlin's libraries"

src/kernel/mreader.ml

@@ -47,7 +47,7 @@ let normal_parse ?for_completion config source =
       Mreader_lexer.for_completion lexer pos
   in
   let parser = Mreader_parser.make Mconfig.(config.ocaml.warnings) lexer kind in
-  let lexer_keywords = Mreader_lexer.keywords lexer
+  let lexer_keywords = Mreader_lexer.list_keywords lexer
   and lexer_errors = Mreader_lexer.errors lexer
   and parser_errors = Mreader_parser.errors parser
   and parsetree = Mreader_parser.result parser

src/kernel/mreader_lexer.ml

@@ -109,7 +109,9 @@ let tokens t =
     | Triple t -> Some t
     | _ -> None)
 
-let keywords t = Lexer_raw.list_keywords t.keywords
+let keywords t = t.keywords
+
+let list_keywords t = Lexer_raw.list_keywords t.keywords
 
 let errors t =
   rev_filter_map t.items ~f:(function

src/kernel/mreader_lexer.mli

@@ -40,7 +40,8 @@ val for_completion :
 val initial_position : t -> Lexing.position
 
 val tokens : t -> triple list
-val keywords : t -> string list
+val list_keywords : t -> string list
+val keywords : t -> keywords
 val errors : t -> exn list
 val comments : t -> (string * Location.t) list
 

src/kernel/mreader_parser.ml

@@ -78,7 +78,7 @@ let eof_token = (Parser_raw.EOF, Lexing.dummy_pos, Lexing.dummy_pos)
 
 let errors_ref = ref []
 
-let resume_parse =
+let resume_parse keywords =
   let rec normal acc tokens = function
     | I.InputNeeded env as checkpoint ->
       let token, tokens =
@@ -115,10 +115,18 @@ let resume_parse =
       normal ((Correct checkpoint, token) :: acc) tokens checkpoint
   and enter_error acc token tokens env =
     let candidates = R.generate env in
-    let explanation =
-      Mreader_explain.explain env token candidates.R.popped candidates.R.shifted
+    let error =
+      match Parse_errors.error_messages keywords env token with
+      | Some message ->
+        let _, loc_start, loc_end = token in
+        let loc = { Location.loc_start; loc_end; loc_ghost = false } in
+        Syntaxerr.Error (Syntaxerr.Custom (loc, message))
+      | None ->
+        Mreader_explain.Syntax_explanation
+          (Mreader_explain.explain env token candidates.R.popped
+             candidates.R.shifted)
     in
-    errors_ref := Mreader_explain.Syntax_explanation explanation :: !errors_ref;
+    errors_ref := error :: !errors_ref;
     recover acc (token :: tokens) candidates
   and recover acc tokens candidates =
     let token, tokens =
@@ -150,14 +158,14 @@ let seek_step steps tokens =
   in
   aux [] (steps, tokens)
 
-let parse initial steps tokens initial_pos =
+let parse initial steps keywords tokens initial_pos =
   let acc, tokens = seek_step steps tokens in
   let step =
     match acc with
     | (step, _) :: _ -> step
     | [] -> Correct (initial initial_pos)
   in
-  let acc, result = resume_parse acc tokens step in
+  let acc, result = resume_parse keywords acc tokens step in
   (List.rev acc, result)
 
 let run_parser warnings lexer previous kind =
@@ -173,7 +181,7 @@ let run_parser warnings lexer previous kind =
     in
     let steps, result =
       let state = Parser_raw.Incremental.implementation in
-      parse state steps tokens initial_pos
+      parse state steps (Mreader_lexer.keywords lexer) tokens initial_pos
     in
     (`Structure steps, `Implementation result)
   | MLI ->
@@ -184,7 +192,7 @@ let run_parser warnings lexer previous kind =
     in
     let steps, result =
       let state = Parser_raw.Incremental.interface in
-      parse state steps tokens initial_pos
+      parse state steps (Mreader_lexer.keywords lexer) tokens initial_pos
     in
     (`Signature steps, `Interface result)
 

src/ocaml/parsing/pprintast.ml

@@ -1959,7 +1959,9 @@ let prepare_error err =
         (Style.as_inline_code Doc.tyvar) var
         Style.inline_code var
   | Other loc ->
-      Location.errorf ~source ~loc "Syntax error"
+      Location.error ~source ~loc "Syntax error"
+  | Custom (loc, msg) ->
+      Location.error ~source ~loc msg
   | Ill_formed_ast (loc, s) ->
       Location.errorf ~loc
         "broken invariant in parsetree: %s" s

src/ocaml/parsing/syntaxerr.ml

@@ -29,6 +29,7 @@ type error =
   | Applicative_path of Location.t
   | Variable_in_scope of Location.t * string
   | Other of Location.t
+  | Custom of Location.t * string
   | Ill_formed_ast of Location.t * string
   | Invalid_package_type of Location.t * invalid_package_type
   | Removed_string_set of Location.t
@@ -41,6 +42,7 @@ let location_of_error = function
   | Applicative_path l
   | Variable_in_scope(l,_)
   | Other l
+  | Custom (l, _)
   | Not_expecting (l, _)
   | Ill_formed_ast (l, _)
   | Invalid_package_type (l, _)

src/ocaml/parsing/syntaxerr.mli

@@ -34,6 +34,7 @@ type error =
   | Applicative_path of Location.t
   | Variable_in_scope of Location.t * string
   | Other of Location.t
+  | Custom of Location.t * string
   | Ill_formed_ast of Location.t * string
   | Invalid_package_type of Location.t * invalid_package_type
   | Removed_string_set of Location.t

src/ocaml/preprocess/dune

@@ -43,3 +43,20 @@
  (targets menhirLib.ml menhirLib.mli)
  (mode promote)
  (action (run menhir --dump-menhirLib .)))
+
+(rule
+ (targets parse_errors.ml)
+ (enabled_if (<> %{profile} "release"))
+ (deps parser_raw.cmly parse_errors.lrgrep)
+ (mode    promote)
+ (action (run lrgrep compile -g parser_raw.cmly -s parse_errors.lrgrep)))
+
+(rule
+ (targets lrgrep_runtime.ml)
+ (mode promote)
+ (action (copy %{lib:lrgrep.runtime:lrgrep_runtime.ml} lrgrep_runtime.ml)))
+
+(rule
+ (targets lrgrep_runtime.mli)
+ (mode promote)
+ (action (copy %{lib:lrgrep.runtime:lrgrep_runtime.mli} lrgrep_runtime.mli)))

src/ocaml/preprocess/lexer_raw.mli

@@ -62,6 +62,7 @@ val make: ?preprocessor:preprocessor -> keywords -> state
 
 val skip_sharp_bang: state -> Lexing.lexbuf -> Parser_raw.token result
 val token: state -> Lexing.lexbuf -> Parser_raw.token result
+val as_keyword : keywords -> Parser_raw.token -> string option
 
 (* Comments are filtered out from the token rule and stored in a global
    variable. *)

src/ocaml/preprocess/lexer_raw.mll

@@ -188,6 +188,13 @@ let list_keywords =
   fun keywords ->
     Hashtbl.fold add_kw keywords init
 
+let as_keyword keywords token =
+  Hashtbl.to_seq keywords
+  |> Seq.find_map (function
+       | (text, token') when token = token' -> Some text
+       | _ -> None
+     )
+
 let store_string_char buf c = Buffer.add_char buf c
 let store_string_utf_8_uchar buf u = Buffer.add_utf_8_uchar buf u
 let store_string buf s = Buffer.add_string buf s