Source

spotlib / lib / xstring.ml

open Base
open String

let index_opt s c = try Some (index s c) with Not_found -> None

let is_prefix ?from:(pos=0) ~prefix:sub str =
  let str_len = String.length str in
  let sub_len = String.length sub in
  if pos + sub_len > str_len then false
  else 
    let rec iter i = 
      if str.[pos + i] <> sub.[i] then false
      else 
        let i' = i + 1 in
        if i' = sub_len then true
        else iter i'
    in
    iter 0

let index_string_from str pos sub =
  let sub_len = String.length sub in
  if sub_len = 0 then pos 
  else 
    let limit = String.length str - sub_len in
    let rec iter i = 
      if i > limit then raise Not_found
      else if is_prefix str ~from:i ~prefix:sub then i
      else iter (i+1)
    in
    iter pos

let is_postfix ~postfix:sub str =
  is_prefix ~from:(String.length str - String.length sub) ~prefix: sub str

let rec index_rec s lim i c =
  if i >= lim then None else
    if String.unsafe_get s i = c then Some i else index_rec s lim (i +
  1) c
;;
  
let index_from_to s from to_ c =
  let l = String.length s in
  if from < 0 || from > to_ || to_ >= l then 
    invalid_arg "Xstring.index_from_to" 
  else
    index_rec s (to_+1) from c
;;

let chop_newline s =
  let len = String.length s in
  if len > 1 && s.[len-1] = '\n' then
    if len > 2 && s.[len-2] = '\r' then String.sub s 0 (len-2)
    else String.sub s 0 (len-1)
  else s

let sub_from_to s from to_ = 
  if from > to_ then invalid_arg "sub_from_to";
  String.sub s from (to_ - from + 1)

let split_by_newline s =
  let length = String.length s in
  let rec aux st start_pos pos = 
    if pos = length then List.rev st else match s.[pos] with
    | '\r' | '\n' -> 
        let st = String.sub s start_pos (pos - start_pos) :: st in
        skip st (pos+1)
    | _ -> aux st start_pos (pos+1)
  and skip st pos = 
    if pos = length then List.rev st else match s.[pos] with
    | '\r' | '\n' -> skip st (pos+1)
    | _ -> aux st pos (pos+1)
  in
  aux [] 0 0

(* split a string according to char_sep predicate *)
let split char_sep str =
  let len = String.length str in
  if len = 0 then [] else
    let rec skip_sep cur =
      if cur >= len then cur
      else if char_sep str.[cur] then skip_sep (succ cur)
      else cur  in
    let rec split beg cur =
      if cur >= len then 
	if beg = cur then []
	else [String.sub str beg (len - beg)]
      else if char_sep str.[cur] 
	   then 
	     let nextw = skip_sep cur in
	      (String.sub str beg (cur - beg))
		::(split nextw nextw)
	   else split beg (succ cur) in
    let wstart = skip_sep 0 in
    split wstart wstart

let make1 = String.make 1

module Set = Xset.Make(struct type t = string let compare (x:string) y = compare x y end)

module Open = struct
  let chop_newline = chop_newline
  let split_by_newline = split_by_newline
end

let split_at len str = String.sub str 0 len, String.sub str len (String.length str - len)
let take len str = String.sub str 0 len
let drop len str = String.sub str len (String.length str - len)

let scani_left f acc ?from ?to_ s = 
  let from = Option.default from (fun () -> 0) in
  let to_ = Option.default to_ (fun () -> String.length s - 1) in
  let rec fold acc pos = 
    if pos >= to_ then acc
    else 
      match f pos acc & String.unsafe_get s pos with
      | `Continue acc -> fold acc & pos + 1
      | `Stop acc -> acc
  in
  fold acc from
    
let foldi_left f acc s = scani_left f acc s

module Levenshtein = struct
  let (@) = String.unsafe_get

  (* It is not tail recursive, but so far I am happy *)    
  let dist_non_tco s1 s2 =
    let lev lev_fix (i, j) = match i, j with
      | -1, d | d, -1 -> max d 0
      | _ ->
          min (lev_fix (i-1, j) + 1)
          & min (lev_fix (i, j-1) + 1)
                (lev_fix (i-1, j-1) + if s1@i = s2@j then 0 else 1)
    in
    memoize_rec lev (String.length s1 - 1, String.length s2 - 1)
end