From 154528c42ee815be94ac35375cd1c9a61efd0c78 Mon Sep 17 00:00:00 2001 From: Mateo Date: Thu, 8 Aug 2024 10:21:28 +0200 Subject: [PATCH] revert: added back tokens type --- src/lsp/cobol_parser/cobol_parser.ml | 2 +- src/lsp/cobol_parser/parser_engine.ml | 4 +-- src/lsp/cobol_parser/text_tokenizer.ml | 32 +++++++++---------- src/lsp/cobol_parser/text_tokenizer.mli | 41 +++++++++++++------------ 4 files changed, 40 insertions(+), 39 deletions(-) diff --git a/src/lsp/cobol_parser/cobol_parser.ml b/src/lsp/cobol_parser/cobol_parser.ml index f8615d33..84a7fc52 100644 --- a/src/lsp/cobol_parser/cobol_parser.ml +++ b/src/lsp/cobol_parser/cobol_parser.ml @@ -24,7 +24,7 @@ module Tokens = struct include Grammar_tokens let pp = Text_tokenizer.pp_token let pp' = Text_tokenizer.pp_token' - let pp'_list = Text_tokenizer.pp_token'_list + let pp'_list = Text_tokenizer.pp_tokens let pp'_list_with_loc_info = Text_tokenizer.pp_tokens_with_loc_info end module Expect = Grammar_expect diff --git a/src/lsp/cobol_parser/parser_engine.ml b/src/lsp/cobol_parser/parser_engine.ml index 7b2c814f..6d94e84c 100644 --- a/src/lsp/cobol_parser/parser_engine.ml +++ b/src/lsp/cobol_parser/parser_engine.ml @@ -163,7 +163,7 @@ let all_diags { preproc = { pp; diags; tokzr; _ }; _ } = (* --- *) -let rec produce_tokens (ps: _ state as 's) : 's * Tokzr.token' list = +let rec produce_tokens (ps: _ state as 's) : 's * Text_tokenizer.tokens = let text, pp = Cobol_preproc.next_chunk ps.preproc.pp in let { preproc = { pp; tokzr; _ }; _ } as ps = update_pp ps pp in assert (text <> []); @@ -400,7 +400,7 @@ type ('a, 'm) stage = rewound. *) and ('a, 'm) interim_stage = 'm state * - Tokzr.token' list * + Text_tokenizer.tokens * 'a Grammar_interpr.env (* Always valid input_needed env. *) (** Final stage, at which the parser has stopped processing. *) diff --git a/src/lsp/cobol_parser/text_tokenizer.ml b/src/lsp/cobol_parser/text_tokenizer.ml index d53bcd90..79bfcb4b 100644 --- a/src/lsp/cobol_parser/text_tokenizer.ml +++ b/src/lsp/cobol_parser/text_tokenizer.ml @@ -23,6 +23,7 @@ open Parser_diagnostics (* --- *) type token' = Grammar_tokens.token with_loc +type tokens = token' list let combined_tokens = (* /!\ WARNING: None of the constituents of combined tokens may be @@ -95,27 +96,27 @@ let pp_token_string: Grammar_tokens.token Pretty.printer = fun ppf -> let pp_token: Grammar_tokens.token Pretty.printer = fun ppf -> let string s = Pretty.string ppf s and print format = Pretty.print ppf format in - fun t -> match t with + function | WORD w -> print "WORD[%s]" w | WORD_IN_AREA_A w -> print "WORD_IN_AREA_A[%s]" w | PICTURE_STRING w -> print "PICTURE_STRING[%s]" w | INFO_WORD s -> print "INFO_WORD[%s]" s - | COMMENT_ENTRY _ -> print "COMMENT_ENTRY[%a]" pp_token_string t - | EXEC_BLOCK _ -> print "EXEC_BLOCK[%a]" pp_token_string t + | COMMENT_ENTRY _ as t -> print "COMMENT_ENTRY[%a]" pp_token_string t + | EXEC_BLOCK _ as t -> print "EXEC_BLOCK[%a]" pp_token_string t | DIGITS i -> print "DIGITS[%s]" i | SINTLIT i -> print "SINT[%s]" i | FIXEDLIT (i, sep, d) -> print "FIXED[%s%c%s]" i sep d | FLOATLIT (i, sep, d, e) -> print "FLOAT[%s%c%sE%s]" i sep d e | INTERVENING_ c -> print "<%c>" c | tok when is_intrinsic_token tok -> - print "INTRINSIC_FUNC[%a]" pp_token_string t + print "INTRINSIC_FUNC[%a]" pp_token_string tok | EOF -> string "EOF" | t -> pp_token_string ppf t let pp_token': token' Pretty.printer = Cobol_common.Srcloc.pp_with_loc pp_token -let pp_token'_list = +let pp_tokens = Pretty.list ~fopen:"@[" ~fclose:"@]" pp_token' let pp_tokens_with_loc_info ?fsep = @@ -340,12 +341,12 @@ let preproc_n_combine_tokens ~intrinsics_enabled ~source_format = type 'a memory = | Amnesic: Cobol_common.Behaviors.amnesic memory - | Eidetic: token' list -> Cobol_common.Behaviors.eidetic memory + | Eidetic: tokens -> Cobol_common.Behaviors.eidetic memory type 'm state = { lexer_state: Text_lexer.lexer_state; - leftover_tokens: token' list; (* non-empty only when [preproc_n_combine_tokens] + leftover_tokens: tokens; (* non-empty only when [preproc_n_combine_tokens] errors out for lack of input tokens. *) memory: 'm memory; context_stack: Context.stack; @@ -544,7 +545,7 @@ let acc_tokens_of_text_word (rev_prefix_tokens, state) { payload = c; loc } = else nominal state -let tokens_of_text: 'a state -> text -> token' list * 'a state = fun state text -> +let tokens_of_text: 'a state -> text -> tokens * 'a state = fun state text -> let tokens, state = List.fold_left acc_tokens_of_text_word ([], state) text in List.rev tokens, state @@ -557,7 +558,7 @@ let tokenize_text ~source_format ({ leftover_tokens; _ } as state) text = match preproc_n_combine_tokens ~intrinsics_enabled ~source_format tokens with | Ok (tokens, diags) -> if show `Tks state then - Pretty.error "Tks: %a@." pp_token'_list tokens; + Pretty.error "Tks: %a@." pp_tokens tokens; let diags = Parser_diagnostics.union diags state.diags in Ok tokens, { state with diags } | Error `MissingInputs -> @@ -606,7 +607,7 @@ let retokenize { lexer_state; persist = { lexer; _ }; _ } w = (handling of DECIMAL POINT). *) fst @@ Text_lexer.read_tokens lexer lexer_state w -let reword_intrinsics s : token' list -> token' list = +let reword_intrinsics s : tokens -> tokens = (* Some intrinsics NOT preceded with FUNCTION may now be words; assumes [Disabled_intrinsics] does not occur on a `FUNCTION` keyword (but that's unlikely). *) @@ -630,8 +631,7 @@ let reword_intrinsics s : token' list -> token' list = {!module:Text_lexer}. *) (* TODO: Find whether everything related to Area A and comma-retokenization could be moved to Text_lexer *) -let retokenize_after: lexer_update -> _ state -> token' list -> token' list = - fun update s -> +let retokenize_after: lexer_update -> _ state -> tokens -> tokens = fun update s -> match update with | Enabled_keywords tokens | Disabled_keywords tokens @@ -738,7 +738,7 @@ let enable_intrinsics state token tokens = let tokens = retokenize_after Enabled_intrinsics state tokens in let token, tokens = List.hd tokens, List.tl tokens in if show `Tks state then - Pretty.error "Tks': %a@." pp_token'_list tokens; + Pretty.error "Tks': %a@." pp_tokens tokens; emit_token state token, token, tokens @@ -750,7 +750,7 @@ let disable_intrinsics state token tokens = let tokens = retokenize_after Disabled_intrinsics state tokens in let token, tokens = List.hd tokens, List.tl tokens in if show `Tks state then - Pretty.error "Tks': %a@." pp_token'_list tokens; + Pretty.error "Tks': %a@." pp_tokens tokens; emit_token state token, token, tokens @@ -785,7 +785,7 @@ let decimal_point_is_comma (type m) (state: m state) token tokens = let tokens = retokenize_after CommaBecomesDecimalPoint state tokens in let token, tokens = List.hd tokens, List.tl tokens in if show `Tks state then - Pretty.error "Tks': %a@." pp_token'_list tokens; + Pretty.error "Tks': %a@." pp_tokens tokens; emit_token state token, token, tokens @@ -819,7 +819,7 @@ let push_contexts state tokens : Context.t list -> 's * 'a = function (* Update tokenizer state *) let state, tokens = enable_tokens state tokens tokens_set in if show `Tks state then - Pretty.error "Tks': %a@." pp_token'_list tokens; + Pretty.error "Tks': %a@." pp_tokens tokens; with_context_stack state context_stack, tokens diff --git a/src/lsp/cobol_parser/text_tokenizer.mli b/src/lsp/cobol_parser/text_tokenizer.mli index 4c225fea..5afa8fa4 100644 --- a/src/lsp/cobol_parser/text_tokenizer.mli +++ b/src/lsp/cobol_parser/text_tokenizer.mli @@ -19,11 +19,12 @@ open EzCompat (** Tokens passed to {!Parser}; can be obtained via {!tokenize_text}. *) type token' = Grammar_tokens.token Cobol_ptree.with_loc +type tokens = token' list val pp_token: Grammar_tokens.token Pretty.printer val pp_token': token' Pretty.printer -val pp_token'_list: token' list Pretty.printer -val pp_tokens_with_loc_info: ?fsep:Pretty.simple -> token' list Pretty.printer +val pp_tokens: tokens Pretty.printer +val pp_tokens_with_loc_info: ?fsep:Pretty.simple -> tokens Pretty.printer (* --- *) @@ -63,44 +64,44 @@ val diagnostics val parsed_tokens : Cobol_common.Behaviors.eidetic state - -> token' list Lazy.t + -> tokens Lazy.t val tokenize_text : source_format: Cobol_preproc.Src_format.any -> 'a state -> Cobol_preproc.Text.t - -> (token' list, [>`MissingInputs | `ReachedEOF of token' list]) result * 'a state + -> (tokens, [>`MissingInputs | `ReachedEOF of tokens]) result * 'a state val next_token : 'a state - -> token' list - -> ('a state * token' * token' list) option + -> tokens + -> ('a state * token' * tokens) option val put_token_back : 'a state -> token' - -> token' list - -> 'a state * token' list + -> tokens + -> 'a state * tokens (* --- *) val enable_intrinsics : 'a state -> token' - -> token' list - -> 'a state * token' * token' list + -> tokens + -> 'a state * token' * tokens val disable_intrinsics : 'a state -> token' - -> token' list - -> 'a state * token' * token' list + -> tokens + -> 'a state * token' * tokens val reset_intrinsics : 'a state -> token' - -> token' list - -> 'a state * token' * token' list + -> tokens + -> 'a state * token' * tokens val replace_intrinsics : 'a state @@ -110,16 +111,16 @@ val replace_intrinsics val decimal_point_is_comma : 'a state -> token' - -> token' list - -> 'a state * token' * token' list + -> tokens + -> 'a state * token' * tokens (* --- *) val push_contexts : 'a state - -> token' list + -> tokens -> Grammar_contexts.context list - -> 'a state * token' list + -> 'a state * tokens val top_context : _ state @@ -127,8 +128,8 @@ val top_context val pop_context : 'a state - -> token' list - -> 'a state * token' list + -> tokens + -> 'a state * tokens val enable_context_sensitive_tokens: _ state -> unit val disable_context_sensitive_tokens: _ state -> unit