1996-11-29 08:55:09 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Objective Caml *)
|
|
|
|
(* *)
|
|
|
|
(* Jerome Vouillon, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* Objective Caml port by John Malecki and Xavier Leroy *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
(*********************** Basic functions and types *********************)
|
|
|
|
|
|
|
|
(*** Miscellaneous ***)
|
|
|
|
exception Out_of_range
|
|
|
|
|
|
|
|
let nothing _ = ()
|
|
|
|
|
|
|
|
(*** Operations on lists. ***)
|
|
|
|
|
|
|
|
(* Remove an element from a list *)
|
|
|
|
let except e l =
|
|
|
|
let rec except_e = function
|
|
|
|
[] -> []
|
|
|
|
| elem::l -> if e = elem then l else elem::except_e l
|
|
|
|
in except_e l
|
|
|
|
|
|
|
|
(* Position of an element in a list. Head of list has position 0. *)
|
|
|
|
let index a l =
|
|
|
|
let rec index_rec i = function
|
|
|
|
[] -> raise Not_found
|
|
|
|
| b::l -> if a = b then i else index_rec (i + 1) l
|
|
|
|
in index_rec 0 l
|
|
|
|
|
|
|
|
(* Remove an element from an association list *)
|
|
|
|
let assoc_remove lst elem =
|
|
|
|
let rec remove =
|
|
|
|
function
|
|
|
|
[] -> []
|
|
|
|
| ((a, _) as c::t) ->
|
|
|
|
if a = elem then t
|
|
|
|
else c::(remove t)
|
|
|
|
in remove lst
|
|
|
|
|
|
|
|
(* Nth element of a list. *)
|
|
|
|
let rec list_nth p0 p1 =
|
|
|
|
match (p0,p1) with
|
|
|
|
([], _) ->
|
|
|
|
invalid_arg "list_nth"
|
|
|
|
| ((a::_), 0) ->
|
|
|
|
a
|
|
|
|
| ((_::l), n) ->
|
|
|
|
list_nth l (n - 1)
|
|
|
|
|
|
|
|
(* Return the `n' first elements of `l' *)
|
|
|
|
(* ### n l -> l' *)
|
|
|
|
let rec list_truncate =
|
|
|
|
fun
|
|
|
|
p0 p1 -> match (p0,p1) with (0, _) -> []
|
|
|
|
| (_, []) -> []
|
|
|
|
| (n, (a::l)) -> a::(list_truncate (n - 1) l)
|
|
|
|
|
|
|
|
(* Separe the `n' first elements of `l' and the others *)
|
|
|
|
(* ### n list -> (first, last) *)
|
|
|
|
let rec list_truncate2 =
|
|
|
|
fun
|
|
|
|
p0 p1 -> match (p0,p1) with (0, l) ->
|
|
|
|
([], l)
|
|
|
|
| (_, []) ->
|
|
|
|
([], [])
|
|
|
|
| (n, (a::l)) ->
|
|
|
|
let (first, last) = (list_truncate2 (n - 1) l) in
|
|
|
|
(a::first, last)
|
|
|
|
|
|
|
|
(* Replace x by y in list l *)
|
|
|
|
(* ### x y l -> l' *)
|
|
|
|
let list_replace x y =
|
|
|
|
let rec repl =
|
|
|
|
function
|
|
|
|
[] -> []
|
|
|
|
| a::l ->
|
|
|
|
if a == x then y::l
|
|
|
|
else a::(repl l)
|
|
|
|
in repl
|
|
|
|
|
|
|
|
(* Filter `list' according to `predicate'. *)
|
|
|
|
(* ### predicate list -> list' *)
|
|
|
|
let filter p =
|
|
|
|
let rec filter2 =
|
|
|
|
function
|
|
|
|
[] ->
|
|
|
|
[]
|
|
|
|
| a::l ->
|
|
|
|
if p a then
|
1997-05-19 08:42:21 -07:00
|
|
|
a::(filter2 l)
|
1996-11-29 08:55:09 -08:00
|
|
|
else
|
1997-05-19 08:42:21 -07:00
|
|
|
filter2 l
|
1996-11-29 08:55:09 -08:00
|
|
|
in filter2
|
|
|
|
|
|
|
|
(* Find the first element `element' of `list' *)
|
|
|
|
(* so that `predicate element' holds. *)
|
|
|
|
(* ### predicate list -> element *)
|
|
|
|
let find p =
|
|
|
|
let rec find2 =
|
|
|
|
function
|
|
|
|
[] ->
|
1997-05-19 08:42:21 -07:00
|
|
|
raise Not_found
|
1996-11-29 08:55:09 -08:00
|
|
|
| a::l ->
|
1997-05-19 08:42:21 -07:00
|
|
|
if p a then a
|
|
|
|
else find2 l
|
1996-11-29 08:55:09 -08:00
|
|
|
in find2
|
|
|
|
|
|
|
|
(*** Operations on strings. ***)
|
|
|
|
|
|
|
|
(* Return the position of the first occurence of char `c' in string `s' *)
|
|
|
|
(* Raise `Not_found' if `s' does not contain `c'. *)
|
|
|
|
(* ### c s -> pos *)
|
|
|
|
let string_pos s c =
|
|
|
|
let i = ref 0 and l = String.length s in
|
|
|
|
while (!i < l) & (String.get s !i != c) do i := !i + 1 done;
|
|
|
|
if !i = l then raise Not_found;
|
|
|
|
!i
|
|
|
|
|
|
|
|
(* Remove blanks (spaces and tabs) at beginning and end of a string. *)
|
|
|
|
let string_trim s =
|
|
|
|
let l = String.length s and i = ref 0 in
|
|
|
|
while
|
|
|
|
(!i < l) & (match String.get s !i with ' ' | '\t' -> true | _ -> false)
|
|
|
|
do
|
|
|
|
incr i
|
|
|
|
done;
|
|
|
|
let j = ref (l - 1) in
|
|
|
|
while
|
|
|
|
(!j >= !i) & (match String.get s !j with ' ' | '\t' -> true | _ -> false)
|
|
|
|
do
|
|
|
|
decr j
|
|
|
|
done;
|
|
|
|
String.sub s !i (!j - !i + 1)
|
|
|
|
|
|
|
|
(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)
|
|
|
|
|
|
|
|
let isprefix s1 s2 =
|
|
|
|
let l1 = String.length s1 and l2 = String.length s2 in
|
|
|
|
(l1 = l2 && s1 = s2) || (l1 < l2 && s1 = String.sub s2 0 l1)
|
|
|
|
|
|
|
|
(* Split a string at the given delimiter char *)
|
|
|
|
|
|
|
|
let split_string sep str =
|
|
|
|
let rec split i j =
|
|
|
|
if j >= String.length str then
|
|
|
|
if i >= j then [] else [String.sub str i (j-i)]
|
|
|
|
else if str.[j] = sep then
|
|
|
|
if i >= j
|
|
|
|
then skip_sep (j+1)
|
|
|
|
else String.sub str i (j-i) :: skip_sep (j+1)
|
|
|
|
else
|
|
|
|
split i (j+1)
|
|
|
|
and skip_sep j =
|
|
|
|
if j < String.length str && str.[j] = sep
|
|
|
|
then skip_sep (j+1)
|
|
|
|
else split j j
|
|
|
|
in split 0 0
|
|
|
|
|
|
|
|
(*** I/O channels ***)
|
|
|
|
|
|
|
|
type io_channel = {
|
|
|
|
io_in : in_channel;
|
|
|
|
io_out : out_channel;
|
|
|
|
io_fd : Unix.file_descr
|
|
|
|
}
|
|
|
|
|
|
|
|
let io_channel_of_descr fd = {
|
|
|
|
io_in = Unix.in_channel_of_descr fd;
|
|
|
|
io_out = Unix.out_channel_of_descr fd;
|
|
|
|
io_fd = fd
|
|
|
|
}
|
|
|
|
|
|
|
|
let close_io io_channel =
|
|
|
|
(try
|
|
|
|
(try
|
|
|
|
close_out io_channel.io_out
|
|
|
|
with
|
1997-05-19 08:42:21 -07:00
|
|
|
Sys_error _ -> ())
|
|
|
|
with End_of_file -> ()); (* SIGPIPE during flush. *)
|
1996-11-29 08:55:09 -08:00
|
|
|
close_in io_channel.io_in
|
|
|
|
|
|
|
|
let std_io = {
|
|
|
|
io_in = stdin;
|
|
|
|
io_out = stdout;
|
|
|
|
io_fd = Unix.stdin
|
|
|
|
}
|