package core

  1. Overview
  2. Docs
Industrial strength alternative to OCaml's standard library

Install

Dune Dependency

Authors

Maintainers

Sources

v0.17.1.tar.gz
md5=743a141234e04210e295980f7a78a6d9
sha512=61b415f4fb12c78d30649fff1aabe3a475eea926ce6edb7774031f4dc7f37ea51f5d9337ead6ec73cd93da5fd1ed0f2738c210c71ebc8fe9d7f6135a06bd176f

doc/src/core/make_substring.ml.html

Source file make_substring.ml

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
(* A substring is a contiguous sequence of characters in a string.  We use a
   functor because we want substrings of [string] and [bigstring].
*)

open! Import
open Std_internal
include Make_substring_intf

type bigstring = Bigstring.t

module Blit = struct
  type ('src, 'dst) t = ('src, 'dst) Blit.blito

  let string_bytes ~src ?src_pos ?src_len ~dst ?(dst_pos = 0) () =
    let src_pos, len =
      Ordered_collection_common.get_pos_len_exn
        ()
        ?pos:src_pos
        ?len:src_len
        ~total_length:(String.length src)
    in
    Bytes.From_string.blit ~src ~src_pos ~len ~dst ~dst_pos
  ;;

  let string_string = string_bytes
  let bytes_bytes = Bytes.blito
  let string_bigstring = Bigstring.From_string.blito
  let bytes_bigstring = Bigstring.From_bytes.blito
  let bigstring_bigstring = Bigstring.blito
  let bigstring_string = Bigstring.To_bytes.blito
  let bigstring_bytes = Bigstring.To_bytes.blito
end

(* We can't call the base module [Base] because [@@deriving quickcheck] wants to access
   the [Base] library directly, and we'd be shadowing it. *)
module F (Underlying : Base) : S with type base = Underlying.t = struct
  type base = Underlying.t

  type t =
    { base : Underlying.t
    ; pos : int
    ; len : int
    }
  [@@deriving quickcheck]

  (* note we override the generated [quickcheck_generator] below, once we've defined
     [create] *)

  (* {[
       let invariant t =
         assert (0 <= t.pos);
         assert (0 <= t.len);
         assert (t.pos + t.len <= Base.length t.base);
       ;; ]} *)

  let base t = t.base
  let pos t = t.pos
  let length t = t.len
  let is_empty t = Int.equal t.len 0

  let base_of_string s =
    let len = String.length s in
    let buf = Underlying.create len in
    Underlying.blit_from_string ~src:s ~dst:buf ();
    buf
  ;;

  let base_of_bigstring s =
    let len = Bigstring.length s in
    let buf = Underlying.create len in
    Underlying.blit_from_bigstring ~src:s ~dst:buf ();
    buf
  ;;

  let create ?pos ?len base =
    let pos, len =
      Ordered_collection_common.get_pos_len_exn
        ()
        ?pos
        ?len
        ~total_length:(Underlying.length base)
    in
    { base; pos; len }
  ;;

  let quickcheck_generator =
    let open Quickcheck.Let_syntax in
    let%bind base = Underlying.quickcheck_generator in
    let base_len = Underlying.length base in
    let%bind len = Int.gen_uniform_incl 0 base_len in
    let%bind pos = Int.gen_uniform_incl 0 (base_len - len) in
    return (create ~pos ~len base)
  ;;

  let get_no_bounds_check t i = Underlying.get (base t) (pos t + i)

  let get t i =
    if i >= 0 && i < length t
    then get_no_bounds_check t i
    else raise (Invalid_argument "index out of bounds")
  ;;

  let sub ?pos ?len t =
    let pos, len =
      Ordered_collection_common.get_pos_len_exn () ?pos ?len ~total_length:(length t)
    in
    { base = t.base; pos = t.pos + pos; len }
  ;;

  module Make_arg = struct
    type nonrec t = t

    module Elt = Char

    let fold t ~init ~f =
      let rec go acc i = if i >= length t then acc else go (f acc (get t i)) (i + 1) in
      go init 0 [@nontail]
    ;;

    let iter =
      `Custom
        (fun t ~f ->
          for i = 0 to length t - 1 do
            f (get t i)
          done)
    ;;

    let foldi =
      `Custom
        (fun t ~init ~f ->
          let rec go acc i =
            if i >= length t then acc else go (f i acc (get_no_bounds_check t i)) (i + 1)
          in
          go init 0 [@nontail])
    ;;

    let iteri =
      `Custom
        (fun t ~f ->
          for i = 0 to length t - 1 do
            f i (get_no_bounds_check t i)
          done)
    ;;

    let length = `Custom length
  end

  module C = Indexed_container.Make0 (Make_arg)

  let fold = C.fold
  let iter = C.iter
  let fold_result = C.fold_result
  let fold_until = C.fold_until

  (* [C.to_list] has to construct then reverse the list *)
  let to_list t = List.init (length t) ~f:(get t)
  let to_array = C.to_array
  let find_map = C.find_map
  let find = C.find
  let exists = C.exists
  let for_all = C.for_all
  let mem = C.mem
  let count = C.count
  let sum = C.sum
  let min_elt = C.min_elt
  let max_elt = C.max_elt
  let foldi = C.foldi
  let iteri = C.iteri
  let existsi = C.existsi
  let for_alli = C.for_alli
  let counti = C.counti
  let findi = C.findi
  let find_mapi = C.find_mapi

  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:{ t with len = 0 }
  ;;

  let drop_suffix t n =
    wrap_sub_n
      ~name:"drop_suffix"
      t
      n
      ~pos:0
      ~len:(length t - n)
      ~on_error:{ t with len = 0 }
  ;;

  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 blit_to (type a) (blit : (Underlying.t, a) Blit.t) t ~dst ~dst_pos =
    blit ~src:t.base ~src_pos:t.pos ~src_len:t.len ~dst ~dst_pos ()
  ;;

  let blit_to_string = blit_to Underlying.blit_to_bytes
  let blit_to_bytes = blit_to Underlying.blit_to_bytes
  let blit_to_bigstring = blit_to Underlying.blit_to_bigstring
  let blit_base = blit_to Underlying.blit

  let blit_from ~name (type a) (blit : (a, base) Blit.t) t ~src ~src_pos ~len =
    if len > t.len
    then
      failwithf
        "Substring.blit_from_%s len > substring length : %d > %d"
        name
        len
        t.len
        ();
    blit ~src ~src_pos ~src_len:len ~dst:t.base ~dst_pos:t.pos ()
  ;;

  let blit_from_string = blit_from ~name:"string" Underlying.blit_from_string
  let blit_from_bigstring = blit_from ~name:"bigstring" Underlying.blit_from_bigstring
  let of_base base = { base; pos = 0; len = Underlying.length base }
  let of_string x = of_base (base_of_string x)
  let of_bigstring x = of_base (base_of_bigstring x)

  let make (type a) create (blit : (base, a) Blit.t) t =
    let dst = create t.len in
    blit ~src:t.base ~src_pos:t.pos ~src_len:t.len ~dst ~dst_pos:0 ();
    dst
  ;;

  let to_string x =
    Bytes.unsafe_to_string
      ~no_mutation_while_string_reachable:(make Bytes.create Underlying.blit_to_bytes x)
  ;;

  let to_bigstring = make Bigstring.create Underlying.blit_to_bigstring
  let sexp_of_t x = Sexp.Atom (to_string x)

  let concat_gen create_dst blit_dst ts =
    let len = List.fold ts ~init:0 ~f:(fun len t -> len + length t) in
    let dst = create_dst len in
    ignore
      (List.fold ts ~init:0 ~f:(fun dst_pos t ->
         blit_dst t ~dst ~dst_pos;
         dst_pos + length t)
        : int);
    dst
  ;;

  let concat ts = of_base (concat_gen Underlying.create blit_base ts)

  let concat_string ts =
    Bytes.unsafe_to_string
      ~no_mutation_while_string_reachable:(concat_gen Bytes.create blit_to_string ts)
  ;;

  let concat_bigstring ts = concat_gen Bigstring.create blit_to_bigstring ts
end
OCaml

Innovation. Community. Security.