Skip to content
This repository
tag: v218
Fetching contributors…

Cannot retrieve contributors at this time

file 893 lines (797 sloc) 24.832 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)

(* depends *)
module Char = BaseChar

include String

let compare_int (a:int) b = Pervasives.compare a b

(* {6 Allocation (returns a string)} *)

let insert s pos text =
  let ls = length s in
  if pos > ls then invalid_arg "String.insert" else
    let lt = length text in
    let r = create (ls + lt) in
    unsafe_blit s 0 r 0 pos ;
    unsafe_blit text 0 r pos lt ;
    (* behavior of unsafe_blit is unspecified for negative length *)
    ( if pos < ls then
        unsafe_blit s pos r (pos + lt) (ls - pos) ) ;
    r

let unsafe_sub s p l =
  let r = create l in
  unsafe_blit s p r 0 l ;
  r

let init n f =
  if n >= 0
  then
    let s = create n in
    for i = 0 to pred n do
      unsafe_set s i (f i)
    done ;
    s
  else
    let n = (- n) in
    let s = create n in
    for i = pred n downto 0 do
      unsafe_set s i (f (n-i-1))
    done ;
    s

let fold_init n f acc =
  if n >= 0
  then
    let s = create n in
    let rec aux acc i =
      if i = n then s
      else (
        let c, acc = f acc in
        unsafe_set s i c ;
        aux acc (succ i)
      )
    in aux acc 0
  else
    let n = (- n) in
    let s = create n in
    let rec aux acc i =
      if i < 0 then s
      else (
        let c, acc = f acc in
        unsafe_set s i c ;
        aux acc (pred i)
      )
    in aux acc (pred n)

let of_chars l =
  let s = create (List.length l) in
  let _ =
    (* do not use iteri because it is not in OCaml stdlib
and we want to be as free as possible regarding dependancy
between Base.List and Base.String *)
    let p = ref 0 in
    List.iter
      (fun c ->
         unsafe_set s !p c ;
         incr p) l
  in
  s

let map f s =
  let l = length s in
  init l (fun i -> f (unsafe_get s i))
    (* or inline ? *)
    (* let s' = create l in *)
    (* for i = 0 to pred l do *)
    (* unsafe_set s' i (f (unsafe_get s i)) *)
    (* done ; *)
    (* s' *)

(* replace is implemented after is_substring *)

let citation sep len s =
  let len_s = length s in
  if len_s <= len then s else
    let len_sep = length sep in
    let left = ( len_s - len ) / 2 in
    let len' = left + left + len_sep in
    let s' = create len' in
    unsafe_blit s 0 s' 0 left;
    unsafe_blit sep 0 s' left len_sep;
    unsafe_blit s (len_s - left) s' (left + len_sep) left;
    s'

let random n =
  init n (fun _ -> char_of_int (Random.int 26 + 97))

(* TODO: check and use unsafe_sub *)
let ltrim ?(is_space=Char.is_space) s =
  let l = length s in
  let rec aux p =
    if p = l then ""
    else
      let c = unsafe_get s p in
      if is_space c then aux (succ p)
      else String.sub s p (l - p)
  in
  aux 0

(* TODO: check and use unsafe_sub *)
let rtrim ?(is_space=Char.is_space) s =
  let l = length s in
  let rec aux p =
    if p < 0 then ""
    else
      let c = unsafe_get s p in
      if is_space c then aux (pred p)
      else String.sub s 0 (succ p)
  in
  aux (pred l)

let trim ?(is_space=Char.is_space) s =
  (* do not combine ltrim + rtrim (double allocation) *)
  let l = length s in
  if l = 0 then s else
  let left =
    let rec aux p =
      if p = l then l
      else
        let c = unsafe_get s p in
        if is_space c then aux (succ p)
        else p
    in aux 0 in
  let right =
    let rec aux p =
      if p < 0 then 0
      else
        let c = unsafe_get s p in
        if is_space c then aux (pred p)
        else p
    in aux (pred l) in
  let len = right - left + 1 in
  if len <= 0 then "" else unsafe_sub s left len

(* "s" -> s *)
let strip_quotes s =
  let l = length s in
  if l >= 2 && unsafe_get s 0 = '"' && unsafe_get s (pred l) = '"' then sub s 1 (l - 2)
  else s

let repeat s n =
  if n > 0 then
    let l = length s in
    let len = n * l in
    init len (fun i -> unsafe_get s (i mod l))
  else ""

(* TODO:
1) check and use unsafe_sub
2) see utilisation, and maybe optimized return s if l = len
*)
(* this is better of using sub because sub does the check,
and the error message does not tell we are in a left *)
let left s l =
  if l = 0 then ""
  else
    let len = length s in
    if l > 0 then
      if l > len then invalid_arg "String.left" else
        sub s 0 l
    else (* l =< 0 *)
      let len' = l + len in
      if len' < 0 then invalid_arg "String.left" else
        sub s 0 len'

let right s l =
  if l = 0 then ""
  else
    let len = length s in
    if l > 0 then
      if l > len then invalid_arg "String.right" else
        sub s (String.length s - l) l
    else (* l =< 0 *)
      let len' = l + len in
      if len' < 0 then invalid_arg "String.right" else
        sub s (-l) len'

(* left_at & right_at are implemented after findi & rev_findi *)

let remove_trail s =
  let l = length s in
  let rec aux p =
    if p = 0 then ""
    else
      let pm = pred p in
      let c = unsafe_get s pm in
      if c = '\n' or c = '\r' then aux pm
      else sub s 0 p
  in aux l

(* remove_prefix is implemeted after is_prefix *)

let complete_left n c s =
  if n < 0 then invalid_arg "String.complete_left" else
    let l = length s in
    if l < n then ( make (n - l) c ) ^ s
    else if l > n then unsafe_sub s (l - n) n
    else s

let complete_right n c s =
  if n < 0 then invalid_arg "String.complete_right" else
    let l = length s in
    if l < n then s ^ make (n - l) c
    else if l > n then unsafe_sub s 0 n
    else s

let complete = complete_right

(* TODO: recode using concat_map applied with %identity *)
let sconcat ?(left="") ?(right="") ?nil sep l =
  match l with
    [] -> Option.default (left^right) nil
  | hd :: tl ->
      let len_left = length left
      and len_right = length right
      and len_hd = length hd
      and len_sep = length sep in
      let num = ref 0 and len = ref (len_left + len_right) in
      List.iter (fun s -> incr num; len := !len + length s) l;
      let r = create (!len + len_sep * (!num - 1)) in
      unsafe_blit left 0 r 0 len_left ;
      unsafe_blit hd 0 r len_left len_hd ;
      let pos = ref (len_left + len_hd) in
      List.iter
        (fun s ->
           unsafe_blit sep 0 r !pos len_sep ;
           pos := !pos + len_sep ;
           let len_s = length s in
           unsafe_blit s 0 r !pos len_s ;
           pos := !pos + len_s)
        tl ;
      unsafe_blit right 0 r !pos len_right ;
      r

(* next commit, with the optimized version *)
let rev_sconcat ?(left="") ?(right="") ?nil sep l =
  sconcat ~left ~right ?nil sep (List.rev l)

(* TODO: optimized 1-1 (cf doc) *)
let concat_map ?(left="") ?(right="") ?nil sep f l =
  let l = List.rev_map f l in
  match l with
  | [] -> Option.default (left^right) nil
  | hd :: tl ->
      let len_left = length left
      and len_right = length right
      and len_hd = length hd
      and len_sep = length sep in
      let num = ref 0 and len = ref (len_left + len_right) in
      List.iter (fun s -> incr num; len := !len + length s) l ;
      len := !len + len_sep * (!num - 1) ;
      let r = create !len in
      unsafe_blit left 0 r 0 len_left ;
      let pos = ref (!len - len_right) in
      unsafe_blit right 0 r !pos len_right ;
      pos := !pos - len_hd ;
      unsafe_blit hd 0 r !pos len_hd ;
      List.iter
        (fun s ->
           let len_s = length s in
           pos := !pos - len_sep ;
           unsafe_blit sep 0 r !pos len_sep ;
           pos := !pos - len_s ;
           unsafe_blit s 0 r !pos len_s)
        tl ;
      r

(* Same remark, 1-1 *)
let rev_concat_map ?(left="") ?(right="") ?nil sep f l =
  let l = List.rev_map f l in
  match l with
  | [] -> Option.default (left^right) nil
  | hd :: tl ->
      let len_left = length left
      and len_right = length right
      and len_hd = length hd
      and len_sep = length sep in
      let num = ref 0 and len = ref (len_left + len_right) in
      List.iter (fun s -> incr num; len := !len + length s) l ;
      len := !len + len_sep * (!num - 1) ;
      let r = create !len in
      unsafe_blit left 0 r 0 len_left ;
      let pos = ref (!len - len_right) in
      unsafe_blit right 0 r !pos len_right ;
      pos := len_left ;
      unsafe_blit hd 0 r !pos len_hd ;
      pos := !pos + len_hd ;
      List.iter
        (fun s ->
           let len_s = length s in
           unsafe_blit sep 0 r !pos len_sep ;
           pos := !pos + len_sep ;
           unsafe_blit s 0 r !pos len_s ;
           pos := !pos + len_s)
        tl ;
      r

(* {6 Iterators} *)

let fold f acc s =
  let l = length s in
  let rec aux p acc =
    if p = l then acc
    else
      aux (succ p) (f acc (unsafe_get s p))
  in aux 0 acc

let rev_fold f acc s =
  let l = length s in
  let rec aux p acc =
    if p < 0 then acc
    else aux (pred p) (f acc (unsafe_get s p))
  in
  aux (pred l) acc

let exists f s =
  let l = length s in
  let rec aux p =
    if p = l then false
    else
      let c = unsafe_get s p in
      if f c then true else aux (succ p)
  in aux 0

let for_all f s = not (exists (fun c -> not (f c)) s)

(* {6 Condition (returns a bool) } *)

let equal_insensitive s1 s2 =
  let l = length s1 in
  let rec aux i =
    i=l or (Char.equal_insensitive (unsafe_get s1 i) (unsafe_get s2 i) && aux (succ i))
  in
  l = length s2 && aux 0

let compare_insensitive s1 s2 =
  let l1 = length s1
  and l2 = length s2 in
  let rec aux i =
    if i=l1 or i=l2 then compare_int l1 l2
    else
      let c = Char.compare_insensitive (unsafe_get s1 i) (unsafe_get s2 i) in
      if c = 0 then aux (succ i) else c
  in
  aux 0

let is_word = for_all (fun c -> Char.is_alpha c || c = '_')
let is_int = for_all Char.is_digit

let is_float s =
  let l = length s in
  let rec aux dot p =
    if p = l then true
    else
      let c = unsafe_get s p in
      if Char.is_digit c then aux dot (succ p)
      else
        if c = '.' then
          if dot then false
          else aux true (succ p)
        else false
  in
  aux false 0

(* s is a substring of s1 starting at position p1 *)
let is_substring s s1 p1 =
  if p1 < 0 then invalid_arg "String.is_substring" else
    let l = length s and l1 = length s1 in
    let rec aux p =
      p = l or (
        let pp1 = p1 + p in
        pp1 < l1 && unsafe_get s p = unsafe_get s1 pp1 && aux (succ p)
      )
    in
    aux 0

let is_substring_compare compare s s1 p1 =
  let l = length s
  and l1 = length s1 in
  let rec aux p =
    let pp1 = p1 + p in
    p = l or (pp1 < l1 &&
                compare (unsafe_get s p) (unsafe_get s1 pp1) = 0
        && aux (succ p))
  in
  aux 0

let is_substring_insensitive =
  let f a b = Char.compare (Char.lowercase a) (Char.lowercase b) in
  is_substring_compare f

type replace_expr =
  | RepNode of replace_expr CharMap.t
  | RepLeaf of int * string * int
      (* path_len * replacement_text * replacement_len *)

let prepare_replace_data data =
  List.fold_left (
    fun acc (f, t) ->
      let flen = String.length f in
      let tlen = String.length t in
      let rec create_end expr start stop =
        if start = stop then expr
        else
          let expr = RepNode (CharMap.singleton f.[stop] expr) in
          create_end expr start (pred stop)
      in
      let rec add map i =
        if i < flen then
          let next = f.[i] in
          match CharMap.find_opt next map with
          | Some (RepLeaf _) -> invalid_arg "String.multi_replace"
              (* no overlapping replace *)
          | Some (RepNode node) ->
              CharMap.add next (RepNode (add node (succ i))) map
          | None ->
              CharMap.add next (create_end (RepLeaf (flen, t, tlen)) i (pred flen)) map
        else map
      in add acc 0
  ) CharMap.empty data

(* Replacement algorithm based on a tree (generalisation of old http_encode) *)
let multi_replace s data =
  let data = prepare_replace_data data in
  let len = String.length s in
  let b = Buffer.create (4*len) in
  let rec aux i j =
    if i < len then
      let next_char = s.[i] in
      let default () = Buffer.add_char b next_char; aux (i+1) (j+1) in
      match CharMap.find_opt next_char data with
      | Some (RepLeaf (di,t,dj)) ->
          Buffer.add_string b t; aux (i+di) (j+dj)
      | Some (RepNode e) ->
          let rec sub_aux map p =
            if p < len then
              let sub_char = s.[p] in
              match CharMap.find_opt sub_char map with
              | Some (RepLeaf (di,t,dj)) ->
                  Buffer.add_string b t;
                  aux (i+di) (j+dj)
              | Some (RepNode e) -> sub_aux e (succ p)
              | None -> default ()
            else default ()
          in sub_aux e (succ i)
      | None -> default ()
    else j
  in Buffer.sub b 0 (aux 0 0)

let replace s pat repl = multi_replace s [pat, repl]

(* s contains p at any char. Naif implementation (KMP?) *)
(* less tests as is_contained_from_until p s 0 (length s) *)
let is_contained_from p s ofs =
  let ofs = max 0 ofs in
  let ls = length s and lp = length p in
  let rec aux i =
    if i < ofs then None else
      if is_substring p s i then Some i else aux (pred i)
  in aux (ls - lp)

let is_contained p s = (is_contained_from p s 0) <> None

let is_contained_from_until p s start stop =
  let start = max 0 start in
  let ls = length s and lp = length p in
  if stop - start < lp then None
  else
    let rec aux i =
      if i < start then None else
        if is_substring p s i then Some i else aux (pred i)
    in aux ((min ls stop) - lp)

let is_prefix pre s = is_substring pre s 0
let is_suffix suf s =
  let ofs = length s - length suf in
  if ofs < 0 then false else
    is_substring suf s ofs

(* remove_prefix is implemented out of its classification
because its implementation uses is_prefix *)
(* example: remove_prefix "foo " "foo bar" gives "bar"
raises Not_found if the prefix is not good *)
let remove_prefix pre s =
  if String.length pre = 0 then s
  else
    if is_prefix pre s
    then right s (- (length pre))
    else raise Not_found
let remove_prefix_if_possible pre s =
  if String.length pre = 0 then s
  else
    if is_prefix pre s
    then right s (- (length pre))
    else s

let remove_suffix suf s =
  if is_suffix suf s
  then left s (- (length suf))
  else raise Not_found
let remove_suffix_if_possible suf s =
  if is_suffix suf s
  then left s (- (length suf))
  else s

let is_escaped s index =
  let rec rindex_inv c s i = if i >= 0 && s.[i] = c then rindex_inv c s (i-1) else i in
  ((index-1) - rindex_inv '\\' s (index-1)) mod 2 = 1

(* {6 Search} *)

let find_opt f s =
  let l = length s in
  let rec aux p =
    if p = l then None
    else
      let c = unsafe_get s p in
      if f c then Some c else aux (succ p)
  in aux 0

let findif f s =
  let l = length s in
  let rec aux i =
    if i = l then None
    else
      let c = unsafe_get s i in
      if f c then Some i else aux (succ i)
  in aux 0

let findi (c : char) = findif ((=) c)

let rev_findif f s =
  let l = length s in
  let rec aux i =
    if i < 0 then None
    else
      let c = unsafe_get s i in
      if f c then Some i else aux (pred i)
  in aux (pred l)

let rev_findi (c : char) = rev_findif ((=) c)

(* left_at & right_at are there because of findi *)
(* TODO: check and use unsafe_sub *)
let left_at s c =
  match findi c s with
  | None -> s
  | Some i -> sub s 0 i

let right_at s c =
  match rev_findi c s with
  | None -> s
  | Some i ->
      let i = i+1 in
      sub s i ((length s) - i)

(* {6 Decons} *)

let tail ?(lines=10) s =
  if lines = 0 then "" else begin
    let l = length s in
    let lines = ref lines in
    let pos = ref (pred l) in
    while !pos >= 0 && !lines > 0 do
      if unsafe_get s !pos = '\n' then
        decr lines;
      decr pos
    done;
    incr pos;
    if unsafe_get s !pos = '\n' then incr pos;
    sub s !pos (l - !pos)
  end


let last_char s =
  let len = length s in
  if len = 0 then invalid_arg "String.last_char" else
    unsafe_get s (pred len)

let len_from func str index =
  let len = length str in
  let max = len - index in
  let rec aux cur =
    if cur < max && func str.[index + cur] then aux (succ cur)
    else cur
  in
  aux 0

let hash = Hashtbl.hash

let char_list_of_string s =
  let rec aux acc i =
    if (i < 0) then acc
    else aux ((unsafe_get s i)::acc) (pred i)
  in aux [] (pred (length s))

let rev_char_list_of_string s =
  let len = length s in
  let rec aux acc i =
    if (i >= len) then acc
    else aux ((unsafe_get s i)::acc) (succ i)
  in aux [] 0

(* =========================================================================== *)
(*
Splitting, dicing & slicing
*)

let slice cut str =
  let rec aux pos =
    try
      let i = String.index_from str pos cut in
      if i==pos then aux (succ pos)
      else unsafe_sub str pos (i - pos) :: aux (succ i)
    with Not_found | Invalid_argument _ ->
      let l = String.length str in
      if l==pos then []
      else [ unsafe_sub str pos (l - pos) ]
  in
  aux 0

let slice_chars cut str =
  let rec index_from pos = if String.contains cut str.[pos] then pos else index_from (succ pos) in
  let rec aux pos =
    try
      let i = index_from pos in
      if i==pos then aux (succ pos)
      else unsafe_sub str pos (i - pos) :: aux (succ i)
    with Invalid_argument _ ->
      let l = String.length str in
      if l==pos then []
      else [ unsafe_sub str pos (l - pos) ]
  in
  aux 0

let split_char c s =
  try
    let i = String.index s c in
    unsafe_sub s 0 i, unsafe_sub s (i + 1) (String.length s - i - 1)
  with Not_found -> s, ""

let split_char_last c s =
  try
    let i = String.rindex s c in
    unsafe_sub s 0 i, unsafe_sub s (i + 1) (String.length s - i - 1)
  with Not_found -> s, ""

(* =========================================================================== *)

(* largeur approximative de la chaîne en fonte proportionnelle *)
let width = fold (fun acc x -> acc + Char.width x) 0

(* limite une chaîne à lim caractères et ajoute des '...' si nécessaire *)
let limit lim s =
  if length s > lim then
    let r = sub s 0 lim in
    if lim >= 10 then (
      unsafe_set r (lim - 3) '.' ;
      unsafe_set r (lim - 2) '.' ;
      unsafe_set r (lim - 1) '.'
    ) ;
    r
  else s

let limit_width lim s =
  let l = length s in
  let rec aux sum pos =
    if pos = l or sum >= lim then pos
    else
      let w = Char.width (unsafe_get s pos) in
      aux (sum + w) (succ pos)
  in
  let last = aux 0 0 in
  if last = l then s
  else String.sub s 0 last ^ "..."

let name_of_int n =
  assert (n>0) ;
  let rec aux n =
    let q = n / 26
    and r = n mod 26 in
    if q=0 then make 1 (Char.chr (97+r))
    else (aux (pred q)) ^ (make 1 (Char.chr (97+r)))
  in aux (pred n)

let name_of_int_upper n =
  assert (n>0) ;
  let rec aux n =
    let q = n / 26
    and r = n mod 26 in
    if q=0 then make 1 (Char.chr (65+r))
    else (aux (pred q)) ^ (make 1 (Char.chr (65+r)))
  in aux (pred n)

let remove_first_char x = sub x 1 (pred (length x))

(* example of use: replace_chars "éèà" "eea" "névé" gives "neve" *)
let remove_accents s =
  let sa = "ÀÁÂÃÄÅàáâãäåÒÓÔÕÖØòóôõöøÈÉÊËèéêëÇçÌÍÎÏìíîïÙÚÛÜùúûüÿÑñ"
  and sb = "AAAAAAaaaaaaOOOOOOooooooEEEEeeeeCcIIIIiiiiUUUUuuuuyNn" in
  (* nb: "sa" is twice as long as "sb" since this is utf8. Code below relies on this! *)
  let len = String.length sb in
  let rec aux i res =
    if i >= len then res
    else
      let from = String.sub sa (2*i) 2 in
      let sto = String.sub sb i 1 in
      aux (succ i) (replace res from sto)
  in
  aux 0 s


(** Optimized deleting of trailing whitespace, like emacs M-x delete-trailing-whitespace do *)
let delete_trailing_whitespace s =
  let aux' i =
    let rec aux j =
      if j < i then i - 1
      else
        if Char.is_space (unsafe_get s j) then aux (pred j)
        else j
    in aux
  in
  let rec aux len lines i = match try Some (String.index_from s i '\n') with Not_found -> None with
    | Some j ->
        let j' = aux' i (pred j) in
        let l' = j'-i+1 in
        aux (len+l'+1) ((len, i, l')::lines) (succ j)
    | None ->
        let j' = aux' i (pred (String.length s)) in
        let l' = j'-i+1 in
        (len+l'), (len, i, l'), lines
  in
  let len, (last_line_ir, last_line_is, last_line_l), lines = aux 0 [] 0 in
  let r = String.create len in
  unsafe_blit s last_line_is r last_line_ir last_line_l;
  List.iter (fun (ir, is, l) -> unsafe_blit s is r ir l; unsafe_set r (ir+l) '\n') lines;
  r

let to_hex s =
  let hex_char i = Char.chr (if i <= 9 then i + 48 else i + 87) in
  init (String.length s lsl 1) (
    fun i ->
      hex_char (
        let c = Char.code (String.unsafe_get s (i lsr 1)) in
        if i land 1 = 1 then c land 15
        else c lsr 4
      )
  )

let from_hex s =
  let l = String.length s in
  if l land 1 = 1 then invalid_arg "String.from_hex" ;
  init (l lsr 1) (
    fun i ->
      let i = i lsl 1 in
      Char.chr (
        (Char.hexa_value (String.unsafe_get s i) lsl 4) +
          (Char.hexa_value (String.unsafe_get s (i+1)))
      )
  )

(* {6 Conversion and escaping} *)

let base64encode s =
  let cA,ca,c0 = int_of_char 'A', int_of_char 'a', int_of_char '0' in
  let code i =
    if i < 26 then char_of_int (cA + i)
    else if i < 52 then char_of_int (ca + i - 26)
    else if i < 62 then char_of_int (c0 + i - 52)
    else if i = 62 then '+'
    else if i = 63 then '/'
    else assert false
  in
  let len = String.length s in
  let buf = String.create (4 * ((len + 2) / 3)) in
  let rec aux i =
    let rem = len - i in
    if rem <= 0 then () else
      let c1 = int_of_char (unsafe_get s i)
      and c2 = if rem < 2 then 0 else int_of_char (unsafe_get s (i+1))
      and c3 = if rem < 3 then 0 else int_of_char (unsafe_get s (i+2))
      in
      let e1 = c1 lsr 2
      and e2 = ((c1 land 0x3) lsl 4) lor (c2 lsr 4)
      and e3 = ((c2 land 0xf) lsl 2) lor (c3 lsr 6)
      and e4 = c3 land 0x3f
      in
      let offset = 4 * i / 3 in
      unsafe_set buf offset (code e1);
      unsafe_set buf (offset+1) (code e2);
      unsafe_set buf (offset+2) (if rem < 2 then '=' else code e3);
      unsafe_set buf (offset+3) (if rem < 3 then '=' else code e4);
      aux (i+3)
  in
  aux 0;
  buf

let base64decode s =
  let cA,ca,c0 = int_of_char 'A', int_of_char 'a', int_of_char '0' in
  let decode c =
    if 'A' <= c && c <= 'Z' then int_of_char c - cA
    else if 'a' <= c && c <= 'z' then 26 + int_of_char c - ca
    else if '0' <= c && c <= '9' then 52 + int_of_char c - c0
    else if c = '+' then 62
    else if c = '/' then 63
    else if c = '=' then 0
    else raise (Invalid_argument "base64decode")
  in
  let len = String.length s in
  if len mod 4 <> 0 then raise (Invalid_argument "base64decode");
  let real_len =
    if len = 0 then 0
    else if unsafe_get s (len-2) = '=' then 3 * len / 4 - 2
    else if unsafe_get s (len-1) = '=' then 3 * len / 4 - 1
    else 3 * len / 4
  in
  let buf = String.create real_len in
  let rec aux i =
    if i >= len then () else
      let c1 = decode (unsafe_get s i)
      and c2 = decode (unsafe_get s (i+1))
      and c3 = decode (unsafe_get s (i+2))
      and c4 = decode (unsafe_get s (i+3))
      in
      let e1 = (c1 lsl 2) lor (c2 lsr 4)
      and e2 = ((c2 lsl 4) land 0xf0) lor (c3 lsr 2)
      and e3 = ((c3 lsl 6) land 0xc0) lor c4
      in
      let offset = 3 * i / 4 in
      unsafe_set buf offset (char_of_int e1);
      if offset + 1 < real_len then unsafe_set buf (offset+1) (char_of_int e2);
      if offset + 2 < real_len then unsafe_set buf (offset+2) (char_of_int e3);
      aux (i+4)
  in
  aux 0;
  buf

let escape ~valid_chars ~escape_char s =
  assert (not (valid_chars escape_char)); (* the escape char should be escaped *)
  assert (for_all valid_chars "0123456789abcdef"); (* hexadecimals characters should be valid *)
  if for_all valid_chars s then s else
    (let b = Buffer.create (length s * 3) in (* the string cannot be longer *)
     for i = 0 to length s - 1 do
       let c = s.[i] in
       if valid_chars c then
         Buffer.add_char b c
       else (
         Buffer.add_char b escape_char;
         Buffer.add_string b (Printf.sprintf "%.2x" (Char.code c))
       )
     done;
     Buffer.contents b)

let equal : string -> string -> bool = (=)
Something went wrong with that request. Please try again.