utils/misc.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* Errors *)
  16
  17 exception Fatal_error
  18
  19 let fatal_error msg =
  20   prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
  21
  22 (* Exceptions *)
  23
  24 let try_finally f1 f2 =
  25   try
  26     let result = f1 () in
  27     f2 ();
  28     result
  29   with x -> f2 (); raise x
  30 ;;
  31
  32 (* List functions *)
  33
  34 let rec map_end f l1 l2 =
  35   match l1 with
  36     [] -> l2
  37   | hd::tl -> f hd :: map_end f tl l2
  38
  39 let rec map_left_right f = function
  40     [] -> []
  41   | hd::tl -> let res = f hd in res :: map_left_right f tl
  42
  43 let rec for_all2 pred l1 l2 =
  44   match (l1, l2) with
  45     ([], []) -> true
  46   | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2
  47   | (_, _) -> false
  48
  49 let rec replicate_list elem n =
  50   if n <= 0 then [] else elem :: replicate_list elem (n-1)
  51
  52 let rec list_remove x = function
  53     [] -> []
  54   | hd :: tl ->
  55       if hd = x then tl else hd :: list_remove x tl
  56
  57 let rec split_last = function
  58     [] -> assert false
  59   | [x] -> ([], x)
  60   | hd :: tl ->
  61       let (lst, last) = split_last tl in
  62       (hd :: lst, last)
  63
  64 let rec samelist pred l1 l2 =
  65   match (l1, l2) with
  66   | ([], []) -> true
  67   | (hd1 :: tl1, hd2 :: tl2) -> pred hd1 hd2 && samelist pred tl1 tl2
  68   | (_, _) -> false
  69
  70 (* Options *)
  71
  72 let may f = function
  73     Some x -> f x
  74   | None -> ()
  75
  76 let may_map f = function
  77     Some x -> Some (f x)
  78   | None -> None
  79
  80 (* File functions *)
  81
  82 let find_in_path path name =
  83   if not (Filename.is_implicit name) then
  84     if Sys.file_exists name then name else raise Not_found
  85   else begin
  86     let rec try_dir = function
  87       [] -> raise Not_found
  88     | dir::rem ->
  89         let fullname = Filename.concat dir name in
  90         if Sys.file_exists fullname then fullname else try_dir rem
  91     in try_dir path
  92   end
  93
  94 let find_in_path_uncap path name =
  95   let uname = String.uncapitalize name in
  96   let rec try_dir = function
  97     [] -> raise Not_found
  98   | dir::rem ->
  99       let fullname = Filename.concat dir name
 100       and ufullname = Filename.concat dir uname in
 101       if Sys.file_exists ufullname then ufullname
 102       else if Sys.file_exists fullname then fullname
 103       else try_dir rem
 104   in try_dir path
 105
 106 let remove_file filename =
 107   try
 108     Sys.remove filename
 109   with Sys_error msg ->
 110     ()
 111
 112 (* Expand a -I option: if it starts with +, make it relative to the standard
 113    library directory *)
 114
 115 let expand_directory alt s =
 116   if String.length s > 0 && s.[0] = '+'
 117   then Filename.concat alt
 118                        (String.sub s 1 (String.length s - 1))
 119   else s
 120
 121 (* Hashtable functions *)
 122
 123 let create_hashtable size init =
 124   let tbl = Hashtbl.create size in
 125   List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
 126   tbl
 127
 128 (* File copy *)
 129
 130 let copy_file ic oc =
 131   let buff = String.create 0x1000 in
 132   let rec copy () =
 133     let n = input ic buff 0 0x1000 in
 134     if n = 0 then () else (output oc buff 0 n; copy())
 135   in copy()
 136
 137 let copy_file_chunk ic oc len =
 138   let buff = String.create 0x1000 in
 139   let rec copy n =
 140     if n <= 0 then () else begin
 141       let r = input ic buff 0 (min n 0x1000) in
 142       if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
 143     end
 144   in copy len
 145
 146 (* Integer operations *)
 147
 148 let rec log2 n =
 149   if n <= 1 then 0 else 1 + log2(n asr 1)
 150
 151 let align n a =
 152   if n >= 0 then (n + a - 1) land (-a) else n land (-a)
 153
 154 let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0
 155
 156 let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0
 157
 158 let no_overflow_lsl a = min_int asr 1 <= a && a <= max_int asr 1
 159
 160 (* String operations *)
 161
 162 let chop_extension_if_any fname =
 163   try Filename.chop_extension fname with Invalid_argument _ -> fname
 164
 165 let chop_extensions file =
 166   let dirname = Filename.dirname file and basename = Filename.basename file in
 167   try
 168     let pos = String.index basename '.' in
 169     let basename = String.sub basename 0 pos in
 170     if Filename.is_implicit file && dirname = Filename.current_dir_name then
 171       basename
 172     else
 173       Filename.concat dirname basename
 174   with Not_found -> file
 175
 176 let search_substring pat str start =
 177   let rec search i j =
 178     if j >= String.length pat then i
 179     else if i + j >= String.length str then raise Not_found
 180     else if str.[i + j] = pat.[j] then search i (j+1)
 181     else search (i+1) 0
 182   in search start 0
 183
 184 let rev_split_words s =
 185   let rec split1 res i =
 186     if i >= String.length s then res else begin
 187       match s.[i] with
 188         ' ' | '\t' | '\r' | '\n' -> split1 res (i+1)
 189       | _ -> split2 res i (i+1)
 190     end
 191   and split2 res i j =
 192     if j >= String.length s then String.sub s i (j-i) :: res else begin
 193       match s.[j] with
 194         ' ' | '\t' | '\r' | '\n' -> split1 (String.sub s i (j-i) :: res) (j+1)
 195       | _ -> split2 res i (j+1)
 196     end
 197   in split1 [] 0