fix conflicts after rebase

boot/menhir/menhirLib.ml

@@ -43,7 +43,7 @@ let rec uniq1 cmp x ys =
       []
   | y :: ys ->
       if cmp x y = 0 then
-        uniq1 compare x ys
+        uniq1 cmp x ys
       else
         y :: uniq1 cmp y ys
 
@@ -85,7 +85,6 @@ let rec foldr f xs accu =
       accu
   | Cons (x, xs) ->
       f x (foldr f xs accu)
-
 end
 module Convert = struct
 (******************************************************************************)
@@ -1965,9 +1964,6 @@ let update buffer x =
     | Two (_, x1), x2 ->
         Two (x1, x2)
 
-(* [show f buffer] prints the contents of the buffer. The function [f] is
-   used to print an element. *)
-
 let show f buffer : string =
   match !buffer with
   | Zero ->
@@ -1981,9 +1977,6 @@ let show f buffer : string =
       (* In the most likely case, we have read two tokens. *)
       Printf.sprintf "after '%s' and before '%s'" (f valid) (f invalid)
 
-(* [last buffer] returns the last element of the buffer (that is, the invalid
-   token). *)
-
 let last buffer =
   match !buffer with
   | Zero ->
@@ -1994,8 +1987,6 @@ let last buffer =
   | Two (_, invalid) ->
       invalid
 
-(* [wrap buffer lexer] *)
-
 open Lexing
 
 let wrap lexer =
@@ -2006,7 +1997,156 @@ let wrap lexer =
     update buffer (lexbuf.lex_start_p, lexbuf.lex_curr_p);
     token
 
+let wrap_supplier supplier =
+  let buffer = ref Zero in
+  buffer,
+  fun () ->
+    let (_token, pos1, pos2) as triple = supplier() in
+    update buffer (pos1, pos2);
+    triple
+
 (* -------------------------------------------------------------------------- *)
+
+let extract text (pos1, pos2) : string =
+  let ofs1 = pos1.pos_cnum
+  and ofs2 = pos2.pos_cnum in
+  let len = ofs2 - ofs1 in
+  try
+    String.sub text ofs1 len
+  with Invalid_argument _ ->
+    (* In principle, this should not happen, but if it does, let's make this
+       a non-fatal error. *)
+    "???"
+
+let sanitize text =
+  String.map (fun c ->
+    if Char.code c < 32 then ' ' else c
+  ) text
+
+(* If we were willing to depend on [Str], we could implement [compress] as
+   follows:
+
+   let compress text =
+     Str.global_replace (Str.regexp "[ \t\n\r]+") " " text
+
+ *)
+
+let rec compress n b i j skipping =
+  if j < n then
+    let c, j = Bytes.get b j, j + 1 in
+    match c with
+    | ' ' | '\t' | '\n' | '\r' ->
+        let i = if not skipping then (Bytes.set b i ' '; i + 1) else i in
+        let skipping = true in
+        compress n b i j skipping
+    | _ ->
+        let i = Bytes.set b i c; i + 1 in
+        let skipping = false in
+        compress n b i j skipping
+  else
+    Bytes.sub_string b 0 i
+
+let compress text =
+  let b = Bytes.of_string text in
+  let n = Bytes.length b in
+  compress n b 0 0 false
+
+let shorten k text =
+  let n = String.length text in
+  if n <= 2 * k + 3 then
+    text
+  else
+    String.sub text 0 k ^
+    "..." ^
+    String.sub text (n - k) k
+
+let is_digit c =
+  let c = Char.code c in
+  Char.code '0' <= c && c <= Char.code '9'
+
+exception Copy
+
+let expand f text =
+  let n = String.length text in
+  let b = Buffer.create n in
+  let rec loop i =
+    if i < n then begin
+      let c, i = text.[i], i + 1 in
+      loop (
+        try
+          if c <> '$' then raise Copy;
+          let j = ref i in
+          while !j < n && is_digit text.[!j] do incr j done;
+          if i = !j then raise Copy;
+          let k = int_of_string (String.sub text i (!j - i)) in
+          Buffer.add_string b (f k);
+          !j
+        with Copy ->
+          (* We reach this point if either [c] is not '$' or [c] is '$'
+             but is not followed by an integer literal. *)
+          Buffer.add_char b c;
+          i
+      )
+    end
+    else
+      Buffer.contents b
+  in
+  loop 0
+end
+module LexerUtil = struct
+(******************************************************************************)
+(*                                                                            *)
+(*                                   Menhir                                   *)
+(*                                                                            *)
+(*                       François Pottier, Inria Paris                        *)
+(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                                                            *)
+(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
+(*  terms of the GNU Library General Public License version 2, with a         *)
+(*  special exception on linking, as described in the file LICENSE.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+open Lexing
+open Printf
+
+let init filename lexbuf =
+  lexbuf.lex_curr_p <- {
+    pos_fname = filename;
+    pos_lnum  = 1;
+    pos_bol   = 0;
+    pos_cnum  = 0
+  };
+  lexbuf
+
+let read filename =
+  let c = open_in filename in
+  let text = really_input_string c (in_channel_length c) in
+  close_in c;
+  let lexbuf = Lexing.from_string text in
+  text, init filename lexbuf
+
+let newline lexbuf =
+  let pos = lexbuf.lex_curr_p in
+  lexbuf.lex_curr_p <- { pos with
+    pos_lnum = pos.pos_lnum + 1;
+    pos_bol = pos.pos_cnum;
+  }
+
+let is_dummy (pos1, pos2) =
+  pos1 == dummy_pos || pos2 == dummy_pos
+
+let range ((pos1, pos2) as range) =
+  if is_dummy range then
+    sprintf "At an unknown location:\n"
+  else
+    let file = pos1.pos_fname in
+    let line = pos1.pos_lnum in
+    let char1 = pos1.pos_cnum - pos1.pos_bol in
+    let char2 = pos2.pos_cnum - pos1.pos_bol in (* yes, [pos1.pos_bol] *)
+    sprintf "File \"%s\", line %d, characters %d-%d:\n"
+      file line char1 char2
+      (* use [char1 + 1] and [char2 + 1] if *not* using Caml mode *)
 end
 module Printers = struct
 (******************************************************************************)
@@ -3519,5 +3659,5 @@ module MakeEngineTable (T : TableFormat.TABLES) = struct
 end
 end
 module StaticVersion = struct
-let require_20200211 = ()
+let require_20201201 = ()
 end

boot/menhir/menhirLib.mli

@@ -1066,12 +1066,20 @@ type 'a buffer
    which internally relies on [lexer] and updates [buffer] on the fly whenever
    a token is demanded. *)
 
+(* The type of the buffer is [(position * position) buffer], which means that
+   it stores two pairs of positions, which are the start and end positions of
+   the last two tokens. *)
+
 open Lexing
 
 val wrap:
   (lexbuf -> 'token) ->
   (position * position) buffer * (lexbuf -> 'token)
 
+val wrap_supplier:
+  (unit -> 'token * position * position) ->
+  (position * position) buffer * (unit -> 'token * position * position)
+
 (* [show f buffer] prints the contents of the buffer, producing a string that
    is typically of the form "after '%s' and before '%s'". The function [f] is
    used to print an element. The buffer MUST be nonempty. *)
@@ -1084,6 +1092,76 @@ val show: ('a -> string) -> 'a buffer -> string
 val last: 'a buffer -> 'a
 
 (* -------------------------------------------------------------------------- *)
+
+(* [extract text (pos1, pos2)] extracts the sub-string of [text] delimited
+   by the positions [pos1] and [pos2]. *)
+
+val extract: string -> position * position -> string
+
+(* [sanitize text] eliminates any special characters from the text [text].
+   A special character is a character whose ASCII code is less than 32.
+   Every special character is replaced with a single space character. *)
+
+val sanitize: string -> string
+
+(* [compress text] replaces every run of at least one whitespace character
+   with exactly one space character. *)
+
+val compress: string -> string
+
+(* [shorten k text] limits the length of [text] to [2k+3] characters. If the
+   text is too long, a fragment in the middle is replaced with an ellipsis. *)
+
+val shorten: int -> string -> string
+
+(* [expand f text] searches [text] for occurrences of [$k], where [k]
+   is a nonnegative integer literal, and replaces each such occurrence
+   with the string [f k]. *)
+
+val expand: (int -> string) -> string -> string
+end
+module LexerUtil : sig
+(******************************************************************************)
+(*                                                                            *)
+(*                                   Menhir                                   *)
+(*                                                                            *)
+(*                       François Pottier, Inria Paris                        *)
+(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
+(*                                                                            *)
+(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
+(*  terms of the GNU Library General Public License version 2, with a         *)
+(*  special exception on linking, as described in the file LICENSE.           *)
+(*                                                                            *)
+(******************************************************************************)
+
+open Lexing
+
+(* [init filename lexbuf] initializes the lexing buffer [lexbuf] so
+   that the positions that are subsequently read from it refer to the
+   file [filename]. It returns [lexbuf]. *)
+
+val init: string -> lexbuf -> lexbuf
+
+(* [read filename] reads the entire contents of the file [filename] and
+   returns a pair of this content (a string) and a lexing buffer that
+   has been initialized, based on this string. *)
+
+val read: string -> string * lexbuf
+
+(* [newline lexbuf] increments the line counter stored within [lexbuf]. It
+   should be invoked by the lexer itself every time a newline character is
+   consumed. This allows maintaining a current the line number in [lexbuf]. *)
+
+val newline: lexbuf -> unit
+
+(* [range (startpos, endpos)] prints a textual description of the range
+   delimited by the start and end positions [startpos] and [endpos].
+   This description is one line long and ends in a newline character.
+   This description mentions the file name, the line number, and a range
+   of characters on this line. The line number is correct only if [newline]
+   has been correctly used, as described dabove. *)
+
+val range: position * position -> string
 end
 module Printers : sig
 (******************************************************************************)
@@ -1701,5 +1779,5 @@ module MakeEngineTable
      and type nonterminal = int
 end
 module StaticVersion : sig
-val require_20200211: unit
+val require_20201201: unit
 end