Strip down Cobol_common.Basics, often replaceable by EzCompat

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

src/lsp/cobol_config/cobol_config.ml

@@ -11,7 +11,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Cobol_common.Basics
+open EzCompat
 
 include Types
 

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"]

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)

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

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 *)
 

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

src/lsp/cobol_config/words.ml

@@ -11,7 +11,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Cobol_common.Basics
+open EzCompat
 
 module FATAL = Cobol_common.Diagnostics.Fatal
 

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 ->

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

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

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

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,

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

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)