Less accurate but more efficient handling of large single-file source locations

Author: nberth

src/lsp/cobol_preproc/src_overlay.ml

@@ -99,8 +99,18 @@ let leftmost_limit_in ~filename ctx =
     | res -> res
   end ctx.right_of None
 
-(** Returns a source location that spans between two given limits; returns a
-    valid pointwise location if the two given limits are physically equal. *)
+(** Internal flag to enable or disable the construction by [join_limits ctx (s,
+    e)] of composed source locations from every registered limits from [s] to
+    [e].  If [true], a call for which [s, e] is a valid lexical location [l]
+    will return [l]; this means some information on the source text
+    manipulations that resulted in some of the constituent tokens may not be
+    represented by [l] in this case.  Setting [simplified_join = false] computes
+    [l] more accurately, but is also potentielly more expensive. *)
+let simplified_join = true
+
+(** [join_limits ctx (s, e)] 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) ->
   let pointwise l =          (* pointwise: ensure this is not a virtual limit *)
     let pos =
@@ -134,18 +144,22 @@ let join_limits: manager -> limit * limit -> srcloc = fun ctx (s, e) ->
     (* Printexc.(print_raw_backtrace Stdlib.stderr @@ get_callstack 10); *)
     loc
   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 assuming `s` is an end of token *)
-  try try_limits (Links.find ctx.over_right_gap s, e) with Not_found ->
-    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 -> join_failure (s, e)
-    else join_failure (s, e)
+  if simplified_join && not (Limit.is_virtual s || Limit.is_virtual e) &&
+     s.pos_fname = e.pos_fname
+  then Cobol_common.Srcloc.raw (s, e)  (* Note: we may loose area-a info here *)
+  else
+    (* 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 assuming `s` is an end of token *)
+    try try_limits (Links.find ctx.over_right_gap s, e) with Not_found ->
+      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 -> join_failure (s, e)
+      else join_failure (s, e)
 
 module New_manager (Id: sig val name: string end) : MANAGER = struct
   let ctx = new_manager Id.name