1(***********************************************************************)
2(*                                                                     *)
3(*                           CIME Caml                                 *)
4(*                                                                     *)
5(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
6(*                                                                     *)
7(*  Copyright 1997 Institut National de Recherche en Informatique et   *)
8(*  en Automatique.  Distributed only by permission.                   *)
9(*                                                                     *)
10(***********************************************************************)
11
12(* $Id: lib_strings.ml,v 1.6 2008/11/05 10:42:35 weis Exp $ *)
13
14(** Returns the sub-string of [s] starting at index [i_start]
15   (inclusively) to index [i_stop] (excluded). *)
16let extract_string s i_start i_stop =
17 let len = i_stop - i_start in
18 String.sub s i_start len;;
19
20(** Test if, starting from index [index], the string [s] matches the
21   pattern [pat] *)
22let starts_by s index pat =
23 let ls = String.length s
24 and lpat = String.length pat in
25 let lim = index + lpat in
26 if index < 0 || ls > 0 && index >= ls then invalid_arg "starts_by" else
27 let rec starts i j =
28  i >= lim || s.[i] = pat.[j] && starts (i + 1) (j + 1) in
29 lim <= ls && starts index 0;;
30
31(** Find the index of character [c] in string [s] starting from index [index],
32   which should be a valid index into [s], and looking forward to the
33   end of string [s]. *)
34let pos_string s index c =
35 let lim = String.length s - 1 in
36 if index < 0 || index > lim then invalid_arg "pos_string" else
37 let rec search i =
38  if i > lim then raise Not_found else
39  if s.[i] = c then i else search (i + 1) in
40 search index;;
41
42(** Find the index of character [c] in string [s] starting from index [index],
43   which should be a valid index into [s], and looking backward to the
44   beginning of string [s]. *)
45let pos_string_rev s index c =
46 let lim = String.length s - 1 in
47 if index < 0 || index > lim then invalid_arg "pos_string_rev" else
48 let rec search i =
49  if i < 0 then raise Not_found else
50  if s.[i] = c then i else search (i - 1) in
51 search index;;
52
53(** Find the sub string of [s] that starts by character [starter] and
54   ends by [stopper], starting from valid index [index]. *)
55let sub_string_from_to s index starter stopper =
56  let i_start =
57    try pos_string s index starter with
58    | Not_found -> failwith (Printf.sprintf "Cannot find %c in %s" starter s) in
59  let i_stop =
60    try pos_string s (i_start + 1) stopper with
61    | Not_found -> failwith (Printf.sprintf "Cannot find %c in %s" stopper s) in
62  extract_string s (i_start + 1) i_stop;;
63
64(** Returns the sub string starting from the position following the
65   last occurrence of character [c] to the end of [s].
66   If [c] is not found, [s] is returned *)
67let from_char_to s c idx =
68 let len = String.length s in
69 if idx >= len then invalid_arg "from_char_to" else
70 let rec search i =
71  if i < 0 then s else
72  if s.[i] = c then extract_string s (i + 1) len
73  else search (i - 1) in
74 search (idx - 1);;
75
76let from_char_to_end s c = from_char_to s c (String.length s - 1);;
77
78let from_to_char s idx c =
79 let len = String.length s in
80 if idx >= len || idx < 0 then invalid_arg "from_char_to" else
81 let rec search i =
82  if i >= len then String.sub s idx (len - idx) else
83  if s.[i] = c then extract_string s idx i
84  else search (i + 1) in
85 search idx;;
86
87let not_enough_room funname len_s len_in =
88  failwith
89    (Printf.sprintf
90       "Lib_strings.%s: cannot fit a string of length %d \
91        into a string of length %d"
92       funname len_s len_in);;
93
94let center_gen c s len_in =
95  let len_s = String.length s in
96  if len_in < len_s then not_enough_room "center" len_s len_in else
97  let idx = (len_in - len_s) / 2 in
98  let b = Bytes.make len_in c in
99  String.blit s 0 b idx len_s;
100  Bytes.to_string b;;
101let center s len_in = center_gen ' ' s len_in;;
102
103let flush_left_gen c s len_in =
104  let len_s = String.length s in
105  if len_in < len_s then not_enough_room "flush_left" len_s len_in else
106  let idx = 0 in
107  let b = Bytes.make len_in c in
108  String.blit s 0 b idx len_s;
109  Bytes.to_string b;;
110let flush_left s len_in = flush_left_gen ' ' s len_in;;
111
112let flush_right_gen c s len_in =
113  let len_s = String.length s in
114  if len_in < len_s then not_enough_room "flush_right" len_s len_in else
115  let idx = len_in - len_s in
116  let b = Bytes.make len_in c in
117  String.blit s 0 b idx len_s;
118  Bytes.to_string b;;
119let flush_right s len_in = flush_right_gen ' ' s len_in;;
120