X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fhttp_getter%2Fzack.ml;fp=helm%2Fhttp_getter%2Fzack.ml;h=0000000000000000000000000000000000000000;hb=c7514aaa249a96c5fdd39b1123fbdb38d92f20b6;hp=bc40f0c05880d770f32ad25cf4d676a5ad0036ab;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git

diff --git a/helm/http_getter/zack.ml b/helm/http_getter/zack.ml
deleted file mode 100644
index bc40f0c05..000000000
--- a/helm/http_getter/zack.ml
+++ /dev/null
@@ -1,475 +0,0 @@
-(*
- * 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 ;;
-