Source file utils.ml

(**************************************************************************)
(*                                                                        *)
(*                 ACG development toolkit                                *)
(*                                                                        *)
(*                  Copyright 2008-2024 INRIA                             *)
(*                                                                        *)
(*  More information on "https://acg.loria.fr/"                     *)
(*  License: CeCILL, see the LICENSE file or "http://www.cecill.info"     *)
(*  Authors: see the AUTHORS file                                         *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(**************************************************************************)

module StringSet = Set.Make (String)
module StringMap = Map.Make (String)

module IntMap = Map.Make (struct
  type t = int

  let compare i j = i - j
end)

module IntSet = Set.Make (struct
  type t = int

  let compare i j = i - j
end)

let string_of_list sep to_string = function
  | [] -> ""
  | [ a ] -> to_string a
  | a :: tl ->
      let buf = Buffer.create 16 in
      let () = Buffer.add_string buf (to_string a) in
      let () =
        List.iter
          (fun s ->
            Buffer.add_string buf (Printf.sprintf "%s%s" sep (to_string s)))
          tl
      in
      Buffer.contents buf

let rec intersperse (sep : 'a) : 'a list -> 'a list = function
  | [] -> []
  | [ a_1 ] -> [ a_1 ]
  | a_1 :: a_2 :: tl -> a_1 :: sep :: intersperse sep (a_2 :: tl)

let cycle (n : int) (xs : 'a list) : 'a list =
  let rec cycle_aux n ys acc =
    match (n, ys) with
    | 0, _ -> acc
    | _, [] -> cycle_aux n xs acc
    | _, hd :: tl -> cycle_aux (n - 1) tl (hd :: acc)
  in
  match xs with [] -> [] | _ -> List.rev @@ cycle_aux n xs []

let fold_left1 (f : 'a -> 'a -> 'a) (xs : 'a list) : 'a =
  match xs with
  | [] -> failwith "Empty list passed to fold_left1"
  | head :: tail -> List.fold_left f head tail

let string_of_list_rev sep to_string lst =
  let buf = Buffer.create 16 in
  let rec string_of_list_rev_rec k = function
    | [] -> k ()
    | [ a ] ->
        let () = Buffer.add_string buf (to_string a) in
        k ()
    | a :: tl ->
        string_of_list_rev_rec
          (fun () ->
            let () =
              Buffer.add_string buf (Printf.sprintf "%s%s" sep (to_string a))
            in
            k ())
          tl
  in
  let () = string_of_list_rev_rec (fun () -> ()) lst in
  Buffer.contents buf

module FileErrors_l =
  struct
    type t =
      | FileNotFound of string
      | IsADirectory of string

    let kind = "File"

    let pp fmt  = function
      | FileNotFound f -> Format.fprintf fmt "Can't@ open@ file@ \"%s\"@ (not@ found)" f
      | IsADirectory d -> Format.fprintf fmt "Can't@ open@ file@ \"%s\"@ (it@ is@ a@ directory)" d
  end

module FileErrors = Error.ErrorManager(FileErrors_l)


(** [find_file f dirs msg] tries to find a file with the name [f] in
     the directories listed in [dirs]. If it finds it in [dir], it
     returns the full name [Filename.concat dir f]. To check in the
     current directory, add [""] to the list. It tries in the
     directories of [dirs] in this order and stops when it finds such
     a file. If it can't find any such file, raise the exception
     {!Utils.No_file(f,msg)}. Moreover, if [f] starts with ["/"] or
     ["./"] or ["../"] then it checks wheter [f] exists only in the
     current directory.*)
let find_file name dirs loc =
  let regexp = Str.regexp "\\(^\\./\\)\\|\\(^\\.\\./\\)\\|\\(^/\\)" in
  let check_dirs = not (Str.string_match regexp name 0) in
  let get_name f =
    if Sys.file_exists f then
      if not (Sys.is_directory f) then Some f
      else FileErrors.emit (FileErrors_l.IsADirectory name) ~loc
    else None
  in
  let rec rec_find_file = function
    | [] -> FileErrors.emit (FileErrors_l.FileNotFound name) ~loc
    | dir :: dirs -> (
        match get_name (Filename.concat dir name) with
        | Some f -> f
        | None -> rec_find_file dirs)
  in
  if check_dirs then rec_find_file dirs else 
    match get_name name with
   | Some f -> f
   | None -> FileErrors.emit (FileErrors_l.FileNotFound name) ~loc

let ( >> ) f g x = f (g x)

let decompose ~input ~base =
  let rec decompose_aux i b res =
    let q = i / b in
    let r = i mod b in
    match q with 0 -> r :: res | _ -> decompose_aux q base (r :: res)
  in
  decompose_aux input base []

module type MapToSet = functor (_ : Set.S) -> Map.S