--- /dev/null
+(*
+ * Zack's own OCaml library -- set of "helpers" function for the OCaml language
+ *
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@bononia.it>
+ *
+ * This module is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This module is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this module; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *)
+
+open Printf ;;
+
+exception Not_implemented ;;
+
+let (newline, newline_len) =
+ let default_newline = "\n" in
+ let newline =
+ match Sys.os_type with
+ | "Unix" -> "\n"
+ | "Win32" | "Cygwin" -> "\r\n"
+ | "MacOS" -> "\r"
+ | _ -> default_newline
+ in
+ (newline, String.length newline)
+;;
+
+module ZLogic =
+ struct
+
+ let non pred x = not (pred x) ;;
+ let conj p1 p2 x = (p1 x) && (p2 x) ;;
+ let disj p1 p2 x = (p1 x) || (p2 x) ;;
+ let imply p1 p2 x = (non p1) x || p2 x ;;
+
+ let (&&&) = conj ;;
+ let (|||) = disj ;;
+ let (=>) = imply ;;
+
+ end
+;;
+
+module ZArray =
+ struct
+
+ exception Found of int;;
+
+ (** return the index of first element in ary on which pred is true *)
+ let index pred ary =
+ try
+ Array.iteri (fun idx e -> if pred e then raise (Found idx)) ary;
+ raise Not_found
+ with Found idx -> idx
+ ;;
+ (** as index but return the element itself instead of the index *)
+ let find pred ary = ary.(index pred ary) ;;
+ (** check if at least one element in ary satisfies pred *)
+ let exists pred ary =
+ try
+ ignore (find pred ary);
+ true
+ with Not_found -> false
+ ;;
+ (** check if all elements in ary satisfy pred *)
+ let for_all pred ary = not (exists (ZLogic.non pred) ary) ;;
+
+ (** return a fresh array containing all elements of ary that satisfy pred
+ *)
+ let filter pred ary =
+ let indexes = (* indexes of element on which pred is satisfied *)
+ let (_, indexes) =
+ Array.fold_left
+ (fun (i, acc) e -> if pred e then (i+1, i::acc) else (i+1, acc))
+ (0, [])
+ ary
+ in
+ List.rev indexes
+ in
+ let size = List.length indexes in
+ let newary = Array.make size ary.(0) in
+ let rec fill i = function
+ | [] -> ()
+ | idx::tl ->
+ newary.(i) <- ary.(idx);
+ fill (i+1) tl
+ in
+ fill 0 indexes;
+ newary
+ ;;
+
+ let lrotate () =
+ raise Not_implemented; () ;;
+ let rrotate () =
+ raise Not_implemented; () ;;
+
+ end
+
+module ZDbm =
+ struct
+ (** fold on dbm key and values, processing order is not specified *)
+ let fold f init dbm =
+ let res = ref init in
+ Dbm.iter (fun key value -> res := f !res key value) dbm;
+ !res
+ ;;
+ end
+
+module ZHashtbl =
+ struct
+ let keys tbl = Hashtbl.fold (fun key _ acc -> key :: acc) tbl [] ;;
+ let values tbl = Hashtbl.fold (fun _ valu acc -> valu :: acc) tbl [] ;;
+ let remove_all tbl key =
+ for i = 1 to List.length (Hashtbl.find_all tbl key) do
+ Hashtbl.remove tbl key
+ done
+ ;;
+ end
+
+module ZList =
+ struct
+ (** tail recursive version of List.map *)
+ let map' f l =
+ let rec aux acc = function
+ | [] -> List.rev acc
+ | hd :: tl -> aux (f hd :: acc) tl
+ in
+ aux [] l
+ ;;
+ (** guarded map on lists. List.length output <= List.length input.
+ Not tail recursive *)
+ let rec map_if f pred = function
+ | [] -> []
+ | hd::tl when pred hd -> f hd :: map_if f pred tl
+ | hd::tl -> map_if f pred tl
+ ;;
+ (** tail recursive version of map_if *)
+ let map_if' f pred l =
+ let rec aux acc = function
+ | [] -> List.rev acc
+ | hd::tl when pred hd -> aux (f hd :: acc) tl
+ | hd::tl -> aux acc tl
+ in
+ aux [] l
+ ;;
+ (** low level to implement assoc_all and assq_all *)
+ let assoc_all_gen eq key list =
+ let rec aux acc = function
+ | [] -> acc
+ | (k, v)::tl when (eq k key) -> aux (v :: acc) tl
+ | _::tl -> aux acc tl
+ in
+ List.rev (aux [] list)
+ ;;
+ (** return all binding of k in association list l in the order they appear
+ in l. Uses structural equality *)
+ let assoc_all k l = assoc_all_gen (=) k l ;;
+ (** as assoc_all but uses physical equality *)
+ let assq_all k l = assoc_all_gen (==) k l ;;
+ let lrotate = function
+ | [] -> raise (Invalid_argument "Zack.List.lrotate")
+ | hd::tl -> tl @ [hd]
+ ;;
+ let rrotate l =
+ match List.rev l with
+ | [] -> raise (Invalid_argument "Zack.List.rrotate")
+ | hd::tl -> hd :: List.rev tl
+ ;;
+ end
+
+module ZSys =
+ struct
+ let copy () =
+ raise Not_implemented; () ;;
+ end
+
+module ZUnix =
+ struct
+
+ let mkdir () =
+ raise Not_implemented; () ;;
+
+ let get_stats follow_symlink =
+ if follow_symlink then Unix.stat else Unix.lstat
+ ;;
+ (* low level for is_* predicates *)
+ let is_file_kind follow_symlink kind fname =
+ (get_stats follow_symlink fname).Unix.st_kind = kind
+ ;;
+ let is_regular ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_REG ;;
+ let is_directory ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_DIR ;;
+ let is_chardev ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_CHR ;;
+ let is_blockdev ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_BLK ;;
+ let is_symlink ?(follow_symlink = false) =
+ is_file_kind follow_symlink Unix.S_LNK ;;
+ let is_fifo ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_FIFO ;;
+ let is_socket ?(follow_symlink = true) =
+ is_file_kind follow_symlink Unix.S_SOCK ;;
+
+ let size ?(follow_symlink = true) fname =
+ (get_stats follow_symlink fname).Unix.st_size ;;
+
+ (** return a list of all entries contained in a directory. Return order is
+ not specified *)
+ let ls dirname =
+ let dir = Unix.opendir dirname in
+ let rec aux acc =
+ match (try Some (Unix.readdir dir) with End_of_file -> None) with
+ | Some entry -> aux (entry :: acc)
+ | None -> acc
+ in
+ let res = aux [] in
+ Unix.closedir dir;
+ res
+ ;;
+
+ end
+
+module ZString =
+ struct
+
+ (** string -> char list *)
+ let explode s =
+ let chars = ref [] in
+ for i = String.length s - 1 downto 0 do
+ chars := s.[i] :: !chars
+ done;
+ !chars
+ ;;
+
+ (** char list -> string *)
+ let implode l =
+ let buf = Buffer.create (List.length l) in
+ let rec implode' = function
+ | [] -> Buffer.contents buf
+ | hd::tl ->
+ Buffer.add_char buf hd;
+ implode' tl
+ in
+ implode' l
+ ;;
+
+ (** perl's chomp, remove once trailing "\n", if any *)
+ let chomp s =
+ let len = String.length s in
+ let diff = len - newline_len in
+ if String.sub s diff newline_len = newline then (* trailing newline *)
+ String.sub s 0 diff
+ else
+ s
+ ;;
+
+ (** map on string *)
+ let map f s =
+ for i = 0 to String.length s do
+ s.[i] <- f s.[i]
+ done
+ ;;
+
+ (** fold_left on string *)
+ let fold_left f init s =
+ let len = String.length s in
+ let rec fold_left' idx acc =
+ if idx = len then
+ acc
+ else (* idx < len *)
+ fold_left' (idx + 1) (f acc s.[idx])
+ in
+ fold_left' 0 init
+ ;;
+
+ (* TODO Non funge *)
+ let fold_right f s init =
+ let len = String.length s in
+ let rec fold_right' idx acc =
+ if idx < 0 then
+ acc
+ else (* idx >= 0 *)
+ fold_right' (idx - 1) (f s.[idx] acc)
+ in
+ fold_right' len (init - 1)
+ ;;
+
+ (** iter on string *)
+ let iter (f: char -> unit) = fold_left (fun _ c -> f c) () ;;
+ (*
+ let string_iter (f: char -> unit) s =
+ for i = 0 to String.length s do
+ f s.[i]
+ done
+ ;;
+ *)
+
+ let filter () =
+ raise Not_implemented; () ;;
+
+ (** create a string of length len and sets each char of them to the result
+ of applying f to the char's index *)
+ let init len f =
+ let str = String.create len in
+ for i = 0 to len - 1 do
+ str.[i] <- f i
+ done;
+ str
+ ;;
+
+ end
+
+module ZRandom =
+ struct
+
+ type ranges = (int * int) list
+
+ let digit_range = [48, 57] ;;
+ let alpha_upper_range = [65, 90] ;;
+ let alpha_lower_range = [97, 122] ;;
+ let alpha_range = alpha_upper_range @ alpha_lower_range ;;
+ let alphanum_range = digit_range @ alpha_range ;;
+ let word_range = alphanum_range @ [95, 95] ;; (* alphanum + '_' *)
+
+ let rec ranges_are_sane = function
+ | (min, max) :: tl ->
+ if min > max || min < 0 || max > 255 then
+ failwith (sprintf "ZRandom: invalid range %d .. %d" min max);
+ ranges_are_sane tl
+ | [] -> ()
+ ;;
+ let size_of_ranges = (* assumption: ranges are sane *)
+ let rec aux acc = function
+ | [] -> acc
+ | ((min, max) as range) :: tl -> aux (acc + (max - min + 1)) tl
+ in
+ aux 0
+ ;;
+ let nth_in_ranges idx ranges = (* assumption: ranges are sane *)
+ if ranges = [] then
+ failwith "ZRandom: no range provided";
+ let rec aux idx = function
+ | [] -> assert false
+ | (min, max) :: tl ->
+ let nth = min + idx in
+ if nth <= max then nth else aux (nth - max - 1) tl
+ in
+ aux idx ranges
+ ;;
+
+ (* low level for char and string *)
+ let char' ranges =
+ let int = Random.int (size_of_ranges ranges) in
+ Char.chr (nth_in_ranges int ranges)
+ ;;
+
+ (** generate a random char inside provided ranges. Ranges are provided as
+ a list of int pairs. Each pair represent an inclusive interval of possible
+ character codes. Default range is [0, 255] *)
+ let char ?(ranges = [0,255]) () =
+ ranges_are_sane ranges;
+ char' ranges
+ ;;
+
+ (** generate a string of random characters inside provided range *)
+ let string ?(ranges = [0,255]) len =
+ ranges_are_sane ranges;
+ ZString.init len (fun _ -> char' ranges)
+ ;;
+
+ end
+
+module ZStream =
+ struct
+
+ (** map on streams. Beware that this function build stream using
+ Stream.from. That kind of stream can't be mixed with ordinary streams *)
+ let map f stream =
+ Stream.from
+ (fun _ -> try Some (f (Stream.next stream)) with Stream.Failure -> None)
+ ;;
+ (** fold on streams. Beware that this function build stream using
+ Stream.from. That kind of stream can't be mixed with ordinary streams *)
+ let rec fold f init stream =
+ match (try Some (Stream.next stream) with Stream.Failure -> None) with
+ | Some item -> fold f (f init item) stream
+ | None -> init
+ ;;
+
+ (** given an input channel return the stream of its lines (without
+ trailing new line) *)
+ let of_inchan ic =
+ Stream.from (fun _ -> try Some (input_line ic) with End_of_file -> None)
+ ;;
+
+ end
+
+ (** fold_left on input channel lines *)
+let rec fold_in f init ic =
+ match (try Some (input_line ic) with End_of_file -> None) with
+ | Some l -> fold_in f (f init l) ic
+ | None -> init
+;;
+
+ (** iter on input channel lines *)
+let iter_in f = fold_in (fun _ line -> f line) () ;;
+
+ (** map on input channel lines *)
+let map_in f ic = List.rev (fold_in (fun acc line -> f line :: acc) [] ic) ;;
+
+ (** return list of lines read from an input channel *)
+let input_lines ic = List.rev (fold_in (fun acc line -> line :: acc) [] ic) ;;
+
+ (** read all data available on an input channel and return them as a string *)
+let input_all =
+ let strlen = 8192 in
+ let buflen = 8192 * 2 in
+ let str = String.create strlen in
+ fun ic ->
+ let buf = Buffer.create buflen in
+ let rec input' () =
+ let bytes = input ic str 0 strlen in
+ if bytes = 0 then (* EOF *)
+ Buffer.contents buf
+ else begin
+ Buffer.add_substring buf str 0 bytes;
+ input' ()
+ end
+ in
+ input' ()
+;;
+
+ (** write a list of lines to an output channel. Newline is added at the end of
+ each line *)
+let rec output_lines lines oc =
+ match lines with
+ | [] -> ()
+ | hd::tl ->
+ output_string oc (hd ^ newline);
+ output_lines tl oc
+;;
+
+ (** read_lines on stdin *)
+let read_lines () = input_lines stdin ;;
+ (** read_all on stdin *)
+let read_all () = input_all stdin ;;
+
+ (** Some constructor inverse *)
+let unsome = function
+ | Some x -> x
+ | None -> raise (Invalid_argument "Zack.unsome")
+;;
+
+module Array = ZArray ;;
+module Dbm = ZDbm ;;
+module Hashtbl = ZHashtbl ;;
+module List = ZList ;;
+module Logic = ZLogic ;;
+module Random = ZRandom ;;
+module Stream = ZStream ;;
+module String = ZString ;;
+module Sys = ZSys ;;
+module Unix = ZUnix ;;
+
--- /dev/null
+(*
+ * Zack's own OCaml library -- set of "helpers" function for the OCaml language
+ *
+ * Copyright (C) 2003:
+ * Stefano Zacchiroli <zack@bononia.it>
+ *
+ * This module is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This module is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this module; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *)
+
+exception Not_implemented
+
+val fold_in : ('a -> string -> 'a) -> 'a -> in_channel -> 'a
+val iter_in : (string -> unit) -> in_channel -> unit
+val map_in : (string -> 'a) -> in_channel -> 'a list
+val input_lines : in_channel -> string list
+val input_all : in_channel -> string
+val output_lines : string list -> out_channel -> unit
+val read_lines : unit -> string list
+val read_all : unit -> string
+val unsome : 'a option -> 'a
+
+module Array :
+ sig
+ val index : ('a -> bool) -> 'a array -> int
+ val find : ('a -> bool) -> 'a array -> 'a
+
+ val exists : ('a -> bool) -> 'a array -> bool
+ val for_all : ('a -> bool) -> 'a array -> bool
+
+ val filter : ('a -> bool) -> 'a array -> 'a array
+
+(* val lrotate : ?step:int -> 'a array -> 'a array *)
+(* val rrotate : ?step:int -> 'a array -> 'a array *)
+ end
+
+module Dbm :
+ sig
+ val fold : ('a -> string -> string -> 'a) -> 'a -> Dbm.t -> 'a
+ end
+
+module Hashtbl :
+ sig
+ val keys : ('a, 'b) Hashtbl.t -> 'a list
+ val values : ('a, 'b) Hashtbl.t -> 'b list
+
+ val remove_all : ('a, 'b) Hashtbl.t -> 'a -> unit
+ end
+
+module List :
+ sig
+ val map' : ('a -> 'b) -> 'a list -> 'b list
+ val map_if : ('a -> 'b) -> ('a -> bool) -> 'a list -> 'b list
+ val map_if' : ('a -> 'b) -> ('a -> bool) -> 'a list -> 'b list
+
+ val assoc_all : 'a -> ('a * 'b) list -> 'b list
+ val assq_all : 'a -> ('a * 'b) list -> 'b list
+
+ val lrotate : 'a list -> 'a list
+ val rrotate : 'a list -> 'a list
+(* val List.lrotate: ?step:int -> 'a list -> 'a list *)
+(* val List.rrotate: ?step:int -> 'a list -> 'a list *)
+ end
+
+module Logic :
+ sig
+ val non : ('a -> bool) -> 'a -> bool
+ val conj : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+ val disj : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+ val imply : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+
+ val ( &&& ) : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+ val ( ||| ) : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+ val ( => ) : ('a -> bool) -> ('a -> bool) -> 'a -> bool
+ end
+
+module Random :
+ sig
+ val digit_range : (int * int) list
+ val alpha_upper_range : (int * int) list
+ val alpha_lower_range : (int * int) list
+ val alpha_range : (int * int) list
+ val alphanum_range : (int * int) list
+ val word_range : (int * int) list
+
+ val char : ?ranges:(int * int) list -> unit -> char
+ val string : ?ranges:(int * int) list -> int -> string
+ end
+
+module Stream :
+ sig
+ val map : ('a -> 'b) -> 'a Stream.t -> 'b Stream.t
+ val fold : ('a -> 'b -> 'a) -> 'a -> 'b Stream.t -> 'a
+
+ val of_inchan : in_channel -> string Stream.t
+ end
+
+module String :
+ sig
+ val explode : string -> char list
+ val implode : char list -> string
+
+ val chomp : string -> string
+
+ val map : (char -> char) -> string -> unit
+ val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
+(* val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a *)
+ val iter : (char -> unit) -> string -> unit
+(* val filter : (char -> bool) -> string -> string *)
+
+ val init : int -> (int -> char) -> string
+ end
+
+(*
+module Sys :
+ sig
+ val copy : src:string -> dst:string -> unit
+ end
+*)
+
+module Unix :
+ sig
+(* val mkdir : ?parents:bool -> string -> unit *)
+
+ val is_regular : ?follow_symlink:bool -> string -> bool
+ val is_directory : ?follow_symlink:bool -> string -> bool
+ val is_chardev : ?follow_symlink:bool -> string -> bool
+ val is_blockdev : ?follow_symlink:bool -> string -> bool
+ val is_symlink : ?follow_symlink:bool -> string -> bool
+ val is_fifo : ?follow_symlink:bool -> string -> bool
+ val is_socket : ?follow_symlink:bool -> string -> bool
+
+ val size : ?follow_symlink:bool -> string -> int
+
+ val ls : string -> string list
+ end
+
projects / helm.git / commitdiff