~npalix/coccinelle/upstream

« back to all changes in this revision

Viewing changes to bundles/pcre/pcre-ocaml/src/pcre.ml.in

  • Committer: Julia Lawall
  • Date: 2023-06-21 12:02:33 UTC
  • mfrom: (5513.1.5)
  • Revision ID: git-v1:ef7f883593f2b52b7fc270bd721835d460bd569b
Merge branch 'master' into enumcast

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(*
 
2
   PCRE-OCAML - Perl Compatibility Regular Expressions for OCaml
 
3
 
 
4
   Copyright (C) 1999-  Markus Mottl
 
5
   email: markus.mottl@gmail.com
 
6
   WWW:   http://www.ocaml.info
 
7
 
 
8
   This library is free software; you can redistribute it and/or
 
9
   modify it under the terms of the GNU Lesser General Public
 
10
   License as published by the Free Software Foundation; either
 
11
   version 2.1 of the License, or (at your option) any later version.
 
12
 
 
13
   This library is distributed in the hope that it will be useful,
 
14
   but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
16
   Lesser General Public License for more details.
 
17
 
 
18
   You should have received a copy of the GNU Lesser General Public
 
19
   License along with this library; if not, write to the Free Software
 
20
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
 
21
*)
 
22
 
 
23
open Stdcompat
 
24
 
 
25
(* Public exceptions and their registration with the C runtime *)
 
26
 
 
27
type error =
 
28
  | Partial
 
29
  | BadPartial
 
30
  | BadPattern of string * int
 
31
  | BadUTF8
 
32
  | BadUTF8Offset
 
33
  | MatchLimit
 
34
  | RecursionLimit
 
35
  | InternalError of string
 
36
 
 
37
exception Error of error
 
38
exception Backtrack
 
39
exception Regexp_or of string * error
 
40
 
 
41
(* Puts exceptions into global C-variables for fast retrieval *)
 
42
external pcre_ocaml_init : unit -> unit = "pcre_ocaml_init"
 
43
 
 
44
(* Registers exceptions with the C runtime and caches polymorphic variants *)
 
45
let () =
 
46
  Callback.register_exception "Pcre.Error" (Error (InternalError ""));
 
47
  Callback.register_exception "Pcre.Backtrack" Backtrack;
 
48
  pcre_ocaml_init ()
 
49
 
 
50
 
 
51
(* Compilation and runtime flags and their conversion functions *)
 
52
 
 
53
type icflag = int
 
54
type irflag = int
 
55
 
 
56
(* Compilation flags *)
 
57
 
 
58
type cflag =
 
59
  [
 
60
  | `CASELESS
 
61
  | `MULTILINE
 
62
  | `DOTALL
 
63
  | `EXTENDED
 
64
  | `ANCHORED
 
65
  | `DOLLAR_ENDONLY
 
66
  | `EXTRA
 
67
  | `UNGREEDY
 
68
  | `UTF8
 
69
  | `NO_UTF8_CHECK
 
70
  | `NO_AUTO_CAPTURE
 
71
  | `AUTO_CALLOUT
 
72
  | `FIRSTLINE
 
73
  ]
 
74
 
 
75
let int_of_cflag = function
 
76
  | `CASELESS -> 0x0001
 
77
  | `MULTILINE -> 0x0002
 
78
  | `DOTALL -> 0x0004
 
79
  | `EXTENDED -> 0x0008
 
80
  | `ANCHORED -> 0x0010
 
81
  | `DOLLAR_ENDONLY -> 0x0020
 
82
  | `EXTRA -> 0x0040
 
83
  | `UNGREEDY -> 0x0200
 
84
  | `UTF8 -> 0x0800
 
85
  | `NO_AUTO_CAPTURE -> 0x1000
 
86
  | `NO_UTF8_CHECK -> 0x2000
 
87
  | `AUTO_CALLOUT -> 0x4000
 
88
  | `FIRSTLINE -> 0x40000
 
89
 
 
90
let coll_icflag icflag flag = int_of_cflag flag lor icflag
 
91
let cflags flags = List.fold_left coll_icflag 0 flags
 
92
 
 
93
let cflag_of_int = function
 
94
  | 0x0001 -> `CASELESS
 
95
  | 0x0002 -> `MULTILINE
 
96
  | 0x0004 -> `DOTALL
 
97
  | 0x0008 -> `EXTENDED
 
98
  | 0x0010 -> `ANCHORED
 
99
  | 0x0020 -> `DOLLAR_ENDONLY
 
100
  | 0x0040 -> `EXTRA
 
101
  | 0x0200 -> `UNGREEDY
 
102
  | 0x0800 -> `UTF8
 
103
  | 0x1000 -> `NO_AUTO_CAPTURE
 
104
  | 0x2000 -> `NO_UTF8_CHECK
 
105
  | 0x4000 -> `AUTO_CALLOUT
 
106
  | 0x40000 -> `FIRSTLINE
 
107
  | _ -> failwith "Pcre.cflag_list: unknown compilation flag"
 
108
 
 
109
let all_cflags =
 
110
  [
 
111
    0x0001; 0x0002; 0x0004; 0x0008; 0x0010; 0x0020;
 
112
    0x0040; 0x0200; 0x0800; 0x1000; 0x2000; 0x4000; 0x40000;
 
113
  ]
 
114
 
 
115
let cflag_list icflags =
 
116
  let coll flag_list flag =
 
117
    if icflags land flag <> 0 then cflag_of_int flag :: flag_list
 
118
    else flag_list in
 
119
  List.fold_left coll [] all_cflags
 
120
 
 
121
 
 
122
(* Runtime flags *)
 
123
 
 
124
type rflag =
 
125
  [
 
126
  | `ANCHORED
 
127
  | `NOTBOL
 
128
  | `NOTEOL
 
129
  | `NOTEMPTY
 
130
  | `PARTIAL
 
131
  ]
 
132
 
 
133
let int_of_rflag = function
 
134
  | `ANCHORED -> 0x0010
 
135
  | `NOTBOL -> 0x0080
 
136
  | `NOTEOL -> 0x0100
 
137
  | `NOTEMPTY -> 0x0400
 
138
  | `PARTIAL -> 0x8000
 
139
 
 
140
let coll_irflag irflag flag = int_of_rflag flag lor irflag
 
141
let rflags flags = List.fold_left coll_irflag 0 flags
 
142
 
 
143
let rflag_of_int = function
 
144
  | 0x0010 -> `ANCHORED
 
145
  | 0x0080 -> `NOTBOL
 
146
  | 0x0100 -> `NOTEOL
 
147
  | 0x0400 -> `NOTEMPTY
 
148
  | 0x8000 -> `PARTIAL
 
149
  | _ -> failwith "Pcre.rflag_list: unknown runtime flag"
 
150
 
 
151
let all_rflags = [0x0010; 0x0080; 0x0100; 0x0400; 0x8000]
 
152
 
 
153
let rflag_list irflags =
 
154
  let coll flag_list flag =
 
155
    if irflags land flag <> 0 then rflag_of_int flag :: flag_list
 
156
    else flag_list in
 
157
  List.fold_left coll [] all_rflags
 
158
 
 
159
 
 
160
(* Information on the PCRE-configuration (build-time options) *)
 
161
 
 
162
external pcre_version : unit -> string = "pcre_version_stub"
 
163
 
 
164
external pcre_config_utf8 : unit -> bool = "pcre_config_utf8_stub" @noalloc@
 
165
 
 
166
external pcre_config_newline :
 
167
  unit -> char = "pcre_config_newline_stub" @noalloc@
 
168
 
 
169
external pcre_config_link_size : unit -> (int @untagged@)
 
170
  = "pcre_config_link_size_stub_bc" "pcre_config_link_size_stub" @noalloc@
 
171
 
 
172
external pcre_config_match_limit :
 
173
  unit -> (int @untagged@)
 
174
  = "pcre_config_match_limit_stub_bc" "pcre_config_match_limit_stub" @noalloc@
 
175
 
 
176
external pcre_config_match_limit_recursion : unit -> (int @untagged@)
 
177
  =
 
178
  "pcre_config_match_limit_recursion_stub_bc"
 
179
  "pcre_config_match_limit_recursion_stub"
 
180
  @noalloc@
 
181
 
 
182
external pcre_config_stackrecurse :
 
183
  unit -> bool = "pcre_config_stackrecurse_stub" @noalloc@
 
184
 
 
185
let version = pcre_version ()
 
186
let config_utf8 = pcre_config_utf8 ()
 
187
let config_newline = pcre_config_newline ()
 
188
let config_link_size = pcre_config_link_size ()
 
189
let config_match_limit = pcre_config_match_limit ()
 
190
let config_match_limit_recursion = pcre_config_match_limit_recursion ()
 
191
let config_stackrecurse = pcre_config_stackrecurse ()
 
192
 
 
193
 
 
194
(* Information on patterns *)
 
195
 
 
196
type firstbyte_info =
 
197
  [ `Char of char
 
198
  | `Start_only
 
199
  | `ANCHORED ]
 
200
 
 
201
type study_stat =
 
202
  [ `Not_studied
 
203
  | `Studied
 
204
  | `Optimal ]
 
205
 
 
206
type regexp
 
207
 
 
208
external options : regexp -> (icflag @untagged@)
 
209
  = "pcre_options_stub_bc" "pcre_options_stub"
 
210
 
 
211
external size : regexp -> (int @untagged@)
 
212
  = "pcre_size_stub_bc" "pcre_size_stub"
 
213
 
 
214
external studysize : regexp -> (int @untagged@)
 
215
  = "pcre_studysize_stub_bc" "pcre_studysize_stub"
 
216
 
 
217
external capturecount : regexp -> (int @untagged@)
 
218
  = "pcre_capturecount_stub_bc" "pcre_capturecount_stub"
 
219
 
 
220
external backrefmax : regexp -> (int @untagged@)
 
221
  = "pcre_backrefmax_stub_bc" "pcre_backrefmax_stub"
 
222
 
 
223
external namecount : regexp -> (int @untagged@)
 
224
  = "pcre_namecount_stub_bc" "pcre_namecount_stub"
 
225
 
 
226
external nameentrysize : regexp -> (int @untagged@)
 
227
  = "pcre_nameentrysize_stub_bc" "pcre_nameentrysize_stub"
 
228
 
 
229
external names : regexp -> string array = "pcre_names_stub"
 
230
external firstbyte : regexp -> firstbyte_info = "pcre_firstbyte_stub"
 
231
external firsttable : regexp -> string option = "pcre_firsttable_stub"
 
232
external lastliteral : regexp -> char option = "pcre_lastliteral_stub"
 
233
external study_stat : regexp -> study_stat = "pcre_study_stat_stub" @noalloc@
 
234
 
 
235
 
 
236
(* Compilation of patterns *)
 
237
 
 
238
type chtables
 
239
 
 
240
external maketables : unit -> chtables = "pcre_maketables_stub"
 
241
 
 
242
(*  Internal use only! *)
 
243
external pcre_study : regexp -> unit = "pcre_study_stub"
 
244
 
 
245
external compile : (icflag  @untagged@) -> chtables option -> string -> regexp
 
246
  = "pcre_compile_stub_bc" "pcre_compile_stub"
 
247
 
 
248
external get_match_limit : regexp -> int option = "pcre_get_match_limit_stub"
 
249
 
 
250
external get_match_limit_recursion : regexp -> int option
 
251
  = "pcre_get_match_limit_recursion_stub"
 
252
 
 
253
(* Internal use only! *)
 
254
external set_imp_match_limit : regexp -> (int @untagged@) -> regexp
 
255
  = "pcre_set_imp_match_limit_stub_bc" "pcre_set_imp_match_limit_stub"
 
256
  @noalloc@
 
257
 
 
258
(* Internal use only! *)
 
259
external set_imp_match_limit_recursion : regexp -> (int @untagged@) -> regexp
 
260
  =
 
261
  "pcre_set_imp_match_limit_recursion_stub_bc"
 
262
  "pcre_set_imp_match_limit_recursion_stub"
 
263
  @noalloc@
 
264
 
 
265
let regexp
 
266
      ?(study = true) ?limit ?limit_recursion
 
267
      ?(iflags = 0) ?flags ?chtables pat =
 
268
  let rex =
 
269
    match flags with
 
270
    | Some flag_list -> compile (cflags flag_list) chtables pat
 
271
    | _ -> compile iflags chtables pat
 
272
  in
 
273
  if study then pcre_study rex;
 
274
  let rex =
 
275
    match limit with
 
276
    | None -> rex
 
277
    | Some lim -> set_imp_match_limit rex lim
 
278
  in
 
279
  match limit_recursion with
 
280
  | None -> rex
 
281
  | Some lim -> set_imp_match_limit_recursion rex lim
 
282
 
 
283
let regexp_or
 
284
      ?study ?limit ?limit_recursion ?(iflags = 0) ?flags ?chtables pats =
 
285
  let check pat =
 
286
    try ignore (regexp ~study:false ~iflags ?flags ?chtables pat)
 
287
    with Error error -> raise (Regexp_or (pat, error))
 
288
  in
 
289
  List.iter check pats;
 
290
  let big_pat =
 
291
    let cnv pat = "(?:" ^ pat ^ ")" in
 
292
    String.concat "|" (List.rev (List.rev_map cnv pats))
 
293
  in
 
294
  regexp ?study ?limit ?limit_recursion ~iflags ?flags ?chtables big_pat
 
295
 
 
296
let bytes_unsafe_blit_string str str_ofs bts bts_ofs len =
 
297
  let str_bts = Bytes.unsafe_of_string str in
 
298
  Bytes.unsafe_blit str_bts str_ofs bts bts_ofs len
 
299
 
 
300
let string_unsafe_sub str ofs len =
 
301
  let res = Bytes.create len in
 
302
  bytes_unsafe_blit_string str ofs res 0 len;
 
303
  Bytes.unsafe_to_string res
 
304
 
 
305
let quote s =
 
306
  let len = String.length s in
 
307
  let buf = Bytes.create (len lsl 1) in
 
308
  let pos = ref 0 in
 
309
  for i = 0 to len - 1 do
 
310
    match String.unsafe_get s i with
 
311
    | '\\' | '^' | '$' | '.' | '[' | '|'
 
312
    | '('  | ')' | '?' | '*' | '+' | '{' as c ->
 
313
      Bytes.unsafe_set buf !pos '\\';
 
314
      incr pos;
 
315
      Bytes.unsafe_set buf !pos c;
 
316
      incr pos
 
317
    | c -> Bytes.unsafe_set buf !pos c; incr pos
 
318
  done;
 
319
  string_unsafe_sub (Bytes.unsafe_to_string buf) 0 !pos
 
320
 
 
321
 
 
322
(* Matching of patterns and subpattern extraction *)
 
323
 
 
324
(* Default regular expression when none is provided by the user *)
 
325
let def_rex = regexp "\\s+"
 
326
 
 
327
type substrings = string * int array
 
328
 
 
329
type callout_data =
 
330
  {
 
331
    callout_number : int;
 
332
    substrings : substrings;
 
333
    start_match : int;
 
334
    current_position : int;
 
335
    capture_top : int;
 
336
    capture_last : int;
 
337
    pattern_position : int;
 
338
    next_item_length : int;
 
339
  }
 
340
 
 
341
type callout = callout_data -> unit
 
342
 
 
343
let get_subject (subj, _) = subj
 
344
 
 
345
let num_of_subs (_, ovector) = Array.length ovector / 3
 
346
 
 
347
let get_offset_start ovector str_num =
 
348
  if str_num < 0 || str_num >= Array.length ovector / 3 then
 
349
    invalid_arg "Pcre.get_offset_start: illegal offset";
 
350
  let offset = str_num lsl 1 in
 
351
  offset, Array.unsafe_get ovector offset
 
352
 
 
353
let get_substring_aux (subj, ovector) offset start =
 
354
  if start < 0 then raise Not_found
 
355
  else
 
356
    string_unsafe_sub subj start (Array.unsafe_get ovector (offset + 1) - start)
 
357
 
 
358
let get_substring (_, ovector as substrings) str_num =
 
359
  let offset, start = get_offset_start ovector str_num in
 
360
  get_substring_aux substrings offset start
 
361
 
 
362
let get_substring_ofs (_subj, ovector) str_num =
 
363
  let offset, start = get_offset_start ovector str_num in
 
364
  if start < 0 then raise Not_found
 
365
  else start, Array.unsafe_get ovector (offset + 1)
 
366
 
 
367
let unsafe_get_substring (_, ovector as substrings) str_num =
 
368
  let offset = str_num lsl 1 in
 
369
  try get_substring_aux substrings offset (Array.unsafe_get ovector offset)
 
370
  with Not_found -> ""
 
371
 
 
372
let get_substrings ?(full_match = true) (_, ovector as substrings) =
 
373
  if full_match then
 
374
    Array.init (Array.length ovector / 3) (unsafe_get_substring substrings)
 
375
  else
 
376
    let len = (Array.length ovector / 3) - 1 in
 
377
    Array.init len (fun n -> unsafe_get_substring substrings (n + 1))
 
378
 
 
379
let unsafe_get_opt_substring (_, ovector as substrings) str_num =
 
380
  let offset = str_num lsl 1 in
 
381
  try
 
382
    let start = Array.unsafe_get ovector offset in
 
383
    let str = get_substring_aux substrings offset start in
 
384
    Some str
 
385
  with Not_found -> None
 
386
 
 
387
let get_opt_substrings ?(full_match = true) (_, ovector as substrings) =
 
388
  if full_match then
 
389
    Array.init (Array.length ovector / 3) (unsafe_get_opt_substring substrings)
 
390
  else
 
391
    let len = (Array.length ovector / 3) - 1 in
 
392
    Array.init len (fun n -> unsafe_get_opt_substring substrings (n + 1))
 
393
 
 
394
external get_stringnumber : regexp -> string -> (int @untagged@)
 
395
  = "pcre_get_stringnumber_stub_bc" "pcre_get_stringnumber_stub"
 
396
 
 
397
let get_named_substring rex name substrings =
 
398
  get_substring substrings (get_stringnumber rex name)
 
399
 
 
400
let get_named_substring_ofs rex name substrings =
 
401
  get_substring_ofs substrings (get_stringnumber rex name)
 
402
 
 
403
external unsafe_pcre_exec :
 
404
  (irflag @untagged@) ->
 
405
  regexp ->
 
406
  pos : (int @untagged@) ->
 
407
  subj_start : (int @untagged@) ->
 
408
  subj : string ->
 
409
  int array ->
 
410
  callout option ->
 
411
  unit = "pcre_exec_stub_bc" "pcre_exec_stub"
 
412
 
 
413
let make_ovector rex =
 
414
  let subgroups1 = capturecount rex + 1 in
 
415
  let subgroups2 = subgroups1 lsl 1 in
 
416
  subgroups2, Array.make (subgroups1 + subgroups2) 0
 
417
 
 
418
let pcre_exec ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
 
419
              ?callout subj =
 
420
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
421
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
422
  let _, ovector = make_ovector rex in
 
423
  unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
 
424
  ovector
 
425
 
 
426
let exec ?iflags ?flags ?rex ?pat ?pos ?callout subj =
 
427
  subj, pcre_exec ?iflags ?flags ?rex ?pat ?pos ?callout subj
 
428
 
 
429
let next_match ?iflags ?flags ?rex ?pat ?(pos = 0) ?callout (subj, ovector) =
 
430
  let pos = Array.unsafe_get ovector 1 + pos in
 
431
  let subj_len = String.length subj in
 
432
  if pos < 0 || pos > subj_len then
 
433
    invalid_arg "Pcre.next_match: illegal offset";
 
434
  subj, pcre_exec ?iflags ?flags ?rex ?pat ~pos ?callout subj
 
435
 
 
436
let rec copy_lst ar n = function
 
437
  | [] -> ar
 
438
  | h :: t -> Array.unsafe_set ar n h; copy_lst ar (n - 1) t
 
439
 
 
440
let exec_all ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?pos ?callout subj =
 
441
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
442
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
443
  let (_, ovector as sstrs) = exec ~iflags ~rex ?pos ?callout subj in
 
444
  let null_flags = iflags lor 0x0400 in
 
445
  let subj_len = String.length subj in
 
446
  let rec loop pos (subj, ovector as sstrs) n lst =
 
447
    let maybe_ovector =
 
448
      try
 
449
        let first = Array.unsafe_get ovector 0 in
 
450
        if first = pos && Array.unsafe_get ovector 1 = pos then
 
451
          if pos = subj_len then None
 
452
          else Some (pcre_exec ~iflags:null_flags ~rex ~pos ?callout subj)
 
453
        else Some (pcre_exec ~iflags ~rex ~pos ?callout subj)
 
454
      with Not_found -> None in
 
455
    match maybe_ovector with
 
456
    | Some ovector ->
 
457
        let new_pos = Array.unsafe_get ovector 1 in
 
458
        loop new_pos (subj, ovector) (n + 1) (sstrs :: lst)
 
459
    | None -> copy_lst (Array.make (n + 1) sstrs) (n - 1) lst in
 
460
  loop (Array.unsafe_get ovector 1) sstrs 0 []
 
461
 
 
462
let extract ?iflags ?flags ?rex ?pat ?pos ?full_match ?callout subj =
 
463
  get_substrings ?full_match (exec ?iflags ?flags ?rex ?pat ?pos ?callout subj)
 
464
 
 
465
let extract_opt ?iflags ?flags ?rex ?pat ?pos ?full_match ?callout subj =
 
466
  get_opt_substrings
 
467
    ?full_match (exec ?iflags ?flags ?rex ?pat ?pos ?callout subj)
 
468
 
 
469
let extract_all ?iflags ?flags ?rex ?pat ?pos ?full_match ?callout subj =
 
470
  let many_sstrs = exec_all ?iflags ?flags ?rex ?pat ?pos ?callout subj in
 
471
  Array.map (get_substrings ?full_match) many_sstrs
 
472
 
 
473
let extract_all_opt ?iflags ?flags ?rex ?pat ?pos ?full_match ?callout subj =
 
474
  let many_sstrs = exec_all ?iflags ?flags ?rex ?pat ?pos ?callout subj in
 
475
  Array.map (get_opt_substrings ?full_match) many_sstrs
 
476
 
 
477
let pmatch ?iflags ?flags ?rex ?pat ?pos ?callout subj =
 
478
  try ignore (pcre_exec ?iflags ?flags ?rex ?pat ?pos ?callout subj); true
 
479
  with Not_found -> false
 
480
 
 
481
 
 
482
(* String substitution *)
 
483
 
 
484
(* Elements of a substitution pattern *)
 
485
type subst =
 
486
  | SubstString of int * int (* Denotes a substring in the substitution *)
 
487
  | Backref of int           (* nth backreference ($0 is program name!) *)
 
488
  | Match                    (* The whole matched string *)
 
489
  | PreMatch                 (* The string before the match *)
 
490
  | PostMatch                (* The string after the match *)
 
491
  | LastParenMatch           (* The last matched group *)
 
492
 
 
493
(* Information on substitution patterns *)
 
494
type substitution = string     (* The substitution string *)
 
495
                  * int        (* Highest group number of backreferences *)
 
496
                  * bool       (* Makes use of "LastParenMatch" *)
 
497
                  * subst list (* The list of substitution elements *)
 
498
 
 
499
(* Only used internally in "subst" *)
 
500
exception FoundAt of int
 
501
 
 
502
let zero = Char.code '0'
 
503
 
 
504
let subst str =
 
505
  let max_br = ref 0 in
 
506
  let with_lp = ref false in
 
507
  let lix = String.length str - 1 in
 
508
  let rec loop acc n =
 
509
    if lix < n then acc
 
510
    else
 
511
      try
 
512
        for i = n to lix do
 
513
          if String.unsafe_get str i = '$' then raise (FoundAt i)
 
514
        done;
 
515
        SubstString (n, lix - n + 1) :: acc
 
516
      with FoundAt i ->
 
517
        if i = lix then SubstString (n, lix - n + 1) :: acc
 
518
        else
 
519
          let i1 = i + 1 in
 
520
          let acc = if n = i then acc else SubstString (n, i - n) :: acc in
 
521
          match String.unsafe_get str i1 with
 
522
          | '0'..'9' as c ->
 
523
              let subpat_nr = ref (Char.code c - zero) in
 
524
              (try
 
525
                for j = i1 + 1 to lix do
 
526
                  let c = String.unsafe_get str j in
 
527
                  if c >= '0' && c <= '9' then
 
528
                    subpat_nr := 10 * !subpat_nr + Char.code c - zero
 
529
                  else raise (FoundAt j)
 
530
                done;
 
531
                max_br := max !subpat_nr !max_br;
 
532
                Backref !subpat_nr :: acc
 
533
              with FoundAt j ->
 
534
                max_br := max !subpat_nr !max_br;
 
535
                loop (Backref !subpat_nr :: acc) j)
 
536
          | '!'  -> loop acc (i1 + 1)
 
537
          | '$'  -> loop (SubstString (i1, 1) :: acc) (i1 + 1)
 
538
          | '&'  -> loop (Match :: acc) (i1 + 1)
 
539
          | '`'  -> loop (PreMatch :: acc) (i1 + 1)
 
540
          | '\'' -> loop (PostMatch :: acc) (i1 + 1)
 
541
          | '+'  ->
 
542
              with_lp := true;
 
543
              loop (LastParenMatch :: acc) (i1 + 1)
 
544
          | _    -> loop acc i1 in
 
545
  let subst_lst = loop [] 0 in
 
546
  str, !max_br, !with_lp, subst_lst
 
547
 
 
548
let def_subst = subst ""
 
549
 
 
550
(* Calculates a list of tuples (str, offset, len) which contain
 
551
   substrings to be copied on substitutions. Internal use only! *)
 
552
let calc_trans_lst subgroups2 ovector subj templ subst_lst =
 
553
  let prefix_len = Array.unsafe_get ovector 0 in
 
554
  let last = Array.unsafe_get ovector 1 in
 
555
  let coll (res_len, trans_lst as accu) =
 
556
    let return_lst (_str, _ix, len as el) =
 
557
      if len = 0 then accu else res_len + len, el :: trans_lst in
 
558
    function
 
559
    | SubstString (ix, len) -> return_lst (templ, ix, len)
 
560
    | Backref 0 ->
 
561
        let prog_name = Sys.argv.(0) in
 
562
        return_lst (prog_name, 0, String.length prog_name)
 
563
    | Backref n ->
 
564
        let offset = n lsl 1 in
 
565
        let start = Array.unsafe_get ovector offset in
 
566
        let len = Array.unsafe_get ovector (offset + 1) - start in
 
567
        return_lst (subj, start, len)
 
568
    | Match -> return_lst (subj, prefix_len, last - prefix_len)
 
569
    | PreMatch -> return_lst (subj, 0, prefix_len)
 
570
    | PostMatch -> return_lst (subj, last, String.length subj - last)
 
571
    | LastParenMatch ->
 
572
        let subgroups2_2 = subgroups2 - 2 in
 
573
        let pos = ref subgroups2_2 in
 
574
        let ix = ref (Array.unsafe_get ovector subgroups2_2) in
 
575
        while !ix < 0 do
 
576
          let pos_2 = !pos - 2 in
 
577
          pos := pos_2;
 
578
          ix := Array.unsafe_get ovector pos_2
 
579
        done;
 
580
        return_lst (subj, !ix, Array.unsafe_get ovector (!pos + 1) - !ix) in
 
581
  List.fold_left coll (0, []) subst_lst
 
582
 
 
583
let replace ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
584
            ?(pos = 0) ?(itempl = def_subst) ?templ ?callout subj =
 
585
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
586
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
587
  let templ, max_br, with_lp, subst_lst =
 
588
    match templ with
 
589
    | Some str -> subst str
 
590
    | _ -> itempl in
 
591
  let subj_len = String.length subj in
 
592
  if pos < 0 || pos > subj_len then invalid_arg "Pcre.replace: illegal offset";
 
593
  let subgroups2, ovector = make_ovector rex in
 
594
  let nsubs = (subgroups2 lsr 1) - 1 in
 
595
  if max_br > nsubs then
 
596
    failwith "Pcre.replace: backreference denotes nonexistent subpattern";
 
597
  if with_lp && nsubs = 0 then failwith "Pcre.replace: no backreferences";
 
598
  let rec loop full_len trans_lsts cur_pos =
 
599
    if
 
600
      cur_pos > subj_len ||
 
601
      try
 
602
        unsafe_pcre_exec
 
603
          iflags rex ~pos:cur_pos ~subj_start:0 ~subj
 
604
          ovector callout;
 
605
        false
 
606
      with Not_found -> true
 
607
    then
 
608
      let postfix_len = max (subj_len - cur_pos) 0 in
 
609
      let left = pos + full_len in
 
610
      let res = Bytes.create (left + postfix_len) in
 
611
      bytes_unsafe_blit_string subj 0 res 0 pos;
 
612
      bytes_unsafe_blit_string subj cur_pos res left postfix_len;
 
613
      let inner_coll ofs (templ, ix, len) =
 
614
        bytes_unsafe_blit_string templ ix res ofs len; ofs + len in
 
615
      let coll ofs (res_len, trans_lst) =
 
616
        let new_ofs = ofs - res_len in
 
617
        let _ = List.fold_left inner_coll new_ofs trans_lst in
 
618
        new_ofs in
 
619
      let _ = List.fold_left coll left trans_lsts in
 
620
      Bytes.unsafe_to_string res
 
621
    else
 
622
      let first = Array.unsafe_get ovector 0 in
 
623
      let len = first - cur_pos in
 
624
      let res_len, _ as trans_lst_el =
 
625
        calc_trans_lst subgroups2 ovector subj templ subst_lst in
 
626
      let trans_lsts =
 
627
        if len > 0 then
 
628
          trans_lst_el :: (len, [(subj, cur_pos, len)]) :: trans_lsts
 
629
        else trans_lst_el :: trans_lsts in
 
630
      let full_len = full_len + len + res_len in
 
631
      let next = first + 1 in
 
632
      let last = Array.unsafe_get ovector 1 in
 
633
      if last < next then
 
634
        if first < subj_len then
 
635
          let new_trans_lsts = (1, [(subj, cur_pos + len, 1)]) :: trans_lsts in
 
636
          loop (full_len + 1) new_trans_lsts next
 
637
        else loop full_len trans_lsts next
 
638
      else loop full_len trans_lsts last in
 
639
  loop 0 [] pos
 
640
 
 
641
let qreplace ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
642
             ?(pos = 0) ?(templ = "") ?callout subj =
 
643
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
644
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
645
  let subj_len = String.length subj in
 
646
  if pos < 0 || pos > subj_len then invalid_arg "Pcre.qreplace: illegal offset";
 
647
  let templ_len = String.length templ in
 
648
  let _, ovector = make_ovector rex in
 
649
  let rec loop full_len subst_lst cur_pos =
 
650
    if
 
651
      cur_pos > subj_len ||
 
652
      try
 
653
        unsafe_pcre_exec
 
654
          iflags rex ~pos:cur_pos ~subj_start:0 ~subj ovector callout;
 
655
        false
 
656
      with Not_found -> true
 
657
    then
 
658
      let postfix_len = max (subj_len - cur_pos) 0 in
 
659
      let left = pos + full_len in
 
660
      let res = Bytes.create (left + postfix_len) in
 
661
      bytes_unsafe_blit_string subj 0 res 0 pos;
 
662
      bytes_unsafe_blit_string subj cur_pos res left postfix_len;
 
663
      let coll ofs = function
 
664
        | Some (substr, ix, len) ->
 
665
            let new_ofs = ofs - len in
 
666
            bytes_unsafe_blit_string substr ix res new_ofs len;
 
667
            new_ofs
 
668
        | None ->
 
669
            let new_ofs = ofs - templ_len in
 
670
            bytes_unsafe_blit_string templ 0 res new_ofs templ_len;
 
671
            new_ofs in
 
672
      let _ = List.fold_left coll left subst_lst in
 
673
      Bytes.unsafe_to_string res
 
674
    else
 
675
      let first = Array.unsafe_get ovector 0 in
 
676
      let len = first - cur_pos in
 
677
      let subst_lst =
 
678
        if len > 0 then None :: Some (subj, cur_pos, len) :: subst_lst
 
679
        else None :: subst_lst in
 
680
      let last = Array.unsafe_get ovector 1 in
 
681
      let full_len = full_len + len + templ_len in
 
682
      let next = first + 1 in
 
683
      if last < next then
 
684
        if first < subj_len then
 
685
          loop (full_len + 1) (Some (subj, cur_pos + len, 1) :: subst_lst) next
 
686
        else loop full_len subst_lst next
 
687
      else loop full_len subst_lst last in
 
688
  loop 0 [] pos
 
689
 
 
690
let substitute_substrings ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
691
                          ?(pos = 0) ?callout ~subst subj =
 
692
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
693
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
694
  let subj_len = String.length subj in
 
695
  if pos < 0 || pos > subj_len then invalid_arg "Pcre.substitute: illegal offset";
 
696
  let _, ovector = make_ovector rex in
 
697
  let rec loop full_len subst_lst cur_pos =
 
698
    if
 
699
      cur_pos > subj_len ||
 
700
      try
 
701
        unsafe_pcre_exec
 
702
          iflags rex ~pos:cur_pos ~subj_start:0 ~subj ovector callout;
 
703
        false
 
704
      with Not_found -> true
 
705
    then
 
706
      let postfix_len = max (subj_len - cur_pos) 0 in
 
707
      let left = pos + full_len in
 
708
      let res = Bytes.create (left + postfix_len) in
 
709
      bytes_unsafe_blit_string subj 0 res 0 pos;
 
710
      bytes_unsafe_blit_string subj cur_pos res left postfix_len;
 
711
      let coll ofs (templ, ix, len) =
 
712
        let new_ofs = ofs - len in
 
713
        bytes_unsafe_blit_string templ ix res new_ofs len;
 
714
        new_ofs in
 
715
      let _ = List.fold_left coll left subst_lst in
 
716
      Bytes.unsafe_to_string res
 
717
    else
 
718
      let first = Array.unsafe_get ovector 0 in
 
719
      let len = first - cur_pos in
 
720
      let templ = subst (subj, ovector) in
 
721
      let templ_len = String.length templ in
 
722
      let subst_lst =
 
723
        if len > 0 then
 
724
          (templ, 0, templ_len) :: (subj, cur_pos, len) :: subst_lst
 
725
        else (templ, 0, templ_len) :: subst_lst in
 
726
      let last = Array.unsafe_get ovector 1 in
 
727
      let full_len = full_len + len + templ_len in
 
728
      let next = first + 1 in
 
729
      if last < next then
 
730
        if first < subj_len then
 
731
          loop (full_len + 1) ((subj, cur_pos + len, 1) :: subst_lst) next
 
732
        else loop full_len subst_lst next
 
733
      else loop full_len subst_lst last in
 
734
  loop 0 [] pos
 
735
 
 
736
let substitute ?iflags ?flags ?rex ?pat ?pos ?callout ~subst:str_subst subj =
 
737
  let subst (subj, ovector) =
 
738
    let first = Array.unsafe_get ovector 0 in
 
739
    let last = Array.unsafe_get ovector 1 in
 
740
    str_subst (string_unsafe_sub subj first (last - first)) in
 
741
  substitute_substrings ?iflags ?flags ?rex ?pat ?pos ?callout ~subst subj
 
742
 
 
743
let replace_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat ?(pos = 0)
 
744
                  ?(itempl = def_subst) ?templ ?callout subj =
 
745
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
746
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
747
  let templ, max_br, with_lp, subst_lst =
 
748
    match templ with
 
749
    | Some str -> subst str
 
750
    | _ -> itempl in
 
751
  let subgroups2, ovector = make_ovector rex in
 
752
  let nsubs = (subgroups2 lsr 1) - 1 in
 
753
  if max_br > nsubs then
 
754
    failwith "Pcre.replace_first: backreference denotes nonexistent subpattern";
 
755
  if with_lp && nsubs = 0 then failwith "Pcre.replace_first: no backreferences";
 
756
  try
 
757
    unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
 
758
    let res_len, trans_lst =
 
759
      calc_trans_lst subgroups2 ovector subj templ subst_lst in
 
760
    let first = Array.unsafe_get ovector 0 in
 
761
    let last = Array.unsafe_get ovector 1 in
 
762
    let rest = String.length subj - last in
 
763
    let res = Bytes.create (first + res_len + rest) in
 
764
    bytes_unsafe_blit_string subj 0 res 0 first;
 
765
    let coll ofs (templ, ix, len) =
 
766
      bytes_unsafe_blit_string templ ix res ofs len; ofs + len in
 
767
    let ofs = List.fold_left coll first trans_lst in
 
768
    bytes_unsafe_blit_string subj last res ofs rest;
 
769
    Bytes.unsafe_to_string res
 
770
  with Not_found -> subj
 
771
 
 
772
let qreplace_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
773
                   ?(pos = 0) ?(templ = "") ?callout subj =
 
774
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
775
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
776
  let _, ovector = make_ovector rex in
 
777
  try
 
778
    unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
 
779
    let first = Array.unsafe_get ovector 0 in
 
780
    let last = Array.unsafe_get ovector 1 in
 
781
    let len = String.length templ in
 
782
    let rest = String.length subj - last in
 
783
    let postfix_start = first + len in
 
784
    let res = Bytes.create (postfix_start + rest) in
 
785
    bytes_unsafe_blit_string subj 0 res 0 first;
 
786
    bytes_unsafe_blit_string templ 0 res first len;
 
787
    bytes_unsafe_blit_string subj last res postfix_start rest;
 
788
    Bytes.unsafe_to_string res
 
789
  with Not_found -> subj
 
790
 
 
791
let substitute_substrings_first ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
792
                                ?(pos = 0) ?callout ~subst subj =
 
793
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
794
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
795
  let _, ovector = make_ovector rex in
 
796
  try
 
797
    unsafe_pcre_exec iflags rex ~pos ~subj_start:0 ~subj ovector callout;
 
798
    let subj_len = String.length subj in
 
799
    let prefix_len = Array.unsafe_get ovector 0 in
 
800
    let last = Array.unsafe_get ovector 1 in
 
801
    let templ = subst (subj, ovector) in
 
802
    let postfix_len = subj_len - last in
 
803
    let templ_len = String.length templ in
 
804
    let postfix_start = prefix_len + templ_len in
 
805
    let res = Bytes.create (postfix_start + postfix_len) in
 
806
    bytes_unsafe_blit_string subj 0 res 0 prefix_len;
 
807
    bytes_unsafe_blit_string templ 0 res prefix_len templ_len;
 
808
    bytes_unsafe_blit_string subj last res postfix_start postfix_len;
 
809
    Bytes.unsafe_to_string res
 
810
  with Not_found -> subj
 
811
 
 
812
let substitute_first ?iflags ?flags ?rex ?pat ?pos
 
813
                     ?callout ~subst:str_subst subj =
 
814
  let subst (subj, ovector) =
 
815
    let first = Array.unsafe_get ovector 0 in
 
816
    let last = Array.unsafe_get ovector 1 in
 
817
    str_subst (string_unsafe_sub subj first (last - first)) in
 
818
  substitute_substrings_first
 
819
    ?iflags ?flags ?rex ?pat ?pos ?callout ~subst subj
 
820
 
 
821
 
 
822
(* Splitting *)
 
823
 
 
824
let internal_psplit flags rex max pos callout subj =
 
825
  let subj_len = String.length subj in
 
826
  if subj_len = 0 then []
 
827
  else if max = 1 then [subj]
 
828
  else
 
829
    let subgroups2, ovector = make_ovector rex in
 
830
 
 
831
    (* Adds contents of subgroups to the string accumulator *)
 
832
    let handle_subgroups strs =
 
833
      let strs = ref strs in
 
834
      let i = ref 2 in
 
835
      while !i < subgroups2 do
 
836
        let first = Array.unsafe_get ovector !i in
 
837
        incr i;
 
838
        let last = Array.unsafe_get ovector !i in
 
839
        let str =
 
840
          if first < 0 then ""
 
841
          else string_unsafe_sub subj first (last - first) in
 
842
        strs := str :: !strs; incr i
 
843
      done;
 
844
      !strs in
 
845
 
 
846
    (* Performs the recursive split *)
 
847
    let rec loop strs cnt pos prematch =
 
848
      let len = subj_len - pos in
 
849
      if len < 0 then strs
 
850
      else
 
851
        (* Checks termination due to max restriction *)
 
852
        if cnt = 0 then
 
853
          if prematch &&
 
854
            try
 
855
              unsafe_pcre_exec
 
856
                flags rex ~pos ~subj_start:pos ~subj ovector callout;
 
857
              true
 
858
            with Not_found -> false
 
859
          then
 
860
            let last = Array.unsafe_get ovector 1 in
 
861
            let strs = handle_subgroups strs in
 
862
            string_unsafe_sub subj last (subj_len - last) :: strs
 
863
          else string_unsafe_sub subj pos len :: strs
 
864
 
 
865
        (* Calculates next accumulator state for splitting *)
 
866
        else
 
867
          if
 
868
            try
 
869
              unsafe_pcre_exec
 
870
                flags rex ~pos ~subj_start:pos ~subj ovector callout;
 
871
              false
 
872
            with Not_found -> true
 
873
          then string_unsafe_sub subj pos len :: strs
 
874
          else
 
875
            let first = Array.unsafe_get ovector 0 in
 
876
            let last = Array.unsafe_get ovector 1 in
 
877
            if first = pos then
 
878
              if last = pos then
 
879
                let strs = if prematch then handle_subgroups strs else strs in
 
880
                if len = 0 then "" :: strs
 
881
                else if
 
882
                  try
 
883
                    unsafe_pcre_exec
 
884
                      (flags lor 0x0410) rex ~pos ~subj_start:pos ~subj
 
885
                      ovector callout;
 
886
                    true
 
887
                  with Not_found -> false
 
888
                then
 
889
                  let new_strs = handle_subgroups ("" :: strs) in
 
890
                  loop new_strs (cnt - 1) (Array.unsafe_get ovector 1) false
 
891
                else
 
892
                  let new_strs = string_unsafe_sub subj pos 1 :: strs in
 
893
                  loop new_strs (cnt - 1) (pos + 1) true
 
894
              else
 
895
                if prematch then loop (handle_subgroups strs) cnt last false
 
896
                else loop (handle_subgroups ("" :: strs)) (cnt - 1) last false
 
897
            else
 
898
              let new_strs = string_unsafe_sub subj pos (first - pos) :: strs in
 
899
              loop (handle_subgroups new_strs) (cnt - 1) last false in
 
900
    loop [] (max - 1) pos false
 
901
 
 
902
let rec strip_all_empty = function "" :: t -> strip_all_empty t | l -> l
 
903
 
 
904
external isspace : char -> bool = "pcre_isspace_stub" @noalloc@
 
905
 
 
906
let rec find_no_space ix len str =
 
907
  if ix = len || not (isspace (String.unsafe_get str ix)) then ix
 
908
  else find_no_space (ix + 1) len str
 
909
 
 
910
let split ?(iflags = 0) ?flags ?rex ?pat ?(pos = 0) ?(max = 0) ?callout subj =
 
911
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
912
  let res =
 
913
    match pat, rex with
 
914
    | Some str, _ -> internal_psplit iflags (regexp str) max pos callout subj
 
915
    | _, Some rex -> internal_psplit iflags rex max pos callout subj
 
916
    | _ ->
 
917
        (* special case for Perl-splitting semantics *)
 
918
        let len = String.length subj in
 
919
        if pos > len || pos < 0 then failwith "Pcre.split: illegal offset";
 
920
        let new_pos = find_no_space pos len subj in
 
921
        internal_psplit iflags def_rex max new_pos callout subj in
 
922
  List.rev (if max = 0 then strip_all_empty res else res)
 
923
 
 
924
let asplit ?iflags ?flags ?rex ?pat ?pos ?max ?callout subj =
 
925
  Array.of_list (split ?iflags ?flags ?rex ?pat ?pos ?max ?callout subj)
 
926
 
 
927
 
 
928
(* Full splitting *)
 
929
 
 
930
type split_result = Text of string
 
931
                  | Delim of string
 
932
                  | Group of int * string
 
933
                  | NoGroup
 
934
 
 
935
let rec strip_all_empty_full = function
 
936
  | Delim _ :: rest -> strip_all_empty_full rest
 
937
  | l -> l
 
938
 
 
939
let full_split ?(iflags = 0) ?flags ?(rex = def_rex) ?pat
 
940
               ?(pos = 0) ?(max = 0) ?callout subj =
 
941
  let rex = match pat with Some str -> regexp str | _ -> rex in
 
942
  let iflags = match flags with Some flags -> rflags flags | _ -> iflags in
 
943
  let subj_len = String.length subj in
 
944
  if subj_len = 0 then []
 
945
  else if max = 1 then [Text (subj)]
 
946
  else
 
947
    let subgroups2, ovector = make_ovector rex in
 
948
 
 
949
    (* Adds contents of subgroups to the string accumulator *)
 
950
    let handle_subgroups strs =
 
951
      let strs = ref strs in
 
952
      let i = ref 2 in
 
953
      while !i < subgroups2 do
 
954
        let group_nr = !i lsr 1 in
 
955
        let first = Array.unsafe_get ovector !i in
 
956
        incr i;
 
957
        let last = Array.unsafe_get ovector !i in
 
958
        let str =
 
959
          if first < 0 then NoGroup
 
960
          else
 
961
            let group_str = string_unsafe_sub subj first (last - first) in
 
962
            Group (group_nr, group_str) in
 
963
        strs := str :: !strs; incr i
 
964
      done;
 
965
      !strs in
 
966
 
 
967
    (* Performs the recursive split *)
 
968
    let rec loop strs cnt pos prematch =
 
969
      let len = subj_len - pos in
 
970
      if len < 0 then strs
 
971
      else
 
972
        (* Checks termination due to max restriction *)
 
973
        if cnt = 0 then
 
974
          if prematch &&
 
975
            try
 
976
              unsafe_pcre_exec
 
977
                iflags rex ~pos ~subj_start:pos ~subj ovector callout;
 
978
               true
 
979
            with Not_found -> false
 
980
          then
 
981
            let first = Array.unsafe_get ovector 0 in
 
982
            let last = Array.unsafe_get ovector 1 in
 
983
            let delim = Delim (string_unsafe_sub subj first (last - first)) in
 
984
            Text (string_unsafe_sub subj last (subj_len - last))
 
985
              :: handle_subgroups (delim :: strs)
 
986
          else
 
987
            if len = 0 then strs
 
988
            else Text (string_unsafe_sub subj pos len) :: strs
 
989
 
 
990
        (* Calculates next accumulator state for splitting *)
 
991
        else
 
992
          if
 
993
            try
 
994
              unsafe_pcre_exec
 
995
                iflags rex ~pos ~subj_start:pos ~subj ovector callout;
 
996
              false
 
997
            with Not_found -> true
 
998
          then
 
999
            if len = 0 then strs
 
1000
            else Text (string_unsafe_sub subj pos len) :: strs
 
1001
          else
 
1002
            let first = Array.unsafe_get ovector 0 in
 
1003
            let last = Array.unsafe_get ovector 1 in
 
1004
            if first = pos then
 
1005
              if last = pos then
 
1006
                if len = 0 then handle_subgroups (Delim "" :: strs)
 
1007
                else
 
1008
                  let empty_groups = handle_subgroups [] in
 
1009
                  if
 
1010
                    try
 
1011
                      unsafe_pcre_exec
 
1012
                        (iflags lor 0x0410) rex ~pos ~subj_start:pos ~subj
 
1013
                        ovector callout;
 
1014
                      true
 
1015
                    with Not_found -> false
 
1016
                  then
 
1017
                    let first = Array.unsafe_get ovector 0 in
 
1018
                    let last = Array.unsafe_get ovector 1 in
 
1019
                    let delim =
 
1020
                      Delim (string_unsafe_sub subj first (last - first)) in
 
1021
                    let new_strs =
 
1022
                      handle_subgroups (
 
1023
                        delim :: (if prematch then strs
 
1024
                                  else empty_groups @ (Delim "" :: strs))) in
 
1025
                    loop new_strs (cnt - 1) last false
 
1026
                  else
 
1027
                    let new_strs =
 
1028
                      Text (string_unsafe_sub subj pos 1)
 
1029
                        :: empty_groups @ Delim "" :: strs in
 
1030
                    loop new_strs (cnt - 1) (pos + 1) true
 
1031
              else
 
1032
                  let delim =
 
1033
                    Delim (string_unsafe_sub subj first (last - first)) in
 
1034
                  loop (handle_subgroups (delim :: strs)) cnt last false
 
1035
            else
 
1036
              let delim = Delim (string_unsafe_sub subj first (last - first)) in
 
1037
              let pre_strs =
 
1038
                Text (string_unsafe_sub subj pos (first - pos)) :: strs in
 
1039
              loop
 
1040
                (handle_subgroups (delim :: pre_strs)) (cnt - 1) last false in
 
1041
    let res = loop [] (max - 1) pos true in
 
1042
    List.rev (if max = 0 then strip_all_empty_full res else res)
 
1043
 
 
1044
 
 
1045
(* Additional convenience functions useful in combination with this library *)
 
1046
 
 
1047
let foreach_line ?(ic = stdin) f =
 
1048
  try while true do f (input_line ic) done with End_of_file -> ()
 
1049
 
 
1050
let foreach_file filenames f =
 
1051
  let do_with_file filename =
 
1052
    let file = open_in filename in
 
1053
    try f filename file; close_in file
 
1054
    with exn -> close_in file; raise exn in
 
1055
  List.iter do_with_file filenames