Merge pull request #65 from nberth/clear-source-overlay-cache-upon-re…

…wind

Clear source overlay cache upon parser rewind

src/lsp/cobol_parser/grammar_utils.ml

@@ -20,7 +20,7 @@ open Cobol_ptree
 module Overlay_manager =
   Cobol_preproc.Src_overlay.New_manager (struct
     let name = __MODULE__
-  end)
+  end) ()
 
 let relation_condition ~neg (binrel: binary_relation) = function
   | None ->

src/lsp/cobol_parser/parser_engine.ml

@@ -562,6 +562,7 @@ let rec rewind_n_parse
       let pp = pp_rewind ~new_position:event.preproc_position pp in
       let ps = { ps with preproc = { ps.preproc with pp } } in
       let ps, tokens = produce_tokens ps in
+      Option.iter Overlay_manager.restart_at ps.prev_limit;
       { rwps with stage = Trans (ps, tokens, env); store }
     with Not_found ->                     (* rewinding before first checkpoint *)
       let pp = pp_rewind rwps.init.preproc.pp in

src/lsp/cobol_preproc/preproc_engine.ml

@@ -79,7 +79,7 @@ let preprocessor input = function
   | `WithOptions { libpath; verbose; source_format;
                    config = (module Config) } ->
       let module Om_name = struct let name = __MODULE__ end in
-      let module Om = Src_overlay.New_manager (Om_name) in
+      let module Om = Src_overlay.New_manager (Om_name) () in
       let module Pp = Preproc_grammar.Make (Config) (Om) in
       let source_format = source_format_config source_format in
       {

src/lsp/cobol_preproc/src_overlay.ml

@@ -11,20 +11,21 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Cobol_common.Srcloc.TYPES
+
 module TYPES = struct
   type limit = Lexing.position
 end
 include TYPES
 
-type srcloc = Cobol_common.Srcloc.srcloc  (* alias for shortening definitions *)
-
 module type MANAGER = sig
   type limit := limit
   val id: string
   val limits: srcloc -> limit * limit
   val link_limits: limit -> limit -> unit
   val join_limits: limit * limit -> srcloc
   val dummy_limit: limit
+  val restart_at: limit -> unit
 end
 
 (** Overlay limits (internal) *)
@@ -91,8 +92,7 @@ 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. *)
-  Links.remove ctx.cache s;  (* Manually remove from cache to prevent invalid *)
-  Links.remove ctx.cache e;  (* or even cyclic/infinite search upon rewind. *)
+  Links.remove ctx.cache s;               (* Manually remove from cache. *)
   s, e
 
 (** Links token limits *)
@@ -162,11 +162,15 @@ let join_limits: manager -> limit * limit -> srcloc = fun ctx (s, e) ->
   with Not_found ->
     join_failure (s, e)
 
-module New_manager (Id: sig val name: string end) : MANAGER = struct
+let restart_at ctx _limit =
+  Links.clear ctx.cache
+
+module New_manager (Id: sig val name: string end) () : MANAGER = struct
   let ctx = new_manager Id.name
   let id = ctx.id
   let limits = limits ctx
   let link_limits = link_limits ctx
   let join_limits = join_limits ctx
   let dummy_limit = Lexing.dummy_pos
+  let restart_at = restart_at ctx
 end

src/lsp/cobol_preproc/src_overlay.mli

@@ -15,13 +15,11 @@
     of lexing tokens that can be fed to parsers so as to tag ASTs with complex
     source locations. *)
 
-(* For now, it does not seem worth making this generic in
-   `Cobol_common.Srcloc.srcloc` via an additional functor. *)
-
-(** Source overlay limits, that MUST be considered abstract and whose contents
-    must not be inspected nor relied upon outside of this module.  Such limits
-    are to be fed to parsers, that usually expect lexing positons, so
-    unfortunately we can neither make this type abstract nor private.  *)
+(** Source overlay limits, that {e MUST} be considered abstract and whose
+    contents must not be inspected nor relied upon outside of this module.  Such
+    limits are to be fed to menhir-generated parsers, that expect lexing
+    positons from the {!Stdlib.Lexing} module, so unfortunately we can neither
+    make this type abstract nor private.  *)
 type limit = (* private *) Lexing.position
 
 (** Manager of source overlay limits.  Includes some mutable state. *)
@@ -48,7 +46,12 @@ module type MANAGER = sig
       but not given to {!link_limits} below. *)
   val dummy_limit: limit
 
+  (** [restart_at limit] instructs the manager that limits on the right of (but
+      not including) [limit] are now outdated and should not be relied upon.  At
+      the moment this just clears an internal cache. *)
+  val restart_at: limit -> unit
+
 end
 
 (** Nanager module instantiation *)
-module New_manager: functor (Id: sig val name: string end) -> MANAGER
+module New_manager: functor (Id: sig val name: string end) () -> MANAGER