From feaff872670ec50d76177be9eb7424f2f7ba29bb Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Fri, 15 Sep 2023 16:50:39 +0200 Subject: [PATCH] Strip down `Cobol_common.Basics`, often replaceable by `EzCompat` --- src/lsp/cobol_common/basics.ml | 106 +++----------------- src/lsp/cobol_config/cobol_config.ml | 2 +- src/lsp/cobol_config/default.ml | 2 +- src/lsp/cobol_config/from_file.ml | 3 +- src/lsp/cobol_config/from_file.mli | 2 +- src/lsp/cobol_config/reserved_words.ml | 2 +- src/lsp/cobol_config/types.ml | 7 +- src/lsp/cobol_config/words.ml | 2 +- src/lsp/cobol_data/env.ml | 8 +- src/lsp/cobol_indent/indent_check.ml | 3 +- src/lsp/cobol_lsp/lsp_completion.ml | 6 +- src/lsp/cobol_parser/text_lexer.ml | 6 +- src/lsp/cobol_typeck/cobol_typeck.ml | 8 +- src/lsp/cobol_typeck/cobol_typeck.mli | 1 - test/config_parsing/test_gnucobol_config.ml | 4 +- 15 files changed, 41 insertions(+), 121 deletions(-) diff --git a/src/lsp/cobol_common/basics.ml b/src/lsp/cobol_common/basics.ml index 2956fa5ce..d5eb6f622 100644 --- a/src/lsp/cobol_common/basics.ml +++ b/src/lsp/cobol_common/basics.ml @@ -11,64 +11,22 @@ (* *) (**************************************************************************) -open EzCompat (* for StringMap and Stringset *) - -(* CHECKE: Is it worth having this long name in addition to StrMap *) -module StringMap = StringMap -module StringSet = StringSet -module Strings = StringSet (** alias of {!StringSet} *) -module StrMap = StringMap (** alias of {!StringMap} *) -module IntMap = Map.Make (Int) +(* module IntMap = Map.Make (Int) *) module CharSet = Set.Make (Char) -module Pair = struct - - let with_fst l r = (l, r) - let with_snd r l = (l, r) - - let map_fst ~f (l, r) = (f l, r) - let map_snd ~f (l, r) = (l, f r) - - (** [filter_fst (Some l, r) = Some (l, r) ] and [filter_fst (None, _) = None] *) - let if_fst (l, r) = Option.map (fun l -> l, r) l - - (** [filter_snd (l, Some r) = Some (l, r)] and [filter_snd (_, None) = None] *) - let if_snd (l, r) = Option.map (fun r -> l, r) r - - let filter = function - | Some l, Some r -> Some (l, r) - | _ -> None - - let filter_map_fst ~f (l, r) = Option.map (fun l -> f l, r) l - - let filter_snd_map_pair ~f (l, r) = Option.map (fun r -> f (l, r) ) r - - let filter_map_snd ~f (l, r) = Option.map (fun r -> l, f r) r - - let filter_map ~fl ~fr = function - | Some l, Some r -> Some (fl l, fr r) - | _ -> None - - let swap (f, s) = (s, f) -end - (* Fabrice: we should upstream such functions in ocplib-stuff, within the EzList module *) module LIST = struct + (** [split_at_first ~prefix ~where p list] splits [list] right after, right before, or around the first element [e] that satisfies [p e]. [prefix] indicates whether or not to keep the prefix in revered order, and [where] instructs where to split ([`Around] discards the element). *) - let split_at_first + let split_at_first p ~(prefix: [`Same | `Rev]) - ~(where: [`After | `Before | `Around]) - p - = - let prefix = match prefix with - | `Same -> List.rev - | `Rev -> fun l -> l - in + ~(where: [`After | `Before | `Around]) = + let prefix = match prefix with `Same -> List.rev | `Rev -> Fun.id in let rec aux acc l = match l, where with | [], _ -> Error () | x :: tl, _ when not (p x) -> aux (x :: acc) tl @@ -78,53 +36,13 @@ module LIST = struct in aux [] - (** [take_while pred l] returns all the successive elements of [l] while [pred elt] is - is satisfied, [elt] being the first element of the remaining of the list. *) - let take_while pred list = - let rec aux acc l = - match l with - | hd::tl when pred hd -> - aux (hd::acc) tl - | _ -> - List.rev acc - in - aux [] list - - (*TODO: Remove this and edit its occurences with List.fold_left_map *) - let foldmap ~f (l, acc) = - let l, acc = List.fold_left - (fun (l, acc) x -> let x, acc = f acc x in x::l, acc) ([], acc) l - in - List.rev l, acc - - - (** [fold_left_while pred f acc l] is (f (... (f acc l1) ...) ln) with [l1] [ln] the elements of - [l] for which [pred acc] is satisfied. *) - let rec fold_left_while pred f acc l = - match l with - | [] -> acc - | hd::tl when pred acc -> fold_left_while pred f (f acc hd) tl - | _ -> acc - - (** [fold_left_whilei pred f acc l] is (f n (... (f 0 acc l0) ...) ln) with [l0] [ln] the elements of - [l] for which [pred acc] is satisfied. *) - let fold_left_whilei pred f acc l = - let rec aux idx pred f acc l = - match l with - | [] -> acc - | hd::tl when pred acc -> aux (idx + 1) pred f (f idx acc hd) tl + (** [fold_left_while pred f acc l] is (f (... (f acc l1) ...) ln) with [l1] + [ln] the elements of [l] for which [pred acc] is satisfied. *) + let fold_left_while pred f acc l = + let rec aux acc = function + | hd :: tl when pred acc -> aux (f acc hd) tl | _ -> acc in - aux 0 pred f acc l -end + aux acc l -(** This operator maps a ['a option * 'b] to the function [f]. The function [f] must be of type - ['b -> 'a -> 'c * 'b]. [(x, acc) >>= f] returns [None, acc] if [x = None] or [(Some x', acc')] - if [x = Some y] with [x', acc' = f acc y]. *) -let (>>=) (x, acc) f = - Option.fold ~none:(None, acc) ~some:(fun x -> let x, acc = f acc x in Some x, acc) x - - -(*CHECKME: Is there an already defined operator for this? If not maybe we can keep these - * somewhere else, it might be useful in more than one places, or maybe it's too confusing. *) -let (>>) f g = (fun x -> f x |> g) +end diff --git a/src/lsp/cobol_config/cobol_config.ml b/src/lsp/cobol_config/cobol_config.ml index 2b821ca70..bdd1aac0b 100644 --- a/src/lsp/cobol_config/cobol_config.ml +++ b/src/lsp/cobol_config/cobol_config.ml @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Cobol_common.Basics +open EzCompat include Types diff --git a/src/lsp/cobol_config/default.ml b/src/lsp/cobol_config/default.ml index 627f394ca..ebb7a9122 100644 --- a/src/lsp/cobol_config/default.ml +++ b/src/lsp/cobol_config/default.ml @@ -12,7 +12,7 @@ (**************************************************************************) (** Module containing all the default options *) -open Cobol_common.Basics +open EzCompat let not_reserved = ["TERMINAL"; "EXAMINE"] diff --git a/src/lsp/cobol_config/from_file.ml b/src/lsp/cobol_config/from_file.ml index 45175a09d..ce5ca457d 100644 --- a/src/lsp/cobol_config/from_file.ml +++ b/src/lsp/cobol_config/from_file.ml @@ -13,7 +13,8 @@ open Types open Options -open Cobol_common.Basics + +open EzCompat module Make (Diags: Cobol_common.Diagnostics.STATEFUL) diff --git a/src/lsp/cobol_config/from_file.mli b/src/lsp/cobol_config/from_file.mli index 1a8660b43..9775e325e 100644 --- a/src/lsp/cobol_config/from_file.mli +++ b/src/lsp/cobol_config/from_file.mli @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Cobol_common.Basics +open EzCompat (** This functor is used to build a config ({! Types.T}) module from a file *) module Make diff --git a/src/lsp/cobol_config/reserved_words.ml b/src/lsp/cobol_config/reserved_words.ml index d20cc3f1e..11a489b14 100644 --- a/src/lsp/cobol_config/reserved_words.ml +++ b/src/lsp/cobol_config/reserved_words.ml @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Cobol_common.Basics +open EzCompat (* Please, use `Word` module to access these words *) diff --git a/src/lsp/cobol_config/types.ml b/src/lsp/cobol_config/types.ml index 92af6a648..7bb8a251c 100644 --- a/src/lsp/cobol_config/types.ml +++ b/src/lsp/cobol_config/types.ml @@ -13,6 +13,7 @@ (** Module containing most of the types definitions used in {!Cobol_config}. *) +open EzCompat open Cobol_common.Diagnostics.TYPES module DIAGS = Cobol_common.Diagnostics @@ -363,9 +364,9 @@ module type COMP_OPTS = sig (* reserved words *) val words: words_spec - val intrinsic_functions: Cobol_common.Basics.StringSet.t - val system_names: Cobol_common.Basics.StringSet.t - val registers: Cobol_common.Basics.StringSet.t + val intrinsic_functions: StringSet.t + val system_names: StringSet.t + val registers: StringSet.t (* int options *) val text_column: int valued_option diff --git a/src/lsp/cobol_config/words.ml b/src/lsp/cobol_config/words.ml index 62cced9ab..17dfafc0a 100644 --- a/src/lsp/cobol_config/words.ml +++ b/src/lsp/cobol_config/words.ml @@ -11,7 +11,7 @@ (* *) (**************************************************************************) -open Cobol_common.Basics +open EzCompat module FATAL = Cobol_common.Diagnostics.Fatal diff --git a/src/lsp/cobol_data/env.ml b/src/lsp/cobol_data/env.ml index b8c27146a..9b1f9c40b 100644 --- a/src/lsp/cobol_data/env.ml +++ b/src/lsp/cobol_data/env.ml @@ -11,12 +11,10 @@ (* *) (**************************************************************************) +open EzCompat open Cobol_ast open Types -module StringSet = Cobol_common.Basics.StringSet -module StringMap = Cobol_common.Basics.StringMap -module CharSet = Cobol_common.Basics.CharSet module FATAL = Cobol_common.Diagnostics.Fatal (*FIXME: Quite a bit of rework for c translation and analysis alike *) @@ -81,7 +79,7 @@ module PROG_ENV = struct { name: name; parent_prog: t option; data_items: DATA_ITEM.t Qualmap.t; - currency_signs: CharSet.t; + currency_signs: Cobol_common.Basics.CharSet.t; decimal_point: char; using_items: NameSet.t; } @@ -91,7 +89,7 @@ module PROG_ENV = struct { name = name; parent_prog = None; data_items = Qualmap.empty; - currency_signs = CharSet.empty; + currency_signs = Cobol_common.Basics.CharSet.empty; decimal_point = '.'; using_items = NameSet.empty } | Some parent -> diff --git a/src/lsp/cobol_indent/indent_check.ml b/src/lsp/cobol_indent/indent_check.ml index b16877590..f93788a5b 100644 --- a/src/lsp/cobol_indent/indent_check.ml +++ b/src/lsp/cobol_indent/indent_check.ml @@ -11,8 +11,9 @@ (* *) (**************************************************************************) +open EzCompat + open Cobol_common.Srcloc -open Cobol_common.Basics open Indent_type open Indent_keywords diff --git a/src/lsp/cobol_lsp/lsp_completion.ml b/src/lsp/cobol_lsp/lsp_completion.ml index 29794d137..d2f79b2e6 100644 --- a/src/lsp/cobol_lsp/lsp_completion.ml +++ b/src/lsp/cobol_lsp/lsp_completion.ml @@ -11,9 +11,9 @@ (* *) (**************************************************************************) -open Cobol_common -open Cobol_common.Basics -(* open Cobol_common.Srcloc.TYPES *) +open EzCompat + +open Cobol_common (* Visitor *) open Cobol_common.Srcloc.INFIX open Lsp_completion_keywords diff --git a/src/lsp/cobol_parser/text_lexer.ml b/src/lsp/cobol_parser/text_lexer.ml index ea985050f..dda4e55fc 100644 --- a/src/lsp/cobol_parser/text_lexer.ml +++ b/src/lsp/cobol_parser/text_lexer.ml @@ -11,6 +11,8 @@ (* *) (**************************************************************************) +open EzCompat + open Cobol_common.Srcloc.TYPES open Cobol_common.Srcloc.INFIX @@ -105,12 +107,12 @@ module Make (Words: module type of Text_keywords) = struct Hashtbl.add token_of_keyword kwd token_handle let silenced_keywords = - Cobol_common.Basics.Strings.of_list Words.silenced_keywords + StringSet.of_list Words.silenced_keywords let reserve_words: Cobol_config.words_spec -> unit = let on_token_handle_of kwd descr ~f = try f @@ handle_of_keyword kwd with - | Not_found when Cobol_common.Basics.Strings.mem kwd silenced_keywords -> + | Not_found when StringSet.mem kwd silenced_keywords -> () (* Ignore silently? Warn? *) | Not_found -> Pretty.error "@[Unable@ to@ %s@ keyword:@ %s@]@." descr kwd diff --git a/src/lsp/cobol_typeck/cobol_typeck.ml b/src/lsp/cobol_typeck/cobol_typeck.ml index 87fb24555..1df6a3424 100644 --- a/src/lsp/cobol_typeck/cobol_typeck.ml +++ b/src/lsp/cobol_typeck/cobol_typeck.ml @@ -15,8 +15,8 @@ open Cobol_ast open Cobol_common.Srcloc.INFIX +module CharSet = Cobol_common.Basics.CharSet module DIAGS = Cobol_common.Diagnostics -module StrMap = Cobol_common.Basics.StrMap module Visitor = Cobol_common.Visitor module PTree_visitor = Cobol_parser.PTree_visitor module CU = Cobol_data.Compilation_unit @@ -64,7 +64,7 @@ struct | CurrencySign { picture_symbol = Some (Alphanum s | National s); _ } -> Visitor.skip @@ { env with - currency_signs = Cobol_data.CharSet.add s.[0] env.currency_signs } + currency_signs = CharSet.add s.[0] env.currency_signs } | _ -> (* TODO: other clauses? *) Visitor.proceed env (* may report unfinished visitor warnings *) end in @@ -74,8 +74,8 @@ struct env_div base_env in (* Currency sign defaults to '$' *) - if Cobol_data.CharSet.is_empty env.currency_signs - then { env with currency_signs = Cobol_data.CharSet.singleton '$' } + if CharSet.is_empty env.currency_signs + then { env with currency_signs = CharSet.singleton '$' } else env let try_making_env_of_compilation_unit, diff --git a/src/lsp/cobol_typeck/cobol_typeck.mli b/src/lsp/cobol_typeck/cobol_typeck.mli index b25129591..28780f728 100644 --- a/src/lsp/cobol_typeck/cobol_typeck.mli +++ b/src/lsp/cobol_typeck/cobol_typeck.mli @@ -12,7 +12,6 @@ (**************************************************************************) module DIAGS = Cobol_common.Diagnostics -module StrMap = Cobol_common.Basics.StrMap module Visitor = Cobol_common.Visitor module PTree_visitor = Cobol_parser.PTree_visitor module CUs = Cobol_data.Compilation_unit.SET diff --git a/test/config_parsing/test_gnucobol_config.ml b/test/config_parsing/test_gnucobol_config.ml index e19115f1a..2fc49cb5c 100644 --- a/test/config_parsing/test_gnucobol_config.ml +++ b/test/config_parsing/test_gnucobol_config.ml @@ -11,6 +11,8 @@ (* *) (**************************************************************************) +open EzCompat + let srcdir = try Unix.getenv "DUNE_SOURCEROOT" with Not_found -> ".";; let confdir = Filename.concat srcdir "import/gnucobol/config";; Unix.putenv "COB_CONFIG_DIR" confdir;; @@ -28,8 +30,6 @@ module MF_conf = (val Cobol_config.from_dialect (module Diags) ~strict:true Cobol_config.DIALECT.MicroFocus) -open Cobol_common.Basics - let both_diff s1 s2 = StringSet.union (StringSet.diff s1 s2)