(* Some conventions:
*
- * When I have some _xxx variables before some functions, it's
- * because I want to show that those functions internally use a global
+ * When I have some _xxx variables before some functions, it's
+ * because I want to show that those functions internally use a global
* variable. That does not mean I want people to modify this global.
* In fact they are kind of private, but I still want to show them.
* Maybe one day OCaml will have an effect type system so I don't need this.
- *
- * The variables that are called _init_xxx show the internal init
+ *
+ * The variables that are called _init_xxx show the internal init
* side effect of the module (like static var trick used in C/C++)
- *
+ *
* Why not split the functionnalities of this file in different files ?
- * Because when I write ocaml script I want simply to load one
+ * Because when I write ocaml script I want simply to load one
* file, common.ml, and that's it. Cf common_extra.ml for more on this.
*)
(*****************************************************************************)
(* Flags *)
(*****************************************************************************)
-(* see the corresponding section for the use of those flags. See also
+(* see the corresponding section for the use of those flags. See also
* the "Flags and actions" section at the end of this file.
*)
type prof = PALL | PNONE | PSOME of string list
val profile : prof ref
+val show_trace_profile : bool ref
+
val verbose_level : int ref
(*****************************************************************************)
(* Module side effect *)
(*****************************************************************************)
-(*
+(*
* I define a few unit tests via some let _ = example (... = ...).
* I also initialize the random seed, cf _init_random .
* I also set Gc.stack_size, cf _init_gc_stack .
(*###########################################################################*)
type filename = string
+type dirname = string
(* Trick in case you dont want to do an 'open Common' while still wanting
* more pervasive types than the one in Pervasives. Just do the selective
(*
* Another related trick, found via Jon Harrop to have an extended standard
* lib is to do something like
- *
+ *
* module List = struct
* include List
* val map2 : ...
* end
- *
+ *
* And then can put this "module extension" somewhere to open it.
*)
-(* This module defines the Timeout and UnixExit exceptions.
- * You have to make sure that those exn are not intercepted. So
+(* This module defines the Timeout and UnixExit exceptions.
+ * You have to make sure that those exn are not intercepted. So
* avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up
- * enough. In such case, add a case before such as
- * with Timeout -> raise Timeout | _ -> ...
+ * enough. In such case, add a case before such as
+ * with Timeout -> raise Timeout | _ -> ...
* The same is true for UnixExit (see below).
*)
(* The following functions first indent _tab_level_print spaces.
* They also add the _prefix_pr, for instance used in MPI to show which
* worker is talking.
- *
+ * update: for pr2, it can also print into a log file.
+ *
* The use of 2 in pr2 is because 2 is under UNIX the second descriptor
- * which corresponds to stderr.
+ * which corresponds to stderr.
*)
val _prefix_pr : string ref
+
val pr : string -> unit
-val pr2 : string -> unit
val pr_no_nl : string -> unit
-val pr2_no_nl : string -> unit
val pr_xxxxxxxxxxxxxxxxx : unit -> unit
+
+(* pr2 print on stderr, but can also in addition print into a file *)
+val _chan_pr2: out_channel option ref
+val print_to_stderr : bool ref
+val pr2 : string -> unit
+val pr2_no_nl : string -> unit
val pr2_xxxxxxxxxxxxxxxxx : unit -> unit
(* use Dumper.dump *)
(* see flag: val disable_pr2_once : bool ref *)
val _already_printed : (string, bool) Hashtbl.t
val pr2_once : string -> unit
+val clear_pr2_once : unit -> unit
+val mk_pr2_wrappers: bool ref -> (string -> unit) * (string -> unit)
+
+
+val redirect_stdout_opt : filename option -> (unit -> 'a) -> 'a
val redirect_stdout_stderr : filename -> (unit -> unit) -> unit
-val redirect_stdin : filename -> (unit -> unit) -> unit
-val redirect_stdin_opt : filename option -> (unit -> unit) -> unit
+val redirect_stdin : filename -> (unit -> 'a) -> 'a
+val redirect_stdin_opt : filename option -> (unit -> 'a) -> 'a
+
+val with_pr2_to_string: (unit -> unit) -> string list
val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
val printf : ('a, out_channel, unit) format -> 'a
val spf : ('a, unit, string) format -> 'a
(* default = stderr *)
-val _chan : out_channel ref
+val _chan : out_channel ref
(* generate & use a /tmp/debugml-xxx file *)
-val start_log_file : unit -> unit
+val start_log_file : unit -> unit
(* see flag: val verbose_level : int ref *)
val log : string -> unit
val profile_code : string -> (unit -> 'a) -> 'a
val profile_diagnostic : unit -> string
+val profile_code_exclusif : string -> (unit -> 'a) -> 'a
+val profile_code_inside_exclusif_ok : string -> (unit -> 'a) -> 'a
+
val report_if_take_time : int -> string -> (unit -> 'a) -> 'a
(* similar to profile_code but print some information during execution too *)
val example : bool -> unit
(* generate failwith <string> when pb *)
-val example2 : string -> bool -> unit
+val example2 : string -> bool -> unit
(* use Dumper to report when pb *)
-val assert_equal : 'a -> 'a -> unit
+val assert_equal : 'a -> 'a -> unit
val _list_bool : (string * bool) list ref
val example3 : string -> bool -> unit
val test_all : unit -> unit
+
(* regression testing *)
-type score_result = Ok | Pb of string
-type score = (string (* usually a filename *), score_result) Hashtbl.t
+type score_result = Ok | Pb of string
+type score = (string (* usually a filename *), score_result) Hashtbl.t
+type score_list = (string (* usually a filename *) * score_result) list
val empty_score : unit -> score
-val regression_testing :
+val load_score : string -> unit -> score
+val save_score : score -> string -> unit
+val regression_testing :
score -> filename (* old score file on disk (usually in /tmp) *) -> unit
+val regression_testing_vs: score -> score -> score
+val total_scores : score -> int (* good *) * int (* total *)
val print_score : score -> unit
+val print_total_score: score -> unit
(* quickcheck spirit *)
val laws : string -> ('a -> bool) -> 'a gen -> 'a option
-(* example of use:
+(* example of use:
* let b = laws "unit" (fun x -> reverse [x] = [x]) ig
*)
(* Persistence *)
(*****************************************************************************)
-(* just wrappers around Marshall *)
+(* just wrappers around Marshal *)
val get_value : filename -> 'a
+val read_value : filename -> 'a (* alias *)
val write_value : 'a -> filename -> unit
val write_back : ('a -> 'b) -> filename -> unit
+(* wrappers that also use profile_code *)
+val marshal__to_string: 'a -> Marshal.extern_flags list -> string
+val marshal__from_string: string -> int -> 'a
+
(*****************************************************************************)
(* Counter *)
(*****************************************************************************)
val adjust_pp_with_indent : (unit -> unit) -> unit
val adjust_pp_with_indent_and_header : string -> (unit -> unit) -> unit
+
+val mk_str_func_of_assoc_conv:
+ ('a * string) list -> (string -> 'a) * ('a -> string)
+
(*****************************************************************************)
(* Macro *)
(*****************************************************************************)
(* emacs spirit *)
val save_excursion : 'a ref -> (unit -> 'b) -> 'b
+val save_excursion_and_disable : bool ref -> (unit -> 'b) -> 'b
+val save_excursion_and_enable : bool ref -> (unit -> 'b) -> 'b
(* emacs spirit *)
val unwind_protect : (unit -> 'a) -> (exn -> 'b) -> 'a
val memoized : ('a, 'b) Hashtbl.t -> 'a -> (unit -> 'b) -> 'b
+val cache_in_ref : 'a option ref -> (unit -> 'a) -> 'a
+
(* take file from which computation is done, an extension, and the function
- * and will compute the function only once and then save result in
+ * and will compute the function only once and then save result in
* file ^ extension
*)
-val cache_computation :
- ?verbose:bool -> ?use_cache:bool -> filename -> string (* extension *) ->
+val cache_computation :
+ ?verbose:bool -> ?use_cache:bool -> filename -> string (* extension *) ->
(unit -> 'a) -> 'a
-(* a more robust version where the client describes the dependencies of the
- * computation so it will relaunch the computation in 'f' if needed.
+(* a more robust version where the client describes the dependencies of the
+ * computation so it will relaunch the computation in 'f' if needed.
*)
val cache_computation_robust :
- filename ->
- string (* extension for marshalled object *) ->
- (filename list * 'x) ->
- string (* extension for marshalled dependencies *) ->
- (unit -> 'a) ->
+ filename ->
+ string (* extension for marshalled object *) ->
+ (filename list * 'x) ->
+ string (* extension for marshalled dependencies *) ->
+ (unit -> 'a) ->
'a
-
+
+val cache_computation_robust_in_dir :
+ string option (* destination directory *) -> filename ->
+ string (* extension for marshalled object *) ->
+ (filename list * 'x) ->
+ string (* extension for marshalled dependencies *) ->
+ (unit -> 'a) ->
+ 'a
+
val once : ('a -> unit) -> ('a -> unit)
(*****************************************************************************)
(* how ensure really atomic file creation ? hehe :) *)
-exception FileAlreadyLocked
+exception FileAlreadyLocked
val acquire_file_lock : filename -> unit
val release_file_lock : filename -> unit
exception Here
exception ReturnExn
+exception Multi_found
+
exception WrongFormat of string
val error_cant_have : 'a -> 'b
val exn_to_s : exn -> string
+(* alias *)
+val string_of_exn : exn -> string
+
+type error = Error of string
+
+type evotype = unit
+val evoval : evotype
(*****************************************************************************)
(* Environment *)
val check_stack_size: int -> unit
val check_stack_nbfiles: int -> unit
-
+
(* internally common.ml set Gc. parameters *)
val _init_gc_stack : unit
type cmdline_sections = options_with_title list
-(* A wrapper around Arg modules that have more logical argument order,
+(* A wrapper around Arg modules that have more logical argument order,
* and returns the remaining args.
*)
-val parse_options :
+val parse_options :
cmdline_options -> Arg.usage_msg -> string array -> string list
(* Another wrapper that does Arg.align automatically *)
(* Work with the options_with_title type way to organize a long
* list of command line switches.
*)
-val short_usage :
+val short_usage :
Arg.usage_msg -> short_opt:cmdline_options -> unit
-val long_usage :
- Arg.usage_msg -> short_opt:cmdline_options -> long_opt:cmdline_sections ->
+val long_usage :
+ Arg.usage_msg -> short_opt:cmdline_options -> long_opt:cmdline_sections ->
unit
(* With the options_with_title way, we don't want the default -help and --help
* so need adapter of Arg module, not just wrapper.
*)
val arg_align2 : cmdline_options -> cmdline_options
-val arg_parse2 :
- cmdline_options -> Arg.usage_msg -> (unit -> unit) (* short_usage func *) ->
+val arg_parse2 :
+ cmdline_options -> Arg.usage_msg -> (unit -> unit) (* short_usage func *) ->
string list
(* The action lib. Useful to debug supart of your system. cf some of
* my main.ml for example of use. *)
type flag_spec = Arg.key * Arg.spec * Arg.doc
-type action_spec = Arg.key * Arg.doc * action_func
+type action_spec = Arg.key * Arg.doc * action_func
and action_func = (string list -> unit)
type cmdline_actions = action_spec list
val mk_action_n_arg : (string list -> unit) -> action_func
-val options_of_actions:
+val options_of_actions:
string ref (* the action ref *) -> cmdline_actions -> cmdline_options
-val action_list:
+val action_list:
cmdline_actions -> Arg.key list
-val do_action:
+val do_action:
Arg.key -> string list (* args *) -> cmdline_actions -> unit
(*****************************************************************************)
(* if want to restrict the use of '=', uncomment this:
*
- * val (=): int -> int -> bool
- *
+ * val (=): unit -> unit -> bool
+ *
* But it will not forbid you to use caml functions like List.find, List.mem
* which internaly use this convenient but evolution-unfriendly (=)
*)
-
(*###########################################################################*)
(* And now basic types *)
(*###########################################################################*)
val xor : 'a -> 'a -> bool
+
(*****************************************************************************)
(* Char *)
(*****************************************************************************)
val do_n : int -> (unit -> unit) -> unit
val foldn : ('a -> int -> 'a) -> 'a -> int -> 'a
-val sum_float : float list -> float
-val sum_int : int list -> int
-
val pi : float
val pi2 : float
val pi4 : float
val ( += ) : int ref -> int -> unit
val ( -= ) : int ref -> int -> unit
-val pourcent: int -> int -> int
+val pourcent: int -> int -> int
val pourcent_float: int -> int -> float
val pourcent_float_of_floats: float -> float -> float
+val pourcent_good_bad: int -> int -> int
+val pourcent_good_bad_float: int -> int -> float
+
+type 'a max_with_elem = int ref * 'a ref
+val update_max_with_elem:
+ 'a max_with_elem -> is_better:(int -> int ref -> bool) -> int * 'a -> unit
(*****************************************************************************)
(* Numeric/overloading *)
(*****************************************************************************)
val testd : 'a numdict -> 'a -> 'a
-module ArithFloatInfix : sig
+module ArithFloatInfix : sig
val (+) : float -> float -> float
val (-) : float -> float -> float
val (/) : float -> float -> float
val partition_either :
('a -> ('b, 'c) either) -> 'a list -> 'b list * 'c list
+val partition_either3 :
+ ('a -> ('b, 'c, 'd) either3) -> 'a list -> 'b list * 'c list * 'd list
val filter_some : 'a option list -> 'a list
val map_filter : ('a -> 'b option) -> 'a list -> 'b list
+val tail_map_filter : ('a -> 'b option) -> 'a list -> 'b list
val find_some : ('a -> 'b option) -> 'a list -> 'b
+val list_to_single_or_exn: 'a list -> 'a
+
+(*****************************************************************************)
+(* TriBool *)
+(*****************************************************************************)
+type bool3 = True3 | False3 | TrueFalsePb3 of string
+
+
(*****************************************************************************)
(* Strings *)
(*****************************************************************************)
val ( <!!> ) : string -> int * int -> string
val ( <!> ) : string -> int -> char
+val take_string: int -> string -> string
+val take_string_safe: int -> string -> string
+
val split_on_char : char -> string -> string list
val lowercase : string -> string
val size_mo_ko : int -> string
val size_ko : int -> string
-val edit_distance: string -> string -> int
+val edit_distance: string -> string -> int
+
+val md5sum_of_string : string -> string
(*****************************************************************************)
(* Regexp *)
(*****************************************************************************)
val regexp_alpha : Str.regexp
+val regexp_word : Str.regexp
val _memo_compiled_regexp : (string, Str.regexp) Hashtbl.t
val ( =~ ) : string -> string -> bool
val split_list_regexp : string -> string list -> (string * string list) list
val all_match : string (* regexp *) -> string -> string list
+val global_replace_regexp :
+ string (* regexp *) -> (string -> string) -> string -> string
+
+val regular_words: string -> string list
+val contain_regular_word: string -> bool
(*****************************************************************************)
(* Filenames *)
val dbe_of_filename : filename -> string * string * string
val dbe_of_filename_nodot : filename -> string * string * string
(* Left (d,b,e) | Right (d,b) if file has no extension *)
-val dbe_of_filename_safe :
+val dbe_of_filename_safe :
filename -> (string * string * string, string * string) either
val filename_of_dbe : string * string * string -> filename
val relative_to_absolute : filename -> filename
+val is_relative: filename -> bool
+val is_absolute: filename -> bool
+
val filename_without_leading_path : string -> filename -> filename
(*****************************************************************************)
(* i18n *)
(*****************************************************************************)
-type langage =
+type langage =
| English
| Francais
| Deutsch
(* can also use ocamlcalendar, but heavier, use many modules ... *)
-type month =
+type month =
| Jan | Feb | Mar | Apr | May | Jun
| Jul | Aug | Sep | Oct | Nov | Dec
type year = Year of int
val dmy_to_unixtime: date_dmy -> float_time * Unix.tm
val unixtime_to_dmy: Unix.tm -> date_dmy
val unixtime_to_floattime: Unix.tm -> float_time
+val floattime_to_unixtime: float_time -> Unix.tm
val sec_to_days : int -> string
val sec_to_hours : int -> string
val string_of_unix_time_lfs : Unix.tm -> string
+val is_more_recent : date_dmy -> date_dmy -> bool
+val max_dmy : date_dmy -> date_dmy -> date_dmy
+val min_dmy : date_dmy -> date_dmy -> date_dmy
+val maximum_dmy : date_dmy list -> date_dmy
+val minimum_dmy : date_dmy list -> date_dmy
(*****************************************************************************)
(* Lines/Words/Strings *)
(*****************************************************************************)
val cat : filename -> string list
val cat_orig : filename -> string list
+val cat_array: filename -> string array
+
+val uncat: string list -> filename -> unit
val interpolate : string -> string list
val cmd_to_list_and_status : string -> string list * Unix.process_status
val command2 : string -> unit
+val _batch_mode: bool ref
val command2_y_or_no : string -> bool
+val command2_y_or_no_exit_if_no : string -> unit
val do_in_fork : (unit -> unit) -> int
val readdir_to_dir_size_list : string -> (string * int) list
val glob : string -> filename list
-val files_of_dir_or_files :
+val files_of_dir_or_files :
string (* ext *) -> string list -> filename list
val files_of_dir_or_files_no_vcs :
string (* ext *) -> string list -> filename list
val has_env : string -> bool
(* scheme spirit. do a finalize so no leak. *)
-val with_open_outfile :
+val with_open_outfile :
filename -> ((string -> unit) * out_channel -> 'a) -> 'a
-val with_open_infile :
+val with_open_infile :
filename -> (in_channel -> 'a) -> 'a
-val with_open_outfile_append :
+val with_open_outfile_append :
filename -> ((string -> unit) * out_channel -> 'a) -> 'a
-val with_open_stringbuf :
+val with_open_stringbuf :
(((string -> unit) * Buffer.t) -> unit) -> string
exception Timeout
-(* subtil: have to make sure that Timeout is not intercepted before here. So
+(* subtil: have to make sure that Timeout is not intercepted before here. So
* avoid exn handler such as try (...) with _ -> cos Timeout will not bubble up
- * enough. In such case, add a case before such as
- * with Timeout -> raise Timeout | _ -> ...
- *
+ * enough. In such case, add a case before such as
+ * with Timeout -> raise Timeout | _ -> ...
+ *
* The same is true for UnixExit (see below).
*)
val timeout_function : int -> (unit -> 'a) -> 'a
val timeout_function_opt : int option -> (unit -> 'a) -> 'a
+val remove_file : string -> unit
-(* creation of /tmp files, a la gcc
- * ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c"
+(* creation of /tmp files, a la gcc
+ * ex: new_temp_file "cocci" ".c" will give "/tmp/cocci-3252-434465.c"
*)
val _temp_files_created : string list ref
(* see flag: val save_tmp_files : bool ref *)
val new_temp_file : string (* prefix *) -> string (* suffix *) -> filename
val erase_temp_files : unit -> unit
+val erase_this_temp_file : filename -> unit
(* If the user use some exit 0 in his code, then no one can intercept this
* exit and do something before exiting. There is exn handler for exit 0
* so better never use exit 0 but instead use an exception and just at
* the very toplevel transform this exn in a unix exit code.
- *
+ *
* subtil: same problem than with Timeout. Do not intercept such exception
* with some blind try (...) with _ -> ...
*)
-exception UnixExit of int
+exception UnixExit of int
val exn_to_real_unixexit : (unit -> 'a) -> 'a
(* List *)
(*****************************************************************************)
+
(* tail recursive efficient map (but that also reverse the element!) *)
val map_eff_rev : ('a -> 'b) -> 'a list -> 'b list
(* tail recursive efficient map, use accumulator *)
val span : ('a -> bool) -> 'a list -> 'a list * 'a list
val skip_until : ('a list -> bool) -> 'a list -> 'a list
-val skipfirst : 'a -> 'a list -> 'a list
+val skipfirst : (* Eq a *) 'a -> 'a list -> 'a list
(* cf also List.partition *)
val fpartition : ('a -> 'b option) -> 'a list -> 'b list * 'a list
val groupBy : ('a -> 'a -> bool) -> 'a list -> 'a list list
val exclude_but_keep_attached: ('a -> bool) -> 'a list -> ('a * 'a list) list
+val group_by_post: ('a -> bool) -> 'a list -> ('a list * 'a) list * 'a list
+val group_by_pre: ('a -> bool) -> 'a list -> 'a list * ('a * 'a list) list
+val group_by_mapped_key: ('a -> 'b) -> 'a list -> ('b * 'a list) list
-(* use hash internally to not be in O(n2) *)
+(* Use hash internally to not be in O(n2). If you want to use it on a
+ * simple list, then first do a List.map to generate a key, for instance the
+ * first char of the element, and then use this function.
+ *)
val group_assoc_bykey_eff : ('a * 'b) list -> ('a * 'b list) list
val splitAt : int -> 'a list -> 'a list * 'a list
val fold_left_with_index : ('a -> 'b -> int -> 'a) -> 'a -> 'b list -> 'a
val nth : 'a list -> int -> 'a
-val rang : 'a -> 'a list -> int
+val rang : (* Eq a *) 'a -> 'a list -> int
val last_n : int -> 'a list -> 'a list
val do_withenv :
(('a -> 'b) -> 'c -> 'd) -> ('e -> 'a -> 'b * 'e) -> 'e -> 'c -> 'd * 'e
val map_withenv : ('a -> 'b -> 'c * 'a) -> 'a -> 'b list -> 'c list * 'a
+val map_withkeep: ('a -> 'b) -> 'a list -> ('b * 'a) list
val collect_accu : ('a -> 'b list) -> 'b list -> 'a list -> 'b list
val collect : ('a -> 'b list) -> 'a list -> 'b list
* line. Here we delete any repeated line (here list element).
*)
val uniq : 'a list -> 'a list
+val uniq_eff: 'a list -> 'a list
+
+val has_no_duplicate: 'a list -> bool
+val is_set_as_list: 'a list -> bool
+val get_duplicates: 'a list -> 'a list
+
val doublon : 'a list -> bool
val reverse : 'a list -> 'a list (* alias *)
val min_with : ('a -> 'b) -> 'a list -> 'a
val two_mins_with : ('a -> 'b) -> 'a list -> 'a * 'a
-val all_assoc : 'a -> ('a * 'b) list -> 'b list
+val all_assoc : (* Eq a *) 'a -> ('a * 'b) list -> 'b list
val prepare_want_all_assoc : ('a * 'b) list -> ('a * 'b list) list
val or_list : bool list -> bool
val and_list : bool list -> bool
+val sum_float : float list -> float
+val sum_int : int list -> int
+val avg_list: int list -> float
+
val return_when : ('a -> 'b option) -> 'a list -> 'b
val grep_with_previous : ('a -> 'a -> bool) -> 'a list -> 'a list
val iter_with_previous : ('a -> 'a -> 'b) -> 'a list -> unit
-val iter_with_before_after :
+val iter_with_before_after :
('a list -> 'a -> 'a list -> unit) -> 'a list -> unit
val get_pair : 'a list -> ('a * 'a) list
val keep_best : ('a * 'a -> 'a option) -> 'a list -> 'a list
val sorted_keep_best : ('a -> 'a -> 'a option) -> 'a list -> 'a list
+
val cartesian_product : 'a list -> 'b list -> ('a * 'b) list
(* old stuff *)
(* Arrays *)
(*****************************************************************************)
-val array_find_index : ('a -> bool) -> 'a array -> int
+val array_find_index : (int -> bool) -> 'a array -> int
+val array_find_index_via_elem : ('a -> bool) -> 'a array -> int
+
+(* for better type checking, as sometimes when have an 'int array', can
+ * easily mess up the index from the value.
+ *)
+type idx = Idx of int
+val next_idx: idx -> idx
+val int_of_idx: idx -> int
+
+val array_find_index_typed : (idx -> bool) -> 'a array -> idx
+
+(*****************************************************************************)
+(* Matrix *)
+(*****************************************************************************)
type 'a matrix = 'a array array
val map_matrix : ('a -> 'b) -> 'a matrix -> 'b matrix
+val make_matrix_init:
+ nrow:int -> ncolumn:int -> (int -> int -> 'a) -> 'a matrix
+
+val iter_matrix:
+ (int -> int -> 'a -> unit) -> 'a matrix -> unit
+
+val nb_rows_matrix: 'a matrix -> int
+val nb_columns_matrix: 'a matrix -> int
+
+val rows_of_matrix: 'a matrix -> 'a list list
+val columns_of_matrix: 'a matrix -> 'a list list
+
+val all_elems_matrix_by_row: 'a matrix -> 'a list
+
(*****************************************************************************)
(* Fast array *)
(*****************************************************************************)
val single_set : 'a -> 'a set
val set : 'a list -> 'a set
+val is_set: 'a list -> bool
+
val exists_set : ('a -> bool) -> 'a set -> bool
val forall_set : ('a -> bool) -> 'a set -> bool
val nub : 'a list -> 'a list
-(* use internally a hash and return
- * - the common part,
- * - part only in a,
+(* use internally a hash and return
+ * - the common part,
+ * - part only in a,
* - part only in b
*)
-val diff_two_say_set_eff : 'a list -> 'a list ->
+val diff_two_say_set_eff : 'a list -> 'a list ->
'a list * 'a list * 'a list
(*****************************************************************************)
(* Set as normal list *)
(*****************************************************************************)
-(* cf above *)
+(* cf above *)
(*****************************************************************************)
(* Set as sorted list *)
(* Sets specialized *)
(*****************************************************************************)
-(*
+(*
module StringSet = Set.Make(struct type t = string let compare = compare end)
*)
-
+
(*****************************************************************************)
(* Assoc. But have a look too at Mapb.mli; it's better. Or use Hashtbl. *)
type ('a, 'b) assoc = ('a * 'b) list
-val assoc_to_function : ('a, 'b) assoc -> ('a -> 'b)
+val assoc_to_function : (* Eq a *) ('a, 'b) assoc -> ('a -> 'b)
val empty_assoc : ('a, 'b) assoc
val fold_assoc : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
val lookup_list2 : 'a -> ('a, 'b) assoc list -> 'b * int
val assoc_option : 'a -> ('a, 'b) assoc -> 'b option
+val assoc_with_err_msg : 'a -> ('a, 'b) assoc -> 'b
+
+val sort_by_val_lowfirst: ('a,'b) assoc -> ('a * 'b) list
+val sort_by_val_highfirst: ('a,'b) assoc -> ('a * 'b) list
+
+val sort_by_key_lowfirst: (int,'b) assoc -> (int * 'b) list
+val sort_by_key_highfirst: (int,'b) assoc -> (int * 'b) list
+
+val sortgen_by_key_lowfirst: ('a,'b) assoc -> ('a * 'b) list
+val sortgen_by_key_highfirst: ('a,'b) assoc -> ('a * 'b) list
(*****************************************************************************)
(* Assoc, specialized. *)
(* Note that Hashtbl keep old binding to a key so if want a hash
* of a list, then can use the Hashtbl as is. Use Hashtbl.find_all then
* to get the list of bindings
- *
- * Note that Hashtbl module use different convention :( the object is
+ *
+ * Note that Hashtbl module use different convention :( the object is
* the first argument, not last as for List or Map.
*)
val hfind_default : 'a -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> 'b
val hfind_option : 'a -> ('a, 'b) Hashtbl.t -> 'b option
-val hupdate_default :
+val hupdate_default :
'a -> ('b -> 'b) -> (unit -> 'b) -> ('a, 'b) Hashtbl.t -> unit
val hash_to_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list
val hash_of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t
-val hkeys : ('a, 'b) Hashtbl.t -> 'a list
+val hkeys : ('a, 'b) Hashtbl.t -> 'a list
(*****************************************************************************)
(* Hash sets *)
(*****************************************************************************)
-type 'a hashset = ('a, bool) Hashtbl.t
+type 'a hashset = ('a, bool) Hashtbl.t
(* common use of hashset, in a hash of hash *)
val hash_hashset_add : 'a -> 'b -> ('a, 'b hashset) Hashtbl.t -> unit
-val hashset_to_set :
+val hashset_to_set :
< fromlist : ('a ) list -> 'c; .. > -> ('a, 'b) Hashtbl.t -> 'c
val hashset_to_list : 'a hashset -> 'a list
val top : 'a stack -> 'a
val pop : 'a stack -> 'a stack
+val top_option: 'a stack -> 'a option
+
val push2 : 'a -> 'a stack ref -> unit
val pop2: 'a stack ref -> 'a
+(*****************************************************************************)
+(* Stack with undo/redo support *)
+(*****************************************************************************)
+
+type 'a undo_stack = 'a list * 'a list
+val empty_undo_stack : 'a undo_stack
+val push_undo : 'a -> 'a undo_stack -> 'a undo_stack
+val top_undo : 'a undo_stack -> 'a
+val pop_undo : 'a undo_stack -> 'a undo_stack
+val redo_undo: 'a undo_stack -> 'a undo_stack
+val undo_pop: 'a undo_stack -> 'a undo_stack
+
+val top_undo_option: 'a undo_stack -> 'a option
+
(*****************************************************************************)
(* Binary tree *)
(* N-ary tree with updatable childrens *)
(*****************************************************************************)
-(* Leaf can seem redundant, but sometimes want to directly see if
+(* no empty tree, must have one root at least *)
+type 'a treeref =
+ | NodeRef of 'a * 'a treeref list ref
+
+val treeref_node_iter:
+ (('a * 'a treeref list ref) -> unit) -> 'a treeref -> unit
+val treeref_node_iter_with_parents:
+ (('a * 'a treeref list ref) -> ('a list) -> unit) ->
+ 'a treeref -> unit
+
+val find_treeref:
+ (('a * 'a treeref list ref) -> bool) ->
+ 'a treeref -> 'a treeref
+
+val treeref_children_ref:
+ 'a treeref -> 'a treeref list ref
+
+val find_treeref_with_parents_some:
+ ('a * 'a treeref list ref -> 'a list -> 'c option) ->
+ 'a treeref -> 'c
+
+val find_multi_treeref_with_parents_some:
+ ('a * 'a treeref list ref -> 'a list -> 'c option) ->
+ 'a treeref -> 'c list
+
+
+(* Leaf can seem redundant, but sometimes want to directly see if
* a children is a leaf without looking if the list is empty.
*)
-type ('a, 'b) treeref =
- | NodeRef of 'a * ('a, 'b) treeref list ref
- | LeafRef of 'b
+type ('a, 'b) treeref2 =
+ | NodeRef2 of 'a * ('a, 'b) treeref2 list ref
+ | LeafRef2 of 'b
+
+
+val find_treeref2:
+ (('a * ('a, 'b) treeref2 list ref) -> bool) ->
+ ('a, 'b) treeref2 -> ('a, 'b) treeref2
-val treeref_node_iter:
- (('a * ('a, 'b) treeref list ref) -> unit) -> ('a, 'b) treeref -> unit
-val treeref_node_iter_with_parents:
- (('a * ('a, 'b) treeref list ref) -> ('a list) -> unit) ->
- ('a, 'b) treeref -> unit
+val treeref_node_iter_with_parents2:
+ (('a * ('a, 'b) treeref2 list ref) -> ('a list) -> unit) ->
+ ('a, 'b) treeref2 -> unit
-val find_treeref:
- (('a * ('a, 'b) treeref list ref) -> bool) ->
- ('a, 'b) treeref -> ('a, 'b) treeref
+val treeref_node_iter2:
+ (('a * ('a, 'b) treeref2 list ref) -> unit) -> ('a, 'b) treeref2 -> unit
+
+(*
+val treeref_children_ref: ('a, 'b) treeref -> ('a, 'b) treeref list ref
+val find_treeref_with_parents_some:
+ ('a * ('a, 'b) treeref list ref -> 'a list -> 'c option) ->
+ ('a, 'b) treeref -> 'c
+val find_multi_treeref_with_parents_some:
+ ('a * ('a, 'b) treeref list ref -> 'a list -> 'c option) ->
+ ('a, 'b) treeref -> 'c list
+*)
(*****************************************************************************)
(* Graph. But have a look too at Ograph_*.mli; it's better *)
(* mostly alias to functions in List *)
val map : ('a -> 'b) -> 'a list -> 'b list
+val tail_map : ('a -> 'b) -> 'a list -> 'b list
val filter : ('a -> bool) -> 'a list -> 'a list
val fold : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
(* Currently lexing.ml does not handle the line number position.
- * Even if there is some fields in the lexing structure, they are not
+ * Even if there is some fields in the lexing structure, they are not
* maintained by the lexing engine :( So the following code does not work:
- *
- * let pos = Lexing.lexeme_end_p lexbuf in
- * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum
- * (pos.pos_cnum - pos.pos_bol) in
- *
+ *
+ * let pos = Lexing.lexeme_end_p lexbuf in
+ * sprintf "at file %s, line %d, char %d" pos.pos_fname pos.pos_lnum
+ * (pos.pos_cnum - pos.pos_bol) in
+ *
* Hence those functions to overcome the previous limitation.
*)
line: int;
column: int;
file: filename;
- }
+ }
val fake_parse_info : parse_info
val string_of_parse_info : parse_info -> string
+val string_of_parse_info_bis : parse_info -> string
(* array[i] will contain the (line x col) of the i char position *)
val full_charpos_to_pos : filename -> (int * int) array
(* fill in the line and column field of parse_info that were not set
* during lexing because of limitations of ocamllex. *)
-val complete_parse_info :
+val complete_parse_info :
filename -> (int * int) array -> parse_info -> parse_info
+val full_charpos_to_pos_large:
+ filename -> (int -> (int * int))
+
+val complete_parse_info_large :
+ filename -> (int -> (int * int)) -> parse_info -> parse_info
+
(* return line x col x str_line from a charpos. This function is quite
* expensive so don't use it to get the line x col from every token in
* a file. Instead use full_charpos_to_pos.
val error_message : filename -> (string * int) -> string
val error_message_short : filename -> (string * int) -> string
-(* add a 'decalage/shift' argument to handle stuff such as cpp which includes
+(* add a 'decalage/shift' argument to handle stuff such as cpp which includes
* files and who can make shift.
*)
val error_messagebis : filename -> (string * int) -> int -> string
(* for example of use, see the code used in coccinelle *)
type ('a, 'b) scoped_env = ('a, 'b) assoc list
-val lookup_env : 'a -> ('a, 'b) scoped_env -> 'b
+val lookup_env : (* Eq a *) 'a -> ('a, 'b) scoped_env -> 'b
val member_env_key : 'a -> ('a, 'b) scoped_env -> bool
val new_scope : ('a, 'b) scoped_env ref -> unit
val del_scope : ('a, 'b) scoped_env ref -> unit
val do_in_new_scope : ('a, 'b) scoped_env ref -> (unit -> unit) -> unit
-
+
val add_in_scope : ('a, 'b) scoped_env ref -> 'a * 'b -> unit
val new_scope_h : ('a, 'b) scoped_h_env ref -> unit
val del_scope_h : ('a, 'b) scoped_h_env ref -> unit
+val clean_scope_h : ('a, 'b) scoped_h_env ref -> unit
val do_in_new_scope_h : ('a, 'b) scoped_h_env ref -> (unit -> unit) -> unit
(* Terminal (LFS) *)
(*****************************************************************************)
+(* don't forget to call Common_extra.set_link () *)
+
val _execute_and_show_progress_func :
- (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref
-val execute_and_show_progress :
+ (int (* length *) -> ((unit -> unit) -> unit) -> unit) ref
+val execute_and_show_progress :
int (* length *) -> ((unit -> unit) -> unit) -> unit
(*****************************************************************************)