package acgtk

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file utils.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
(**************************************************************************)
(*                                                                        *)
(*                 ACG development toolkit                                *)
(*                                                                        *)
(*                  Copyright 2008-2021 INRIA                             *)
(*                                                                        *)
(*  More information on "http://acg.gforge.inria.fr/"                     *)
(*  License: CeCILL, see the LICENSE file or "http://www.cecill.info"     *)
(*  Authors: see the AUTHORS file                                         *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*  $Rev::                              $:  Revision of last commit       *)
(*  $Author::                           $:  Author of last commit         *)
(*  $Date::                             $:  Date of last commit           *)
(*                                                                        *)
(**************************************************************************)

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 f_set_size formatter = 
  try
    let terminal_width,_= ANSITerminal.size () in
    Format.pp_set_margin formatter terminal_width
  with
  | Failure f  ->
     let regexp = Str.regexp "ANSITerminal.size" in
     if Str.string_match regexp f 0 then
       Format.pp_set_margin formatter (max_int-1)
     else
       raise (Failure f)

let sterm_set_size () = f_set_size Format.str_formatter

let term_set_size () = f_set_size Format.std_formatter

let fterm_set_size formatter = f_set_size formatter

let no_pp () = 
  List.iter
    (fun formatter -> Format.pp_set_margin formatter (max_int-1))
    [Format.std_formatter;Format.str_formatter]
    
let fformat formatter = fun format ->
  Format.fprintf formatter format

let format format = fformat Format.std_formatter format

let sformat format = fformat Format.str_formatter format

let format_of_list fmter sep to_string = function
  | [] -> ()
  | [a] -> fformat fmter "@[%s@]" (to_string a)
  | a::tl ->
    let () = fformat fmter "@[%s@]" (to_string a) in
    List.iter
      (fun s -> fformat fmter "%s@,@[%s@]" sep (to_string s))
      tl

let color c s = ANSITerminal.sprintf [ANSITerminal.Bold;c] "%s" s

let blue s = color ANSITerminal.blue s
let red s = color ANSITerminal.red s
let green s = color ANSITerminal.green s





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



exception No_file of (string * string )

(** [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 =
  let regexp = Str.regexp "\\(^\\./\\)\\|\\(^\\.\\./\\)\\|\\(^/\\)" in
  let check_dirs = not (Str.string_match regexp name 0) in
  let msg = if check_dirs then
    string_of_list " nor in " (fun x -> if x = "" then "current directory" else Printf.sprintf "\"%s\"" x)  dirs
  else
    "current directory"
  in
  let get_name f = 
    if Sys.file_exists f
    then
      if not (Sys.is_directory f) then
	f
      else
	failwith (Printf.sprintf "Failed while trying to trace file '%s': it is a directory" name )
    else
      raise (No_file (f,msg)) in
  let rec rec_find_file = function
    | [] -> raise (No_file (name,msg))
    | dir::dirs ->
       try
	 get_name (Filename.concat dir name)
       with
       | No_file _ -> rec_find_file dirs in
  if check_dirs then
    rec_find_file dirs
  else
    get_name name
      

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

                          (*
let log_iteration log_function s =
  List.iter
    log_function
    (Bolt.Utils.split "\n" s)
                           *)

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 []
OCaml

Innovation. Community. Security.