From cf33f5256f49021cb5f0f1e8ac85c4a1b8fc99f8 Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Wed, 20 Sep 2023 17:31:01 +0200 Subject: [PATCH] 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. --- src/lsp/cobol_parser/parser_engine.ml | 19 ++++++++++++------- src/lsp/cobol_preproc/src_overlay.ml | 27 +++++++-------------------- 2 files changed, 19 insertions(+), 27 deletions(-) diff --git a/src/lsp/cobol_parser/parser_engine.ml b/src/lsp/cobol_parser/parser_engine.ml index cdb520734..9a3a5b9ac 100644 --- a/src/lsp/cobol_parser/parser_engine.ml +++ b/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 { diff --git a/src/lsp/cobol_preproc/src_overlay.ml b/src/lsp/cobol_preproc/src_overlay.ml index 09165448f..530f84f2b 100644 --- a/src/lsp/cobol_preproc/src_overlay.ml +++ b/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,8 +94,6 @@ 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 *) @@ -105,12 +101,6 @@ 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