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