Run the pre-precessor once before building the first parser checkpoint

This completely removes the need to handle cases of dummy left-most
positions in the source overlay module.

Author: nberth

src/lsp/cobol_parser/parser_engine.ml

@@ -220,7 +220,7 @@ module Make (Config: Cobol_config.T) = struct
 
   (* --- *)
 
-  let do_parse: type m. m state -> _ -> _ * m state =
+  let do_parse: type m. m state -> _ -> _ -> _ * m state =
 
     let rec next_tokens ({ preproc = { tokzr; _ }; _ } as ps) tokens =
       match Tokzr.next_token tokzr tokens with
@@ -424,16 +424,22 @@ module Make (Config: Cobol_config.T) = struct
       Some v, ps
 
     in
-    fun ps c -> normal ps [] c
+    fun ps tokens c -> normal ps tokens c
 
   let parse ?verbose ?show ~recovery
-      (type m) ~(memory: m memory) pp checkpoint
+      (type m) ~(memory: m memory) pp make_checkpoint
     : ('a option, m) output * _ =
     let ps = init_parser ?verbose ?show ~recovery
         ~tokenizer_memory:memory pp in
     let res, ps =
       (* TODO: catch in a deeper context to grab parsed tokens *)
-      try do_parse ps checkpoint with e -> None, add_diag (DIAGS.of_exn e) ps
+      let ps, tokens = produce_tokens ps in
+      let first_pos = match tokens with
+        | [] -> Cobol_preproc.position ps.preproc.pp
+        | t :: _ -> Cobol_common.Srcloc.start_pos ~@t
+      in
+      try do_parse ps tokens (make_checkpoint first_pos)
+      with e -> None, add_diag (DIAGS.of_exn e) ps
     in
     match memory with
     | Amnesic ->
@@ -480,9 +486,8 @@ let parse
                                          init_source_format = source_format}
           in
           let module P = Make (val config) in
-          P.parse ?verbose ?show ~memory ~recovery pp @@
-          Grammar.Incremental.compilation_group @@
-          Cobol_preproc.position pp
+          P.parse ?verbose ?show ~memory ~recovery pp
+          Grammar.Incremental.compilation_group
         end
     in
     {

src/lsp/cobol_preproc/src_overlay.ml

@@ -67,7 +67,6 @@ type manager =
     over_right_gap: limit Links.t;  (** associates the right limit of a token to
                                         the left limit of the next *)
     cache: (srcloc * limit) Links.t;
-    leftmost_in_file: (string, limit) Hashtbl.t;
     id: string;                (** manager identifier (for logging/debugging) *)
   }
 
@@ -80,7 +79,6 @@ let new_manager: string -> manager =
       right_of = Links.create 42;
       over_right_gap = Links.create 42;
       cache = Links.create 42;
-      leftmost_in_file = Hashtbl.create 3;
       id = Pretty.to_string "%s-%u" manager_name !id;
     }
 
@@ -96,21 +94,13 @@ let limits: manager -> srcloc -> limit * limit = fun ctx loc ->
     | _ -> Limit.make_virtual (), Limit.make_virtual ()
   in
   Links.replace ctx.right_of s (loc, e);   (* replace to deal with duplicates *)
-  if not (Hashtbl.mem ctx.leftmost_in_file s.pos_fname)
-  then  Hashtbl.add ctx.leftmost_in_file s.pos_fname s;
   s, e
 
 (** Links token limits *)
 let link_limits ctx left right =
   (* Replace to deal with overriding of limits during recovery. *)
   Links.replace ctx.over_right_gap left right
 
-(** [leftmost_limit_in ~filename ctx] finds the leftmost limit from a location
-    in [filename] that is registered in [ctx] (internal).  Use with moderation
-    as this is quite inefficient. *)
-let leftmost_limit_in ~filename ctx =
-  Hashtbl.find_opt ctx.leftmost_in_file filename
-
 (** Returns a source location that spans between two given limits; returns a
     valid pointwise location if the two given limits are physically equal. *)
 let join_limits: manager -> limit * limit -> srcloc = fun ctx (s, e) ->
@@ -165,17 +155,14 @@ let join_limits: manager -> limit * limit -> srcloc = fun ctx (s, e) ->
   in
   (* first attempt assumes proper token limits: `s` is a left and `e` is a
      right of tokens *)
-  try try_limits (s, e) with Not_found ->
+  try
+    try_limits (s, e)
+  with Not_found ->
   (* otherwise try assuming `s` is an end of token *)
-  try try_limits (Links.find ctx.over_right_gap s, e) with Not_found ->
-  try if s.pos_cnum = 0 (* potential special case with left-position forged by
-                           the parser: retry with leftmost limit if it differs
-                           from s *)
-    then match leftmost_limit_in ~filename:s.pos_fname ctx with
-      | Some l when l != s -> try_limits (l, e) (* physical equality is enough *)
-      | Some _ | None -> raise Not_found
-    else raise Not_found
-  with Not_found -> join_failure (s, e)
+  try
+    try_limits (Links.find ctx.over_right_gap s, e)
+  with Not_found ->
+    join_failure (s, e)
 
 module New_manager (Id: sig val name: string end) : MANAGER = struct
   let ctx = new_manager Id.name