1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
(* Errors *)
|
|
|
|
|
|
|
|
exception Fatal_error
|
|
|
|
|
|
|
|
let fatal_error msg =
|
|
|
|
prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
|
|
|
|
|
|
|
|
(* List functions *)
|
|
|
|
|
|
|
|
let rec map_end f l1 l2 =
|
|
|
|
match l1 with
|
|
|
|
[] -> l2
|
|
|
|
| hd::tl -> f hd :: map_end f tl l2
|
|
|
|
|
|
|
|
let rec for_all2 pred l1 l2 =
|
|
|
|
match (l1, l2) with
|
|
|
|
([], []) -> true
|
2000-12-28 05:07:42 -08:00
|
|
|
| (hd1::tl1, hd2::tl2) -> pred hd1 hd2 && for_all2 pred tl1 tl2
|
1995-05-04 03:15:53 -07:00
|
|
|
| (_, _) -> false
|
|
|
|
|
1996-01-04 04:51:11 -08:00
|
|
|
let rec replicate_list elem n =
|
|
|
|
if n <= 0 then [] else elem :: replicate_list elem (n-1)
|
|
|
|
|
1999-02-04 02:32:27 -08:00
|
|
|
let rec list_remove x = function
|
|
|
|
[] -> []
|
|
|
|
| hd :: tl ->
|
|
|
|
if hd = x then tl else hd :: list_remove x tl
|
|
|
|
|
2000-02-28 07:47:13 -08:00
|
|
|
let rec split_last = function
|
|
|
|
[] -> assert false
|
|
|
|
| [x] -> ([], x)
|
|
|
|
| hd :: tl ->
|
|
|
|
let (lst, last) = split_last tl in
|
|
|
|
(hd :: lst, last)
|
|
|
|
|
1999-11-30 08:07:38 -08:00
|
|
|
(* Options *)
|
|
|
|
|
|
|
|
let may f = function
|
|
|
|
Some x -> f x
|
|
|
|
| None -> ()
|
|
|
|
|
|
|
|
let may_map f = function
|
|
|
|
Some x -> Some (f x)
|
|
|
|
| None -> None
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
(* File functions *)
|
|
|
|
|
|
|
|
let find_in_path path name =
|
1997-06-16 10:09:14 -07:00
|
|
|
if not (Filename.is_implicit name) then
|
1995-05-04 05:48:07 -07:00
|
|
|
if Sys.file_exists name then name else raise Not_found
|
1995-05-04 03:15:53 -07:00
|
|
|
else begin
|
|
|
|
let rec try_dir = function
|
|
|
|
[] -> raise Not_found
|
|
|
|
| dir::rem ->
|
|
|
|
let fullname = Filename.concat dir name in
|
1995-05-04 05:48:07 -07:00
|
|
|
if Sys.file_exists fullname then fullname else try_dir rem
|
1995-05-04 03:15:53 -07:00
|
|
|
in try_dir path
|
|
|
|
end
|
|
|
|
|
|
|
|
let remove_file filename =
|
|
|
|
try
|
|
|
|
Sys.remove filename
|
|
|
|
with Sys_error msg ->
|
|
|
|
()
|
|
|
|
|
2000-12-27 21:02:43 -08:00
|
|
|
(* Expand a -I option: if it starts with +, make it relative to the standard
|
|
|
|
library directory *)
|
|
|
|
|
|
|
|
let expand_directory alt s =
|
|
|
|
if String.length s > 0 && s.[0] = '+'
|
|
|
|
then Filename.concat alt
|
|
|
|
(String.sub s 1 (String.length s - 1))
|
|
|
|
else s
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
(* Hashtable functions *)
|
|
|
|
|
|
|
|
let create_hashtable size init =
|
1996-04-22 04:15:41 -07:00
|
|
|
let tbl = Hashtbl.create size in
|
1995-05-04 03:15:53 -07:00
|
|
|
List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
|
|
|
|
tbl
|
|
|
|
|
|
|
|
(* File copy *)
|
|
|
|
|
|
|
|
let copy_file ic oc =
|
|
|
|
let buff = String.create 0x1000 in
|
|
|
|
let rec copy () =
|
|
|
|
let n = input ic buff 0 0x1000 in
|
|
|
|
if n = 0 then () else (output oc buff 0 n; copy())
|
|
|
|
in copy()
|
|
|
|
|
|
|
|
let copy_file_chunk ic oc len =
|
|
|
|
let buff = String.create 0x1000 in
|
|
|
|
let rec copy n =
|
|
|
|
if n <= 0 then () else begin
|
|
|
|
let r = input ic buff 0 (min n 0x1000) in
|
|
|
|
if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
|
|
|
|
end
|
|
|
|
in copy len
|
1995-06-05 06:44:14 -07:00
|
|
|
|
|
|
|
(* Integer operations *)
|
|
|
|
|
|
|
|
let rec log2 n =
|
1995-06-15 01:10:54 -07:00
|
|
|
if n <= 1 then 0 else 1 + log2(n asr 1)
|
1995-06-05 06:44:14 -07:00
|
|
|
|
|
|
|
let align n a =
|
1995-12-19 02:19:38 -08:00
|
|
|
if n >= 0 then (n + a - 1) land (-a) else n land (-a)
|
1995-10-26 09:25:24 -07:00
|
|
|
|
|
|
|
let no_overflow_add a b = (a lxor b) lor (a lxor (lnot (a+b))) < 0
|
|
|
|
|
|
|
|
let no_overflow_sub a b = (a lxor (lnot b)) lor (b lxor (a-b)) < 0
|
|
|
|
|