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