(* $Id: xstr_search.ml,v 1.1 1999/06/27 23:03:38 gerd Exp $
 * ----------------------------------------------------------------------
 * Search & Replace
 *)


exception Replace_phrase of (int * string);;


let index_of_substring_from s k_left substr =
  let l = String.length s in
  let lsub = String.length substr in
  let k_right = l - lsub in
  let c = if substr <> "" then substr.[0] else ' ' in
  let rec search k =
    if k <= k_right then begin
      if String.sub s k lsub = substr then
	k
      else
	let k_next = String.index_from s (k+1) c in
	search k_next
    end
    else raise Not_found
  in
  if substr = "" then k_left else search k_left
;;


let rindex_of_substring_from s k_right substr =
  let lsub = String.length substr in
  let c = if substr <> "" then substr.[0] else ' ' in
  let rec search k =
    if k >= 0 then begin
      if String.sub s k lsub = substr then
	k
      else
	let k_next = String.rindex_from s (k-1) c in
	search k_next
    end
    else raise Not_found
  in
  if substr = "" then k_right else search k_right
;;


let index_of_substring s substr =
  index_of_substring_from s 0 substr;;

let rindex_of_substring s substr =
  rindex_of_substring_from s (String.length s - String.length substr) substr;;


let contains_substring s substr =
  try
    let _ = index_of_substring s substr in true
  with
    Not_found -> false
;;


let contains_substring_from s k_left substr = 
  try
    let _ = index_of_substring_from s k_left substr in true
  with
    Not_found -> false
;;


let rcontains_substring_from s k_right substr = 
  try
    let _ = rindex_of_substring_from s k_right substr in true
  with
    Not_found -> false
;;


let indexlist_of_substring s substr =
  let rec enumerate k =
    try
      let pos = index_of_substring_from s k substr in
      pos :: enumerate (pos+1)
    with
      Not_found -> []
  in
  enumerate 0
;;


let rev_concat sep sl =
  (* = String.concat sep (List.rev sl), but more efficient *)

  let lsep = String.length sep in
  let rec get_len v sl =
    match sl with
      [] -> v
    | s :: sl' ->
	get_len (v + lsep + String.length s) sl'
  in

  let len = 
    if sl = [] then 0 else get_len 0 sl - lsep in

  let t = Bytes.create len in
  
  let rec fill_in k sl =
    match sl with
      [] -> ()
    | [ s ] ->
	let s_len = String.length s in
	String.blit s 0 t (k-s_len) s_len
    | s :: sl' ->
	let s_len = String.length s in
	let k' = k - s_len in
	let k'' = k' - lsep in
	String.blit s 0 t k' s_len;
	String.blit sep 0 t k'' lsep;
	fill_in k'' sl'
  in

  fill_in len sl;
  Bytes.to_string t
;;


let replace_char s rule =
  let l = String.length s in
  let rec replace coll k_last k =
    if k < l then begin
      let c = s.[k] in
      try
	let s' = rule c k in
	raise (Replace_phrase (1,s'))
	  (* Alternatively, we could directly invoke 'replace' with some
	   * parameters. But this would be a true recursion, without the
	   * chance to be eliminated.
	   * Would lead to Stack_overflow for large strings.
	   *)
      with
	Match_failure(_,_,_) ->
	  replace coll k_last (k+1)
      |	Not_found ->
	  replace coll k_last (k+1)
      |	Replace_phrase (length, s') ->
	  replace (s' :: String.sub s k_last (k-k_last) :: coll) (k+length) (k+length)
    end
    else
      String.sub s k_last (k-k_last) :: coll
  in
  rev_concat "" (replace [] 0 0)
;;


let replace_substring s substrlist rule =
  let characters =
      (List.map
	 (fun substr ->
	   if substr = "" then
	     failwith "replace_substring"
	   else
	     substr.[0])
	 substrlist) in

  let l = String.length s in

  let rec find k sl =
    match sl with
      [] -> raise Not_found
    | sub :: sl' ->
	let lsub = String.length sub in
	if k <= l - lsub && String.sub s k lsub = sub then
	  let replacement = rule sub k in
	  raise (Replace_phrase(lsub, replacement))
	else
	  raise Not_found
  in

  let rule' c k =
    if List.mem c characters then 
      find k substrlist
    else
      raise Not_found
  in

  let rule'' c0 c k =
    if c = c0 then find k substrlist else raise Not_found in

  if List.length substrlist = 1 then
    replace_char s (rule'' (List.hd substrlist).[0])
  else
    replace_char s rule'
;;


(* ======================================================================
 * History:
 * 
 * $Log: xstr_search.ml,v $
 * Revision 1.1  1999/06/27 23:03:38  gerd
 * 	Initial revision.
 *
 * 
 *)