Source

ocaml-core / base / core / lib / core_string.ml

The branch 'bash' does not exist.
  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
module Array = Caml.ArrayLabels
module Char = Core_char
module String = Caml.StringLabels
module List = Core_list
open Sexplib.Std
open Bin_prot.Std

let phys_equal = Caml.(==)

let invalid_argf = Core_printf.invalid_argf

module T = struct
  type t = string with sexp, bin_io

  let compare = String.compare
  (* = on two strings avoids calling compare_val, which is what happens
     with String.compare *)
  let equal (x : string) y = x = y
end

include T

type elt = char

let max_length = Caml.Sys.max_string_length

(* Standard functions *)
let blit = String.blit
let capitalize = String.capitalize
let concat ?(sep="") l = String.concat ~sep l
let copy = String.copy
let escaped = String.escaped
let fill = String.fill
let index_exn = String.index
let index_from_exn = String.index_from
let length = String.length
let lowercase = String.lowercase
let make = String.make
let rindex_exn = String.rindex
let rindex_from_exn = String.rindex_from
let sub = String.sub
let uncapitalize = String.uncapitalize
let uppercase = String.uppercase
external create : int -> string = "caml_create_string"
external get : string -> int -> char = "%string_safe_get"
external length : string -> int = "%string_length"
external set : string -> int -> char -> unit = "%string_safe_set"

let contains ?pos ?len t char =
  let (pos, len) =
    Ordered_collection_common.get_pos_len_exn ?pos ?len ~length:(length t)
  in
  let last = pos + len in
  let rec loop i = i < last && (t.[i] = char || loop (i + 1)) in
  loop pos
;;

TEST = contains "" 'a' = false
TEST = contains "a" 'a' = true
TEST = contains "a" 'b' = false
TEST = contains "ab" 'a' = true
TEST = contains "ab" 'b' = true
TEST = contains "ab" 'c' = false
TEST = contains "abcd" 'b' ~pos:1 ~len:0 = false
TEST = contains "abcd" 'b' ~pos:1 ~len:1 = true
TEST = contains "abcd" 'c' ~pos:1 ~len:2 = true
TEST = contains "abcd" 'd' ~pos:1 ~len:2 = false
TEST = contains "abcd" 'd' ~pos:1 = true
TEST = contains "abcd" 'a' ~pos:1 = false

let index t char =
  try Some (index_exn t char)
  with Not_found -> None

let rindex t char =
  try Some (rindex_exn t char)
  with Not_found -> None

let index_from t pos char =
  try Some (index_from_exn t pos char)
  with Not_found -> None

let rindex_from t pos char =
  try Some (rindex_from_exn t pos char)
  with Not_found -> None

let id x = x
let of_string = id
let to_string = id

let iter t ~f = String.iter t ~f

let init n ~f =
  if n < 0 then invalid_argf "String.init %d" n ();
  let t = create n in
  for i = 0 to n - 1 do
    t.[i] <- f i;
  done;
  t
;;

(** See {!Core_array.normalize} for the following 4 functions. *)
let normalize t i =
  Ordered_collection_common.normalize ~length_fun:String.length t i
let slice t start stop =
  Ordered_collection_common.slice ~length_fun:String.length ~sub_fun:String.sub
    t start stop

let nget x i =
  x.[normalize x i]
let nset x i v =
  x.[normalize x i] <- v

let invalid_argf = Core_printf.invalid_argf

let to_list s =
  let rec loop acc i =
    if i < 0 then
      acc
    else
      loop (s.[i] :: acc) (i-1)
  in
  loop [] (String.length s - 1)

let to_list_rev s =
  let len = String.length s in
  let rec loop acc i =
    if i = len then
      acc
    else
      loop (s.[i] :: acc) (i+1)
  in
  loop [] 0

(** Efficient string splitting *)

let lsplit2_exn line ~on:delim =
  let pos = String.index line delim in
  (String.sub line ~pos:0 ~len:pos,
   String.sub line ~pos:(pos+1) ~len:(String.length line - pos - 1)
  )

let rsplit2_exn line ~on:delim =
  let pos = String.rindex line delim in
  (String.sub line ~pos:0 ~len:pos,
   String.sub line ~pos:(pos+1) ~len:(String.length line - pos - 1)
  )

let lsplit2 line ~on =
  try Some (lsplit2_exn line ~on) with Not_found -> None

let rsplit2 line ~on =
  try Some (rsplit2_exn line ~on) with Not_found -> None

let split_gen str ~on =
  let rec char_list_mem l (c:char) =
    match l with
    | [] -> false
    | hd::tl -> hd = c || char_list_mem tl c
  in
  let is_delim on (c:char) =
    match on with
    | `char c' -> c = c'
    | `char_list l -> char_list_mem l c
  in
  let len = String.length str in
  let rec loop acc last_pos pos =
    if pos = -1 then
      String.sub str ~pos:0 ~len:last_pos :: acc
    else
      if is_delim on str.[pos] then
        let pos1 = pos + 1 in
        let sub_str = String.sub str ~pos:pos1 ~len:(last_pos - pos1) in
        loop (sub_str :: acc) pos (pos - 1)
    else loop acc last_pos (pos - 1)
  in
  loop [] len (len - 1)
;;

let split str ~on = split_gen str ~on:(`char on) ;;

let split_on_chars str ~on:chars =
  split_gen str ~on:(`char_list chars)
;;

(* [is_suffix s ~suff] returns [true] if the string [s] ends with the suffix [suff] *)
let is_suffix s ~suffix =
  let len_suff = String.length suffix in
  let len_s = String.length s in
  len_s >= len_suff
  && (let rec loop i =
        i = len_suff || (suffix.[len_suff - 1 - i] = s.[len_s - 1 - i] && loop (i + 1))
      in
      loop 0)

let is_prefix s ~prefix =
  let len_pref = String.length prefix in
  String.length s >= len_pref
  && (let rec loop i =
        i = len_pref || (prefix.[i] = s.[i] && loop (i + 1))
      in
      loop 0)
;;

let wrap_sub_n t n ~name ~pos ~len ~on_error =
  if n < 0 then
    invalid_arg (name ^ " expecting nonnegative argument")
  else
    try
      sub t ~pos ~len
    with _ ->
      on_error

let drop_prefix t n = wrap_sub_n ~name:"drop_prefix" t n ~pos:n ~len:(length t - n) ~on_error:""
let drop_suffix t n = wrap_sub_n ~name:"drop_suffix" t n ~pos:0 ~len:(length t - n) ~on_error:""
let prefix t n = wrap_sub_n ~name:"prefix" t n ~pos:0 ~len:n ~on_error:t
let suffix t n = wrap_sub_n ~name:"suffix" t n ~pos:(length t - n) ~len:n ~on_error:t

let lfindi ?(pos=0) t ~f =
  let n = length t in
  let rec loop i =
    if i = n then None
    else if f i t.[i] then Some i
    else loop (i + 1)
  in
  loop pos
;;

TEST = lfindi "bob" ~f:(fun _ c -> 'b' = c) = Some 0
TEST = lfindi ~pos:0 "bob" ~f:(fun _ c -> 'b' = c) = Some 0
TEST = lfindi ~pos:1 "bob" ~f:(fun _ c -> 'b' = c) = Some 2
TEST = lfindi "bob" ~f:(fun _ c -> 'x' = c) = None

let find t ~f =
  match lfindi t ~f:(fun _ c -> f c) with
  | None -> None | Some i -> Some t.[i]

let find_map t ~f =
  let n = length t in
  let rec loop i =
    if i = n then None
    else
      match f t.[i] with
      | None -> loop (i + 1)
      | Some _ as res -> res
  in
  loop 0
;;

let rfindi ?pos t ~f =
  let rec loop i =
    if i < 0 then None
    else begin
      if f i t.[i] then Some i
      else loop (i - 1)
    end
  in
  let pos =
    match pos with
    | Some pos -> pos
    | None -> length t - 1
  in
  loop pos
;;

TEST = rfindi "bob" ~f:(fun _ c -> 'b' = c) = Some 2
TEST = rfindi ~pos:2 "bob" ~f:(fun _ c -> 'b' = c) = Some 2
TEST = rfindi ~pos:1 "bob" ~f:(fun _ c -> 'b' = c) = Some 0
TEST = rfindi "bob" ~f:(fun _ c -> 'x' = c) = None

let last_non_whitespace t = rfindi t ~f:(fun _ c -> not (Char.is_whitespace c))

let rstrip t =
  match last_non_whitespace t with
  | None -> ""
  | Some i ->
    if i = length t - 1
    then t
    else prefix t (i + 1)
;;

let first_non_whitespace t = lfindi t ~f:(fun _ c -> not (Char.is_whitespace c))

let lstrip t =
  match first_non_whitespace t with
  | None -> ""
  | Some 0 -> t
  | Some n -> drop_prefix t n
;;

(* [strip t] could be implemented as [lstrip (rstrip t)].  The implementation
   below saves (at least) a factor of two allocation, by only allocating the
   final result.  This also saves some amount of time. *)
let strip t =
  let length = length t in
  if length = 0
    || not (Char.is_whitespace t.[0] || Char.is_whitespace t.[length - 1])
  then t
  else
    match first_non_whitespace t with
    | None -> ""
    | Some first ->
        match last_non_whitespace t with
        | None -> assert false
        | Some last -> sub t ~pos:first ~len:(last - first + 1)
;;

let mapi t ~f =
  let l = String.length t in
  let t' = String.create l in
  for i = 0 to l - 1 do
    t'.[i] <- f i t.[i]
  done;
  t'

(* repeated code to avoid requiring an extra allocation for a closure on each call. *)
let map t ~f =
  let l = String.length t in
  let t' = String.create l in
  for i = 0 to l - 1 do
    t'.[i] <- f t.[i]
  done;
  t'

let to_array s = Array.init (String.length s) ~f:(fun i -> s.[i])

let tr ~target ~replacement s = map ~f:(fun c -> if c = target then replacement else c) s

let tr_inplace ~target ~replacement s = (* destructive version of tr *)
  for i = 0 to String.length s - 1 do
    if s.[i] = target then s.[i] <- replacement
  done

let exists s ~f =
  let rec loop i = i > 0 && (let i = i - 1 in f s.[i] || loop i) in
  loop (length s)
;;

let for_all s ~f =
  let rec loop i = i = 0 || (let i = i - 1 in f s.[i] && loop i) in
  loop (length s)
;;

let fold t ~init ~f =
  let n = length t in
  let rec loop i ac = if i = n then ac else loop (i + 1) (f ac t.[i]) in
  loop 0 init
;;

let count t ~f = Container.fold_count fold t ~f

let is_empty t = String.length t = 0

let mem ?(equal = Char.(=)) t c =
  let rec loop i = i < length t && (equal c t.[i] || loop (i + 1)) in
  loop 0
;;

let concat_array ?sep ar = concat ?sep (Array.to_list ar)

let concat_map ?sep s ~f = concat_array ?sep (Array.map (to_array s) ~f)

let chop_prefix s ~prefix =
  if is_prefix s ~prefix then
    Some (drop_prefix s (String.length prefix))
  else
    None

let chop_prefix_exn s ~prefix =
  match chop_prefix s ~prefix with
  | Some str -> str
  | None ->
      raise (Invalid_argument
               (Printf.sprintf "Core_string.chop_prefix_exn %S %S" s prefix))

let chop_suffix s ~suffix =
  if is_suffix s ~suffix then
    Some (drop_suffix s (String.length suffix))
  else
    None

let chop_suffix_exn s ~suffix =
  match chop_suffix s ~suffix with
  | Some str -> str
  | None ->
      raise (Invalid_argument
               (Printf.sprintf "Core_string.chop_suffix_exn %S %S" s suffix))

(* The following function returns exactly the same results as the standard hash function
   on strings (it performs exactly the same computation), but it is faster on short
   strings (because we don't have to call the generic C function). For random strings of
   length 4 to 6, it is 40% faster. For strings of length 30 or more, the standard hash
   function is faster.
*)
let hash s =
  let len = String.length s in
  if len = 0 then 0
  else if len > 30 then Hashtbl.hash_param 1 1 s
  else
    let res = ref (int_of_char (String.unsafe_get s 0)) in
    for i = 1 to len - 1 do
      res := !res * 19 + int_of_char (String.unsafe_get s i)
    done;
    !res land 0x3FFFFFFF

module Infix = struct
  let ( </> ) str (start,stop) = slice str start stop
end

include (Hashable.Make_binable (struct
  include T
  let hash = hash
end):Hashable.S_binable with type t := t)
module Map = Core_map.Make_binable (T)
module Set = Core_set.Make_binable (T)

(* for interactive top-levels -- modules deriving from String should have String's pretty
   printer. *)
let pp ppf s = Format.fprintf ppf "%s" s

(* fast version, if we ever need it:
  let concat_array ~sep ar =
  let ar_len = Array.length ar in
  if ar_len = 0 then ""
  else
    let sep_len = String.length sep in
    let res_len_ref = ref (sep_len * (ar_len - 1)) in
    for i = 0 to ar_len - 1 do
      res_len_ref := !res_len_ref + String.length ar.(i)
    done;
    let res = String.create !res_len_ref in
    let str_0 = ar.(0) in
    let len_0 = String.length str_0 in
    String.blit ~src:str_0 ~src_pos:0 ~dst:res ~dst_pos:0 ~len:len_0;
    let pos_ref = ref len_0 in
    for i = 1 to ar_len - 1 do
      let pos = !pos_ref in
      String.blit ~src:sep ~src_pos:0 ~dst:res ~dst_pos:pos ~len:sep_len;
      let new_pos = pos + sep_len in
      let str_i = ar.(i) in
      let len_i = String.length str_i in
      String.blit ~src:str_i ~src_pos:0 ~dst:res ~dst_pos:new_pos ~len:len_i;
      pos_ref := new_pos + len_i
    done;
    res
  *)

let of_char c = String.make 1 c

module Escaping = struct
  exception Map_not_one_to_one with sexp
  let escape_gen_exn ~escapeworthy_map ~escape_char =
    (* Check that if escapeworthy_map is one-to-one. *)
    ignore (List.fold escapeworthy_map ~init:Char.Set.empty ~f:(fun acc (_, c) ->
      if Char.Set.mem acc c then raise Map_not_one_to_one
      else Char.Set.add acc c));
    let escapeworthy = (escape_char, escape_char) :: escapeworthy_map in
    let escapeworthy =
      let a = Array.create 256 (-1) in
      List.iter ~f:(fun (k, v) -> a.(Char.to_int k) <- Char.to_int v)
        escapeworthy;
      a
    in
    (fun s ->
      let len = String.length s in
      let buf = ref None in
      let copied = ref 0 in
      for i = 0 to len - 1 do
        let c = s.[i] in
        let mapped = escapeworthy.(Char.to_int c) in
        if mapped <> (-1) then begin
          let buf =
            match !buf with
            | Some b -> b
            | None ->
              let b = Buffer.create (len + 10) in
              buf := Some b;
              b
          in
          Buffer.add_substring buf s !copied (i - !copied);
          Buffer.add_char buf escape_char;
          Buffer.add_char buf (Char.unsafe_of_int mapped);
          copied := i + 1
        end
      done;
      if !copied = 0 then s
      else begin
        let buf = Option.value_exn !buf in
        Buffer.add_substring buf s !copied (len - !copied);
        Buffer.contents buf
      end)
  ;;

  TEST_MODULE "escape_gen" = struct
    let escape = escape_gen_exn
      ~escapeworthy_map:[('%','p');('^','c')] ~escape_char:'_'

    TEST = escape "foo" = "foo"
    TEST = escape "_" = "__"
    TEST = escape "foo%bar" = "foo_pbar"
    TEST = escape "^foo%" = "_cfoo_p"
    TEST =
      try
        let _escape = escape_gen_exn
          ~escapeworthy_map:[('%','p');('^','c');('$','c')] ~escape_char:'_'
        in
        false
      with Map_not_one_to_one -> true
  end

  let escape ~escapeworthy ~escape_char =
    let escapeworthy_map = List.map ~f:(fun c -> (c, c)) escapeworthy in
    escape_gen_exn ~escapeworthy_map ~escape_char

  let unescape_gen ~map ~escape_char =
    let get_c_for_code code =
      if code = escape_char then code else
        match Core_list.Assoc.find map code with
        | None -> code
        | Some x -> x
    in
    let count_escape_chars s =
      let ctr = ref 0 in
      let i = ref 0 in
      while !i < String.length s - 1 do
        if s.[!i] = escape_char then
          begin
            incr ctr;
            i := !i + 2
          end
        else
          i := !i + 1
      done;
      !ctr
    in
    let really_unescape_string num_escape_char os =
      let ns_length = String.length os - num_escape_char in
      let ns = String.create ns_length in
      let os_pos = ref 0 in
      for i = 0 to ns_length - 1 do
        if os.[!os_pos] = escape_char then
          begin
            ns.[i] <- get_c_for_code (os.[!os_pos + 1]);
            os_pos := !os_pos + 2;
          end
        else
          begin
            ns.[i] <- os.[!os_pos];
            os_pos := !os_pos + 1;
          end
      done;
      ns
    in
    (fun str ->
      let num_escape_chars = count_escape_chars str in
      if num_escape_chars > 0 then really_unescape_string num_escape_chars str
      else str)

  TEST_MODULE "unescape_gen" = struct
    let unescape = unescape_gen ~map:['p','%';'c','^'] ~escape_char:'_'

    TEST = unescape "foo" = "foo"
    TEST = unescape "__" = "_"
    TEST = unescape "foo_pbar" = "foo%bar"
    TEST = unescape "_cfoo_p" = "^foo%"
  end

  let unescape ~escape_char str = unescape_gen ~map:[] ~escape_char str

  TEST_MODULE "unescape" = struct
    let unescape = unescape ~escape_char:'_'
    TEST = unescape "foo" = "foo"
    TEST = unescape "__" = "_"
    TEST = unescape "foo_%bar" = "foo%bar"
    TEST = unescape "_^foo_%" = "^foo%"
  end

  let rec is_char_escaped ~escape_char str pos =
    if pos >= String.length str || pos < 0
    then invalid_argf "is_char_escaped: out of bounds" ();
    if pos = 0 then false
    else begin
      str.[pos - 1] = escape_char
      && (not (is_char_escaped ~escape_char str (pos - 1)))
    end
  ;;

  TEST_MODULE "is_char_escaped" = struct
    let is = is_char_escaped ~escape_char:'_'
    TEST = is "___" 2 = false
    TEST = is "x" 0 = false
    TEST = is "_x" 1 = true
    TEST = is "sadflkas____sfff" 12 = false
  end

  let is_char_literal ~escape_char str pos =
    if pos >= String.length str || pos < 0
    then invalid_argf "is_literal: out of bounds" ();
    let escaped = is_char_escaped ~escape_char str pos in
    let c = str.[pos] in
    (not escaped && c <> escape_char)
    || (escaped && c = escape_char)
  ;;

  TEST_MODULE "is_char_literal" = struct
    let is_char_literal = is_char_literal ~escape_char:'_'
    TEST = is_char_literal "123456" 4 = true
    TEST = is_char_literal "12345_6" 6 = false
    TEST = is_char_literal "12345_6" 5 = false
    TEST = is_char_literal "123__456" 4 = true
    TEST = is_char_literal "123456__" 7 = true
    TEST = is_char_literal "__123456" 1 = true
    TEST = is_char_literal "__123456" 0 = false
    TEST = is_char_literal "__123456" 2 = true
  end

  let string_index_from = index_from
  let rec index_from ~escape_char str pos char =
    match string_index_from str pos char with
    | None -> None
    | Some pos ->
      if is_char_literal ~escape_char str pos then
        Some pos
      else if pos = String.length str - 1 then
        None
      else
        index_from ~escape_char str (pos + 1) char
  ;;

  let index_from_exn ~escape_char str pos char =
    match index_from ~escape_char str pos char with
    | None -> raise Not_found
    | Some pos -> pos
  ;;

  let index ~escape_char str char = index_from ~escape_char str 0 char
  let index_exn ~escape_char str char = index_from_exn ~escape_char str 0 char

  TEST_MODULE "index_from" = struct
    let f = index_from ~escape_char:'_'
    TEST = f "1273456_7789" 3 '7' = Some 9
  end

  let string_rindex_from = rindex_from
  let rec rindex_from ~escape_char str pos char =
    match string_rindex_from str pos char with
    | None -> None
    | Some pos ->
      if is_char_literal ~escape_char str pos then
        Some pos
      else if pos = 0 then
        None
      else
        rindex_from ~escape_char str (pos - 1) char
  ;;

  let rindex_from_exn ~escape_char str pos char =
    match rindex_from ~escape_char str pos char with
    | None -> raise Not_found
    | Some pos -> pos
  ;;

  let rindex ~escape_char str char =
    rindex_from ~escape_char str (String.length str - 1) char
  ;;

  let rindex_exn ~escape_char str char =
    match rindex_from ~escape_char str (String.length str - 1) char with
    | None -> raise Not_found
    | Some pos -> pos
  ;;

  TEST_MODULE "rindex_from" = struct
    let f = rindex_from ~escape_char:'_'
    TEST = f "123456_37839" 9 '3' = Some 2
  end

  let split_gen ~escape_char str ~on =
    let rec char_list_mem l (c:char) =
      match l with
      | [] -> false
      | hd::tl -> hd = c || char_list_mem tl c
    in
    let is_delim on str pos =
      match on with
      | `char c -> str.[pos] = c && is_char_literal ~escape_char str pos
      | `char_list l -> char_list_mem l str.[pos] && is_char_literal ~escape_char str pos
    in
    let len = String.length str in
    let rec loop acc last_pos pos =
      if pos = -1 then
        String.sub str ~pos:0 ~len:last_pos :: acc
      else
        if is_delim on str pos then
          let pos1 = pos + 1 in
          let sub_str = String.sub str ~pos:pos1 ~len:(last_pos - pos1) in
          loop (sub_str :: acc) pos (pos - 1)
        else loop acc last_pos (pos - 1)
    in
    loop [] len (len - 1)
  ;;

  let split str ~on = split_gen str ~on:(`char on) ;;

  let split_on_chars str ~on:chars =
    split_gen str ~on:(`char_list chars)
  ;;

  TEST_MODULE "split_on_gen" = struct
    let split_gen = split_gen ~escape_char:'_' ~on:(`char ',')
    TEST = split_gen "foo,bar,baz" = ["foo"; "bar"; "baz"]
    TEST = split_gen "foo_,bar,baz" = ["foo_,bar"; "baz"]
    TEST = split_gen "foo_,bar_,baz" = ["foo_,bar_,baz"]
    TEST = split_gen "foo__,bar,baz" = ["foo__"; "bar"; "baz"]
    TEST = split_gen "foo,bar,baz_," = ["foo"; "bar"; "baz_,"]
    TEST = split_gen "foo,bar_,baz_,," = ["foo"; "bar_,baz_,"; ""]
  end

  let split2 str ~on ~escape_char f =
    match f ~escape_char str on with
    | None -> None
    | Some pos ->
      Some
        (String.sub str ~pos:0 ~len:pos,
         String.sub str ~pos:(pos + 1) ~len:(String.length str - pos - 1))
  ;;

  let split2_exn str ~on ~escape_char f =
    match split2 str ~on ~escape_char f with
    | None -> raise Not_found
    | Some x -> x
  ;;

  let lsplit2 str ~on ~escape_char = split2 str ~on ~escape_char index
  let rsplit2 str ~on ~escape_char = split2 str ~on ~escape_char rindex
  let lsplit2_exn str ~on ~escape_char = split2_exn str ~on ~escape_char index
  let rsplit2_exn str ~on ~escape_char = split2_exn str ~on ~escape_char rindex

  TEST_MODULE "split2" = struct
    let split2 = split2 ~escape_char:'_' ~on:','
    TEST = split2 "foo_,bar,baz_,0" index = Some ("foo_,bar", "baz_,0")
    TEST = split2 "foo_,bar,baz_,0" rindex = Some ("foo_,bar", "baz_,0")
    TEST = split2 "foo_,bar" index = None
    TEST = split2 "foo_,bar" rindex = None
  end
end
;;

let min (x : t) y = if x < y then x else y
let max (x : t) y = if x > y then x else y
let compare (x : t) y = compare x y
let ascending = compare
let descending x y = compare y x
let ( >= ) x y = (x : t) >= y
let ( <= ) x y = (x : t) <= y
let ( = ) x y = (x : t) = y
let ( > ) x y = (x : t) > y
let ( < ) x y = (x : t) < y
let ( <> ) x y = (x : t) <> y