From 733155cb10aa6f44599df4cbeb628a245f7d63c0 Mon Sep 17 00:00:00 2001 From: Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com> Date: Thu, 1 Feb 2024 18:19:43 +0100 Subject: [PATCH] Remove cobol_preproc.ml --- src/lsp/cobol_indent/indent_main.ml | 2 +- src/lsp/cobol_lsp/lsp_document.ml | 4 +- src/lsp/cobol_parser/parser_engine.ml | 36 +++++++++--------- src/lsp/cobol_parser/parser_engine.mli | 7 ++-- src/lsp/cobol_preproc/cobol_preproc.ml | 37 ------------------- .../{preproc_directives.ml => directives.ml} | 0 .../{preproc_options.ml => options.ml} | 0 src/lsp/cobol_preproc/preproc_grammar.mly | 10 ++--- src/lsp/cobol_preproc/preproc_grammar_sig.ml | 8 ++-- src/lsp/cobol_preproc/preproc_utils.mli | 4 +- .../{preproc_engine.ml => preprocess.ml} | 24 ++++++------ .../{preproc_engine.mli => preprocess.mli} | 15 ++++---- src/lsp/cobol_preproc/src_reader.ml | 6 +-- src/lsp/cobol_preproc/src_reader.mli | 4 +- src/lsp/cobol_preproc/text_processor.ml | 10 ++--- src/lsp/cobol_preproc/text_processor.mli | 18 ++++----- .../{preproc_trace.ml => trace.ml} | 2 +- .../{preproc_trace.mli => trace.mli} | 4 +- src/lsp/superbol_free_lib/command_pp.ml | 6 +-- test/cobol_parsing/parser_testing.ml | 14 +++---- test/cobol_preprocessing/preproc_testing.ml | 29 ++++++++------- test/output-tests/gnucobol.ml | 4 +- test/output-tests/preproc.ml | 2 +- test/output-tests/reparse.ml | 4 +- 24 files changed, 109 insertions(+), 141 deletions(-) delete mode 100644 src/lsp/cobol_preproc/cobol_preproc.ml rename src/lsp/cobol_preproc/{preproc_directives.ml => directives.ml} (100%) rename src/lsp/cobol_preproc/{preproc_options.ml => options.ml} (100%) rename src/lsp/cobol_preproc/{preproc_engine.ml => preprocess.ml} (96%) rename src/lsp/cobol_preproc/{preproc_engine.mli => preprocess.mli} (92%) rename src/lsp/cobol_preproc/{preproc_trace.ml => trace.ml} (97%) rename src/lsp/cobol_preproc/{preproc_trace.mli => trace.mli} (94%) diff --git a/src/lsp/cobol_indent/indent_main.ml b/src/lsp/cobol_indent/indent_main.ml index 1d9ec39ed..a965fbbe7 100644 --- a/src/lsp/cobol_indent/indent_main.ml +++ b/src/lsp/cobol_indent/indent_main.ml @@ -23,7 +23,7 @@ let indent_range ~dialect ~source_format ~indent_config ~range ~filename ~conten Cobol_preproc.Src_format.from_config SFFixed in let state = - Cobol_preproc.fold_source_lines ~dialect ~source_format + Cobol_preproc.Preprocess.fold_source_lines ~dialect ~source_format ~on_initial_source_format:(fun src_format st -> { st with src_format }) ~on_compiler_directive:(fun _ { payload = cd; _} st -> match cd with diff --git a/src/lsp/cobol_lsp/lsp_document.ml b/src/lsp/cobol_lsp/lsp_document.ml index 760ddde48..c8930645d 100644 --- a/src/lsp/cobol_lsp/lsp_document.ml +++ b/src/lsp/cobol_lsp/lsp_document.ml @@ -72,7 +72,7 @@ let rewindable_parse ({ project; textdoc; _ } as doc) = recovery = EnableRecovery { silence_benign_recoveries = true }; config = project.config.cobol_config; } @@ - Cobol_preproc.preprocessor + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with libpath = Lsp_project.libpath_for ~uri:(uri doc) project; @@ -116,7 +116,7 @@ let reparse_and_analyze ?position ({ copybook; rewinder; textdoc; _ } as doc) = | Some position, Some rewinder -> check doc @@ Cobol_parser.rewind_and_parse rewinder ~position @@ - Cobol_preproc.reset_preprocessor_for_string @@ + Cobol_preproc.Preprocess.reset_preprocessor_for_string @@ Lsp.Text_document.text textdoc (** Creates a record for a document that is not yet parsed or analyzed. *) diff --git a/src/lsp/cobol_parser/parser_engine.ml b/src/lsp/cobol_parser/parser_engine.ml index 226cdf1b9..707e629cc 100644 --- a/src/lsp/cobol_parser/parser_engine.ml +++ b/src/lsp/cobol_parser/parser_engine.ml @@ -38,19 +38,19 @@ type 'x rewinder = ('x * ('x rewinder)) with_diags; } and preprocessor_rewind = - ?new_position: Lexing.position -> (Cobol_preproc.preprocessor as 'r) -> 'r + ?new_position: Lexing.position -> (Cobol_preproc.Preprocess.preprocessor as 'r) -> 'r and position = | Lexing of Lexing.position | Indexed of { line: int; char: int } (* all starting at 0 *) type 'm simple_parsing = ?options:parser_options - -> Cobol_preproc.preprocessor + -> Cobol_preproc.Preprocess.preprocessor -> (Cobol_ptree.compilation_group option, 'm) output DIAGS.with_diags type 'm rewindable_parsing = ?options:parser_options - -> Cobol_preproc.preprocessor + -> Cobol_preproc.Preprocess.preprocessor -> (((Cobol_ptree.compilation_group option, 'm) output as 'x) * 'x rewinder) DIAGS.with_diags @@ -78,7 +78,7 @@ type 'm state = basis (mostly the pre-processor and tokenizer's states). *) and 'm preproc = { - pp: Cobol_preproc.preprocessor; (* also holds diagnostics *) + pp: Cobol_preproc.Preprocess.t; (* also holds diagnostics *) tokzr: 'm Tokzr.state; persist: 'm persist; } @@ -130,21 +130,21 @@ and update_tokzr ps tokzr = else { ps with preproc = { ps.preproc with tokzr } } let add_diag diag ({ preproc = { pp; _ }; _ } as ps) = - update_pp ps (Cobol_preproc.add_diag pp diag) + update_pp ps (Cobol_preproc.Preprocess.add_diag pp diag) let add_diags diags ({ preproc = { pp; _ }; _ } as ps) = - update_pp ps (Cobol_preproc.add_diags pp diags) + update_pp ps (Cobol_preproc.Preprocess.add_diags pp diags) let all_diags { preproc = { pp; tokzr; _ }; _ } = - DIAGS.Set.union (Cobol_preproc.diags pp) @@ Tokzr.diagnostics tokzr + DIAGS.Set.union (Cobol_preproc.Preprocess.diags pp) @@ Tokzr.diagnostics tokzr (* --- *) let rec produce_tokens (ps: _ state as 's) : 's * Text_tokenizer.tokens = - let text, pp = Cobol_preproc.next_chunk ps.preproc.pp in + let text, pp = Cobol_preproc.Preprocess.next_chunk ps.preproc.pp in let { preproc = { pp; tokzr; _ }; _ } as ps = update_pp ps pp in assert (text <> []); (* Note: this is the source format in use at the end of the sentence. *) - let source_format = Cobol_preproc.source_format pp in + let source_format = Cobol_preproc.Preprocess.source_format pp in match Tokzr.tokenize_text ~source_format tokzr text with | Error `MissingInputs, tokzr -> produce_tokens (update_tokzr ps tokzr) @@ -396,7 +396,7 @@ let on_exn ps e = let first_stage (ps: 'm state) ~make_checkpoint : ('a, 'm) stage = let ps, tokens = produce_tokens ps in let first_pos = match tokens with - | [] -> Cobol_preproc.position ps.preproc.pp + | [] -> Cobol_preproc.Preprocess.position ps.preproc.pp | t :: _ -> Cobol_common.Srcloc.start_pos ~@t in normal ps tokens (make_checkpoint first_pos) @@ -419,9 +419,9 @@ let aggregate_output (type m) (ps: m state) res | Eidetic -> let artifacts = { tokens = Tokzr.parsed_tokens ps.preproc.tokzr; - pplog = Cobol_preproc.rev_log ps.preproc.pp; - rev_comments = Cobol_preproc.rev_comments ps.preproc.pp; - rev_ignored = Cobol_preproc.rev_ignored ps.preproc.pp } in + pplog = Cobol_preproc.Preprocess.rev_log ps.preproc.pp; + rev_comments = Cobol_preproc.Preprocess.rev_comments ps.preproc.pp; + rev_ignored = Cobol_preproc.Preprocess.rev_ignored ps.preproc.pp } in WithArtifacts (res, artifacts) (** Simple parsing *) @@ -469,7 +469,7 @@ let init_rewindable_parse ps ~make_checkpoint = (** Stores a stage as part of the memorized rewindable history events. *) let save_interim_stage (ps, _, env) (store: _ rewindable_history) = - let preproc_position = Cobol_preproc.position ps.preproc.pp in + let preproc_position = Cobol_preproc.Preprocess.position ps.preproc.pp in match store with | store' when preproc_position.pos_cnum <> preproc_position.pos_bol -> @@ -516,7 +516,7 @@ let find_history_event_preceding ~position ({ store; _ } as rwps) = pos | Indexed { line; char } -> let ps = rewindable_parser_state rwps in - Cobol_preproc.position_at ~line ~char ps.preproc.pp + Cobol_preproc.Preprocess.position_at ~line ~char ps.preproc.pp in let rec aux = function | [] -> @@ -560,7 +560,7 @@ let rec rewind_n_parse let rewindable_parse : options:_ -> memory:'m memory -> make_checkpoint:_ - -> Cobol_preproc.preprocessor + -> Cobol_preproc.Preprocess.preprocessor -> ((('a option, 'm) output as 'x) * 'x rewinder) with_diags = fun ~options ~memory ~make_checkpoint pp -> let res, rwps = @@ -581,7 +581,7 @@ let parse (type m) ~(memory: m memory) ?(options = Parser_options.default) - : Cobol_preproc.preprocessor -> + : Cobol_preproc.Preprocess.t -> (Cobol_ptree.compilation_group option, m) output with_diags = parse_once ~options ~memory ~make_checkpoint:Grammar.Incremental.compilation_group @@ -593,7 +593,7 @@ let rewindable_parse (type m) ~(memory: m memory) ?(options = Parser_options.default) - : Cobol_preproc.preprocessor -> + : Cobol_preproc.Preprocess.t -> (((Cobol_ptree.compilation_group option, m) output as 'x) * 'x rewinder) with_diags = rewindable_parse ~options ~memory diff --git a/src/lsp/cobol_parser/parser_engine.mli b/src/lsp/cobol_parser/parser_engine.mli index db0525f37..dacadca8f 100644 --- a/src/lsp/cobol_parser/parser_engine.mli +++ b/src/lsp/cobol_parser/parser_engine.mli @@ -37,7 +37,7 @@ open Parser_outputs (** Simple parsing functions traverse the inputs once to produce a result. *) type 'm simple_parsing = ?options:Parser_options.parser_options - -> Cobol_preproc.preprocessor + -> Cobol_preproc.Preprocess.t -> (Cobol_ptree.compilation_group option, 'm) output Cobol_common.Diagnostics.with_diags @@ -60,7 +60,7 @@ val parse_with_artifacts {!rewinder} that may then be given to {!rewind_and_parse}. *) type 'm rewindable_parsing = ?options:parser_options - -> Cobol_preproc.preprocessor + -> Cobol_preproc.Preprocess.preprocessor -> (((Cobol_ptree.compilation_group option, 'm) output as 'x) * 'x rewinder) Cobol_common.Diagnostics.with_diags @@ -73,7 +73,8 @@ and 'x rewinder [new_position] is not given, the text should be read from the very begining of the input. *) and preprocessor_rewind = - ?new_position:Lexing.position -> (Cobol_preproc.preprocessor as 'r) -> 'r + ?new_position:Lexing.position -> + (Cobol_preproc.Preprocess.t as 'r) -> 'r (* val rewindable_parse *) (* : memory:'m memory -> 'm rewindable_parsing *) diff --git a/src/lsp/cobol_preproc/cobol_preproc.ml b/src/lsp/cobol_preproc/cobol_preproc.ml deleted file mode 100644 index ebfd0ea37..000000000 --- a/src/lsp/cobol_preproc/cobol_preproc.ml +++ /dev/null @@ -1,37 +0,0 @@ -(**************************************************************************) -(* *) -(* SuperBOL OSS Studio *) -(* *) -(* Copyright (c) 2022-2023 OCamlPro SAS *) -(* *) -(* All rights reserved. *) -(* This source code is licensed under the GNU Affero General Public *) -(* License version 3 found in the LICENSE.md file in the root directory *) -(* of this source tree. *) -(* *) -(**************************************************************************) - -(** {1 Source format} *) - -module Src_format = Src_format - -(** {1 Text} - - "Text" refers to the source after manipulations by preprocessor statements. *) - -module Text = Text -module Text_printer = Text_printer - -(** {1 Miscellaneous support modules} *) - -module Src_overlay = Src_overlay -module Trace = Preproc_trace -module Directives = Preproc_directives - -(** {1 Main entry points for the processor itself} *) - -type input = [%import: Src_input.t] - -module Input = Src_input -module Options = Preproc_options -include Preproc_engine diff --git a/src/lsp/cobol_preproc/preproc_directives.ml b/src/lsp/cobol_preproc/directives.ml similarity index 100% rename from src/lsp/cobol_preproc/preproc_directives.ml rename to src/lsp/cobol_preproc/directives.ml diff --git a/src/lsp/cobol_preproc/preproc_options.ml b/src/lsp/cobol_preproc/options.ml similarity index 100% rename from src/lsp/cobol_preproc/preproc_options.ml rename to src/lsp/cobol_preproc/options.ml diff --git a/src/lsp/cobol_preproc/preproc_grammar.mly b/src/lsp/cobol_preproc/preproc_grammar.mly index ca86d9df7..5e21684d8 100644 --- a/src/lsp/cobol_preproc/preproc_grammar.mly +++ b/src/lsp/cobol_preproc/preproc_grammar.mly @@ -22,10 +22,10 @@ (* Entry points *) -%start <Preproc_directives.copy_statement +%start <Directives.copy_statement Cobol_common.Diagnostics.with_diags Cobol_common.Srcloc.with_loc> copy_statement -%start <Preproc_directives.replace_statement +%start <Directives.replace_statement Cobol_common.Diagnostics.with_diags Cobol_common.Srcloc.with_loc> replace_statement @@ -104,8 +104,8 @@ let copy_replacing_text_identifier := c @ [lpar] @ cl @ [rpar] } let leading_or_trailing == - | LEADING; { Preproc_directives.Leading } - | TRAILING; { Preproc_directives.Trailing } + | LEADING; { Directives.Leading } + | TRAILING; { Directives.Trailing } (* --- REPLACE -------------------------------------------------------------- *) @@ -117,7 +117,7 @@ let replace_statement_ := { result = CDirReplace { also; replacing }; diags } } | REPLACE; last = ibo(LAST); OFF; "."; { Cobol_common.Diagnostics.simple_result @@ - Preproc_directives.CDirReplaceOff { last } } + Directives.CDirReplaceOff { last } } (* ISO/IEC 1989:2014 only allows the following clauses in "REPLACE"; however we allow the same clauses as GnuCOBOL. *) diff --git a/src/lsp/cobol_preproc/preproc_grammar_sig.ml b/src/lsp/cobol_preproc/preproc_grammar_sig.ml index 66d7bee45..01ce85e6e 100644 --- a/src/lsp/cobol_preproc/preproc_grammar_sig.ml +++ b/src/lsp/cobol_preproc/preproc_grammar_sig.ml @@ -31,9 +31,9 @@ module type S = sig (* The monolithic API. *) - val replace_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Preproc_directives.replace_statement Cobol_common.Srcloc.with_loc) + val replace_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Directives.replace_statement Cobol_common.Srcloc.with_loc) - val copy_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Preproc_directives.copy_statement Cobol_common.Srcloc.with_loc) + val copy_statement: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (Directives.copy_statement Cobol_common.Srcloc.with_loc) val _unused_symbols: (Lexing.lexbuf -> token) -> Lexing.lexbuf -> (unit) @@ -50,9 +50,9 @@ module type S = sig module Incremental : sig - val replace_statement: Lexing.position -> (Preproc_directives.replace_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint + val replace_statement: Lexing.position -> (Directives.replace_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint - val copy_statement: Lexing.position -> (Preproc_directives.copy_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint + val copy_statement: Lexing.position -> (Directives.copy_statement Cobol_common.Srcloc.with_loc) MenhirInterpreter.checkpoint val _unused_symbols: Lexing.position -> (unit) MenhirInterpreter.checkpoint diff --git a/src/lsp/cobol_preproc/preproc_utils.mli b/src/lsp/cobol_preproc/preproc_utils.mli index bd276c79a..0b646c0f9 100644 --- a/src/lsp/cobol_preproc/preproc_utils.mli +++ b/src/lsp/cobol_preproc/preproc_utils.mli @@ -17,11 +17,11 @@ open Cobol_common.Diagnostics.TYPES module Make (Config: Cobol_config.Types.T) : sig val replacing' - : ?repl_dir:Preproc_directives.replacing_direction + : ?repl_dir:Directives.replacing_direction -> [< `Alphanum of Text.pseudotext | `PseudoText of Text.pseudotext ] Cobol_common.Srcloc.with_loc -> Text.pseudotext Cobol_common.Srcloc.with_loc - -> Preproc_directives.replacing option Cobol_common.Diagnostics.with_diags + -> Directives.replacing option Cobol_common.Diagnostics.with_diags val filter_map_4_list_with_diags' : 'a option with_diags with_loc list -> 'a with_loc list with_diags diff --git a/src/lsp/cobol_preproc/preproc_engine.ml b/src/lsp/cobol_preproc/preprocess.ml similarity index 96% rename from src/lsp/cobol_preproc/preproc_engine.ml rename to src/lsp/cobol_preproc/preprocess.ml index 73f168b59..ffe9d56a4 100644 --- a/src/lsp/cobol_preproc/preproc_engine.ml +++ b/src/lsp/cobol_preproc/preprocess.ml @@ -14,7 +14,7 @@ open Cobol_common.Srcloc.TYPES open Cobol_common.Srcloc.INFIX open Cobol_common.Diagnostics.TYPES -open Preproc_options +open Options module DIAGS = Cobol_common.Diagnostics @@ -25,7 +25,7 @@ type preprocessor = buff: Text.t; reader: Src_reader.t; ppstate: Preproc_state.t; - pplog: Preproc_trace.log; + pplog: Trace.log; diags: DIAGS.diagnostics; persist: preprocessor_persist; } @@ -35,7 +35,7 @@ and preprocessor_persist = { pparser: (module Text_processor.PPPARSER); overlay_manager: (module Src_overlay.MANAGER); - replacing: Preproc_directives.replacing with_loc list list; + replacing: Directives.replacing with_loc list list; copybooks: Cobol_common.Srcloc.copylocs; (* opened copybooks *) dialect: Cobol_config.Types.dialect; source_format: Src_format.any option; (* to keep auto-detecting on reset *) @@ -44,6 +44,8 @@ and preprocessor_persist = show_if_verbose: [`Txt | `Src] list; } +type t = preprocessor + let diags { diags; reader; _ } = DIAGS.Set.union diags @@ Src_reader.diags reader let add_diag lp d = { lp with diags = DIAGS.Set.cons d lp.diags } let add_diags lp d = { lp with diags = DIAGS.Set.union d lp.diags } @@ -110,7 +112,7 @@ let preprocessor input = function buff = []; reader = Src_reader.from input ?source_format; ppstate = Preproc_state.initial; - pplog = Preproc_trace.empty; + pplog = Trace.empty; diags = DIAGS.Set.none; persist = { @@ -182,8 +184,8 @@ let rec next_chunk ({ reader; buff; persist = { dialect; _ }; _ } as lp) = and apply_compiler_directive ({ reader; pplog; _ } as lp) { payload = compdir; loc } = - let lp = with_pplog lp @@ Preproc_trace.new_compdir ~loc ~compdir pplog in - match (compdir : Preproc_directives.compiler_directive) with + let lp = with_pplog lp @@ Trace.new_compdir ~loc ~compdir pplog in + match (compdir : Directives.compiler_directive) with | CDirSource sf -> (match Src_reader.with_source_format sf reader with | Ok reader -> with_reader lp reader @@ -285,7 +287,7 @@ and do_replace lp rev_prefix repl suffix = replacing phrase. *) apply_active_replacing_full lp @@ List.rev rev_prefix in - let lp = with_pplog lp @@ Preproc_trace.new_replace ~loc pplog in + let lp = with_pplog lp @@ Trace.new_replace ~loc pplog in let lp = match repl, lp.persist.replacing with | CDirReplace { replacing = repl; _ }, ([] as replacing) | CDirReplace { replacing = repl; also = false }, replacing -> @@ -310,7 +312,7 @@ and read_lib ({ persist = { libpath; copybooks; verbose; _ }; _ } as lp) (* TODO: `note addendum *) [], DIAGS.Acc.error lp.diags ~loc "@[Cyclic@ COPY@ of@ `%s'@]" filename, - Preproc_trace.cyclic_copy ~loc ~filename lp.pplog + Trace.cyclic_copy ~loc ~filename lp.pplog | Ok filename -> if verbose then Pretty.error "Reading library `%s'@." filename; @@ -321,12 +323,12 @@ and read_lib ({ persist = { libpath; copybooks; verbose; _ }; _ } as lp) ~postproc:(Cobol_common.Srcloc.copy_from ~filename ~copyloc:loc) end in - text, lp.diags, Preproc_trace.copy_done ~loc ~filename lp.pplog + text, lp.diags, Trace.copy_done ~loc ~filename lp.pplog | Error lnf -> [], DIAGS.Acc.error lp.diags ~loc "%a" Cobol_common.Copybook.pp_lookup_error lnf, - Preproc_trace.missing_copy ~loc ~info:lnf lp.pplog + Trace.missing_copy ~loc ~info:lnf lp.pplog in text, with_diags_n_pplog lp diags pplog @@ -401,7 +403,7 @@ let reset_preprocessor_for_string string ?new_position pp = (* --- *) -let preprocessor ?(options = Preproc_options.default) input = +let preprocessor ?(options = Options.default) input = preprocessor input (`WithOptions options) (** Default pretty-printing formatter for {!lex_file}, {!lex_lib}, and diff --git a/src/lsp/cobol_preproc/preproc_engine.mli b/src/lsp/cobol_preproc/preprocess.mli similarity index 92% rename from src/lsp/cobol_preproc/preproc_engine.mli rename to src/lsp/cobol_preproc/preprocess.mli index 830ba1585..4058dc5a8 100644 --- a/src/lsp/cobol_preproc/preproc_engine.mli +++ b/src/lsp/cobol_preproc/preprocess.mli @@ -14,9 +14,10 @@ open Cobol_common.Srcloc.TYPES type preprocessor +type t = preprocessor val preprocessor - : ?options: Preproc_options.preproc_options + : ?options: Options.preproc_options -> Src_input.t -> preprocessor val reset_preprocessor_for_string @@ -33,7 +34,7 @@ val add_diags: preprocessor -> Cobol_common.Diagnostics.Set.t -> preprocessor val position: preprocessor -> Lexing.position val position_at: line:int -> char: int -> preprocessor -> Lexing.position val source_format: preprocessor -> Src_format.any -val rev_log: preprocessor -> Preproc_trace.log +val rev_log: preprocessor -> Trace.log val rev_comments: preprocessor -> Text.comments val rev_ignored: preprocessor -> lexloc list @@ -88,30 +89,30 @@ val fold_source_lines -> ?on_initial_source_format: (Src_format.any -> 'a -> 'a) -> ?skip_compiler_directives_text: bool -> ?on_compiler_directive - : (int -> Preproc_directives.compiler_directive with_loc -> 'a -> 'a) + : (int -> Directives.compiler_directive with_loc -> 'a -> 'a) -> f:(int -> Text.text -> 'a -> 'a) -> Src_input.t -> 'a -> 'a Cobol_common.Diagnostics.with_diags val preprocess_input - : ?options: Preproc_options.preproc_options + : ?options: Options.preproc_options -> ?ppf:Format.formatter -> Src_input.t -> unit Cobol_common.Diagnostics.with_diags val preprocess_file - : ?options: Preproc_options.preproc_options + : ?options: Options.preproc_options -> ?ppf:Format.formatter -> string -> unit Cobol_common.Diagnostics.with_diags val text_of_file - : ?options: Preproc_options.preproc_options + : ?options: Options.preproc_options -> string -> Text.t Cobol_common.Diagnostics.with_diags val text_of_input - : ?options: Preproc_options.preproc_options + : ?options: Options.preproc_options -> Src_input.t -> Text.t Cobol_common.Diagnostics.with_diags diff --git a/src/lsp/cobol_preproc/src_reader.ml b/src/lsp/cobol_preproc/src_reader.ml index b50d5e1ad..1e6bdd511 100644 --- a/src/lsp/cobol_preproc/src_reader.ml +++ b/src/lsp/cobol_preproc/src_reader.ml @@ -83,7 +83,7 @@ let decode_compiler_directive ~dialect compdir_text = let start_pos = Cobol_common.Srcloc.start_pos loc in let parser = Compdir_grammar.Incremental.compiler_directive start_pos in let raw_loc = Cobol_common.Srcloc.raw in - let open Preproc_directives in + let open Directives in match Compdir_grammar.MenhirInterpreter.loop supplier parser with | Source_format_is_free lexloc -> let sf = Src_format.from_config Cobol_config.Types.SFFree in @@ -92,11 +92,11 @@ let decode_compiler_directive ~dialect compdir_text = | Set_sourceformat (format, lexloc) -> (match Src_format.decypher ~dialect format with | Ok sf -> - Ok (Preproc_directives.CDirSource (sf &@ raw_loc lexloc) &@ loc) + Ok (Directives.CDirSource (sf &@ raw_loc lexloc) &@ loc) | Error (`SFUnknown f) -> Error (Unknown_source_format (f, raw_loc lexloc))) | Set (string, lexloc) -> - Ok (Preproc_directives.CDirSet (string &@ raw_loc lexloc) &@ loc) + Ok (Directives.CDirSet (string &@ raw_loc lexloc) &@ loc) | exception Compdir_grammar.Error -> Error (Malformed_or_unknown_compiler_directive loc) diff --git a/src/lsp/cobol_preproc/src_reader.mli b/src/lsp/cobol_preproc/src_reader.mli index c09fa09f7..3ae86a2a5 100644 --- a/src/lsp/cobol_preproc/src_reader.mli +++ b/src/lsp/cobol_preproc/src_reader.mli @@ -36,7 +36,7 @@ val fold_lines : dialect: Cobol_config.Types.dialect -> ?skip_compiler_directives_text: bool -> ?on_compiler_directive - : (int -> Preproc_directives.compiler_directive with_loc -> 'a -> 'a) + : (int -> Directives.compiler_directive with_loc -> 'a -> 'a) -> f:(int -> Text.t -> 'a -> 'a) -> t -> 'a -> 'a @@ -47,7 +47,7 @@ val print_lines val try_compiler_directive : dialect: Cobol_config.Types.dialect -> Text.t - -> ((Text.t * Preproc_directives.compiler_directive with_loc * Text.t) option, + -> ((Text.t * Directives.compiler_directive with_loc * Text.t) option, Text.t * Preproc_diagnostics.error * Text.t) result (** {1 Change of source format} *) diff --git a/src/lsp/cobol_preproc/text_processor.ml b/src/lsp/cobol_preproc/text_processor.ml index a8735a103..e6e9774f5 100644 --- a/src/lsp/cobol_preproc/text_processor.ml +++ b/src/lsp/cobol_preproc/text_processor.ml @@ -15,8 +15,8 @@ open Cobol_common.Srcloc.TYPES open Cobol_common.Srcloc.INFIX open Cobol_common.Diagnostics.TYPES open Text.TYPES -open Preproc_directives (* import types of directives *) -open Preproc_trace (* import types of log events *) +open Directives (* import types of directives *) +open Trace (* import types of log events *) module DIAGS = Cobol_common.Diagnostics @@ -378,11 +378,11 @@ let apply_replacing k repl log = fun k done_text log text -> match k, try_replacing_phrase k repl text, text with | OnPartText, Ok (done_text', le, []), _ -> - Ok (done_text @ done_text', Preproc_trace.append le log) + Ok (done_text @ done_text', Trace.append le log) | OnFullText, Ok (done_text', le, []), _ -> - done_text @ done_text', Preproc_trace.append le log + done_text @ done_text', Trace.append le log | _, Ok (done_text', le, text), _ -> - aux k (done_text @ done_text') (Preproc_trace.append le log) text + aux k (done_text @ done_text') (Trace.append le log) text | OnPartText, Error `MissingText, _ -> Error (`MissingText (done_text, log, text)) | OnPartText, Error `NoReplacement, [] -> diff --git a/src/lsp/cobol_preproc/text_processor.mli b/src/lsp/cobol_preproc/text_processor.mli index 6b76befb7..e113a523e 100644 --- a/src/lsp/cobol_preproc/text_processor.mli +++ b/src/lsp/cobol_preproc/text_processor.mli @@ -20,23 +20,23 @@ open Text.TYPES (** {1 Compiler directives} *) val replacing - : ?partial: Preproc_directives.partial_replacing + : ?partial: Directives.partial_replacing -> pseudotext with_loc -> pseudotext with_loc - -> Preproc_directives.replacing option with_diags + -> Directives.replacing option with_diags type (_, _) repl_attempt = | OnPartText: ([`NoReplacement | `MissingText], partial_text_repl_result) repl_attempt | OnFullText: ([`NoReplacement], - text * Preproc_trace.log) repl_attempt + text * Trace.log) repl_attempt and partial_text_repl_result = - (text * Preproc_trace.log, - [`MissingText of text * Preproc_trace.log * text]) result + (text * Trace.log, + [`MissingText of text * Trace.log * text]) result val apply_replacing : (_, 'a) repl_attempt - -> Preproc_directives.replacing with_loc list - -> Preproc_trace.log + -> Directives.replacing with_loc list + -> Trace.log -> text -> 'a @@ -45,9 +45,9 @@ val apply_replacing module type ENTRY_POINTS = sig type 'x entry val replace_statement - : Preproc_directives.replace_statement with_diags with_loc entry + : Directives.replace_statement with_diags with_loc entry val copy_statement - : Preproc_directives.copy_statement with_diags with_loc entry + : Directives.copy_statement with_diags with_loc entry end module type PPPARSER = sig diff --git a/src/lsp/cobol_preproc/preproc_trace.ml b/src/lsp/cobol_preproc/trace.ml similarity index 97% rename from src/lsp/cobol_preproc/preproc_trace.ml rename to src/lsp/cobol_preproc/trace.ml index c4722d8cf..2bf51207e 100644 --- a/src/lsp/cobol_preproc/preproc_trace.ml +++ b/src/lsp/cobol_preproc/trace.ml @@ -31,7 +31,7 @@ module TYPES = struct } | CompilerDirective of { - compdir: Preproc_directives.compiler_directive; + compdir: Directives.compiler_directive; loc: srcloc; } diff --git a/src/lsp/cobol_preproc/preproc_trace.mli b/src/lsp/cobol_preproc/trace.mli similarity index 94% rename from src/lsp/cobol_preproc/preproc_trace.mli rename to src/lsp/cobol_preproc/trace.mli index 3167a2a44..e48cf9b1a 100644 --- a/src/lsp/cobol_preproc/preproc_trace.mli +++ b/src/lsp/cobol_preproc/trace.mli @@ -26,7 +26,7 @@ module TYPES: sig } | CompilerDirective of { - compdir: Preproc_directives.compiler_directive; + compdir: Directives.compiler_directive; loc: Cobol_common.Srcloc.t; } @@ -49,7 +49,7 @@ val append -> log -> log val new_compdir : loc: Cobol_common.Srcloc.t - -> compdir:Preproc_directives.compiler_directive + -> compdir:Directives.compiler_directive -> log -> log val copy_done : loc: Cobol_common.Srcloc.t diff --git a/src/lsp/superbol_free_lib/command_pp.ml b/src/lsp/superbol_free_lib/command_pp.ml index 0880e1081..f993bf817 100644 --- a/src/lsp/superbol_free_lib/command_pp.ml +++ b/src/lsp/superbol_free_lib/command_pp.ml @@ -63,10 +63,10 @@ let cmd = ~default: common.preproc_options.source_format } in input |> - Cobol_preproc.preprocessor ~options:preproc_options |> + Cobol_preproc.Preprocess.preprocessor ~options:preproc_options |> Cobol_parser.parse_simple ~options:common.parser_options in - let my_text = Cobol_preproc.Input.from ~filename:file ~f:parse in + let my_text = Cobol_preproc.Src_input.from ~filename:file ~f:parse in Format.eprintf "%a@." Cobol_common.Diagnostics.Set.pp my_text.diags; match my_text.result with | Only (Some cg) -> ( @@ -96,7 +96,7 @@ let cmd = let text = let common = common_get () in Cobol_common.Diagnostics.show_n_forget @@ - Cobol_preproc.text_of_file file + Cobol_preproc.Preprocess.text_of_file file ~options:common.preproc_options in let s = diff --git a/test/cobol_parsing/parser_testing.ml b/test/cobol_parsing/parser_testing.ml index 256e1f967..049e7a3b1 100644 --- a/test/cobol_parsing/parser_testing.ml +++ b/test/cobol_parsing/parser_testing.ml @@ -21,7 +21,7 @@ let preproc = Cobol_common.Srcloc.TESTING.register_file_contents ~filename contents; String { filename; contents } |> - Cobol_preproc.preprocessor + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with libpath = []; @@ -149,7 +149,7 @@ let rewindable_parse = let DIAGS.{ result = Only ptree, rewinder; diags } = String { filename = "prog.cob"; contents = prog } |> - Cobol_preproc.preprocessor + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ verbose; libpath = []; source_format; config = Option.value config ~default:default.config; @@ -198,7 +198,7 @@ let iteratively_append_chunks ?config ~f (prog, positions) = Pretty.(to_string "%S" @@ EzString.after prog (pos.cnum - 1)); succ i, rewind_n_parse ~f:(f i num_chunks) rewinder pos - (Cobol_preproc.reset_preprocessor_for_string prog) + (Cobol_preproc.Preprocess.reset_preprocessor_for_string prog) end (1, rewinder) (pairwise positions.pos_anonymous) @@ -230,7 +230,7 @@ let iteratively_append_chunks_stuttering ?config ~f Pretty.(to_string "%S" @@ EzString.after prog (pos.cnum - 1)); let rewinder = rewind_n_parse ~f:(f i num_chunks) rewinder pos - (Cobol_preproc.reset_preprocessor_for_string prog) + (Cobol_preproc.Preprocess.reset_preprocessor_for_string prog) in let rewinder = if i < num_chunks then begin @@ -241,7 +241,7 @@ let iteratively_append_chunks_stuttering ?config ~f Fmt.(truncated ~max:30) Pretty.(to_string "%S" @@ EzString.after prog' (pos.cnum - 1)); rewind_n_parse ~f:(f i num_chunks) rewinder next_pos_1 - (Cobol_preproc.reset_preprocessor_for_string prog') + (Cobol_preproc.Preprocess.reset_preprocessor_for_string prog') end else rewinder in succ i, rewinder @@ -280,13 +280,13 @@ let simulate_cut_n_paste ?config ~f0 ~f ?verbose ?(repeat = 1) and prog_suffix = EzString.after prog (next_pos.cnum - 1) in let rewinder = rewind_n_parse ~f:(fun _ _ -> ()) rewinder pos @@ - Cobol_preproc.reset_preprocessor_for_string @@ + Cobol_preproc.Preprocess.reset_preprocessor_for_string @@ prog_prefix ^ prog_suffix in Pretty.out "Putting it back@."; let rewinder = rewind_n_parse ~f:(f chunk_num num_chunks ~ptree0) rewinder pos @@ - Cobol_preproc.reset_preprocessor_for_string prog + Cobol_preproc.Preprocess.reset_preprocessor_for_string prog in loop (succ i) rewinder end diff --git a/test/cobol_preprocessing/preproc_testing.ml b/test/cobol_preprocessing/preproc_testing.ml index 40d2f56e2..48eaafd54 100644 --- a/test/cobol_preprocessing/preproc_testing.ml +++ b/test/cobol_preprocessing/preproc_testing.ml @@ -24,10 +24,10 @@ let preprocess ?(source_format = Cobol_config.Types.(SF SFFixed)) contents = DIAGS.show_n_forget ~ppf:Fmt.stdout @@ - Cobol_preproc.preprocess_input + Cobol_preproc.Preprocess.preprocess_input ~options:Cobol_preproc.Options.{ default with verbose; libpath = []; source_format } @@ - Cobol_preproc.String { filename; contents } + Cobol_preproc.Src_input.String { filename; contents } let show_text ?(verbose = false) @@ -36,10 +36,10 @@ let show_text contents = let text = DIAGS.show_n_forget ~ppf:Fmt.stdout @@ - Cobol_preproc.text_of_input + Cobol_preproc.Preprocess.text_of_input ~options:Cobol_preproc.Options.{ default with verbose; libpath = []; source_format } @@ - Cobol_preproc.String { filename; contents } + Cobol_preproc.Src_input.String { filename; contents } in Pretty.out "%a@\n" (Cobol_preproc.Text.pp_text' ~fsep:"@\n") text @@ -53,7 +53,7 @@ let show_source_lines contents = DIAGS.show_n_forget ~ppf:Fmt.stdout @@ - Cobol_preproc.fold_source_lines ~dialect ~source_format + Cobol_preproc.Preprocess.fold_source_lines ~dialect ~source_format ~f:begin fun lnum line () -> if with_line_numbers then Pretty.out "@\n%u: " lnum else Pretty.out "@\n"; Pretty.out "%a" Cobol_preproc.Text.pp_text line; @@ -71,13 +71,14 @@ let show_source_lines end let rec show_all_text pp = - match Cobol_preproc.next_chunk pp with + match Cobol_preproc.Preprocess.next_chunk pp with | { payload = Cobol_preproc.Text.Eof; _ } :: _, _ -> - Cobol_common.Diagnostics.Set.pp Fmt.stdout (Cobol_preproc.diags pp); - pp + Cobol_common.Diagnostics.Set.pp Fmt.stdout + (Cobol_preproc.Preprocess.diags pp); + pp | text, pp -> - Pretty.out "%a@\n" Cobol_preproc.Text.pp_text text; - show_all_text pp + Pretty.out "%a@\n" Cobol_preproc.Text.pp_text text; + show_all_text pp let show_lines ppf lines = Pretty.list ~fopen:"@[<v>" ~fsep:"@\n" ~fclose:"@]" (Fmt.fmt "%S") @@ -96,13 +97,13 @@ let preprocess_n_then_cut_n_paste_right_of_indicator let free_format_contents = String.concat "\n" free_lines in Pretty.out "fixed: %a@." show_lines fixed_lines; Pretty.out " free: %a@." show_lines free_lines; - Cobol_preproc.Input.string ~filename fixed_format_contents |> - Cobol_preproc.preprocessor + Cobol_preproc.Src_input.string ~filename fixed_format_contents |> + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with verbose; libpath = []; source_format } |> show_all_text |> - Cobol_preproc.reset_preprocessor_for_string free_format_contents |> + Cobol_preproc.Preprocess.reset_preprocessor_for_string free_format_contents |> show_all_text |> - Cobol_preproc.reset_preprocessor_for_string fixed_format_contents |> + Cobol_preproc.Preprocess.reset_preprocessor_for_string fixed_format_contents |> show_all_text |> ignore diff --git a/test/output-tests/gnucobol.ml b/test/output-tests/gnucobol.ml index 02ededab2..673588e2c 100644 --- a/test/output-tests/gnucobol.ml +++ b/test/output-tests/gnucobol.ml @@ -133,7 +133,7 @@ let setup_input ~filename contents = let oc = open_out filename in output_string oc contents; close_out oc; - Cobol_preproc.String { contents; filename } + Cobol_preproc.Src_input.String { contents; filename } let delete_file ~filename = Ez_file.FileString.remove filename @@ -190,7 +190,7 @@ let do_check_parse (test_filename, contents, _, { check_loc; let source_format = guess_source_format ~filename ~command:check_command in let parse_simple input = input |> - Cobol_preproc.preprocessor + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with source_format } |> Cobol_parser.parse_simple in diff --git a/test/output-tests/preproc.ml b/test/output-tests/preproc.ml index deae014e9..960476584 100644 --- a/test/output-tests/preproc.ml +++ b/test/output-tests/preproc.ml @@ -18,7 +18,7 @@ open Testsuite_utils let preprocess_file ~source_format ~config filename = Cobol_common.Diagnostics.show_n_forget ~min_level:Error @@ - Cobol_preproc.preprocess_file filename + Cobol_preproc.Preprocess.preprocess_file filename ~options:Cobol_preproc.Options.{ source_format; config; verbose = false; libpath = [] } ~ppf:std_formatter diff --git a/test/output-tests/reparse.ml b/test/output-tests/reparse.ml index fec2a6640..4e9afe147 100644 --- a/test/output-tests/reparse.ml +++ b/test/output-tests/reparse.ml @@ -23,7 +23,7 @@ let reparse_file ~source_format ~config filename = default with recovery = DisableRecovery } @@ - Cobol_preproc.preprocessor + Cobol_preproc.Preprocess.preprocessor ~options:Cobol_preproc.Options.{ default with libpath = []; @@ -35,7 +35,7 @@ let reparse_file ~source_format ~config filename = let print = Format.asprintf "@[%a@]@." Cobol_ptree.pp_compilation_group in - match Cobol_preproc.Input.from ~filename ~f:(parse ~source_format) with + match Cobol_preproc.Src_input.from ~filename ~f:(parse ~source_format) with | { result = Only Some cg; _ } -> ( Format.printf "Parse: OK. "; let contents = print cg in