unikernel/duniverse/ocaml-re/lib/str.ml

@@ -0,0 +1,299 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  linking exception.                                                 *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* Modified by Jerome.Vouillon@pps.jussieu.fr for integration in RE *)
+
+(* $Id: re_str.ml,v 1.3 2002/07/03 15:47:54 vouillon Exp $ *)
+
+module Ast = Ast.Export
+
+include struct
+  open Core
+
+  let exec = exec
+  let exec_partial = exec_partial
+end
+
+type regexp =
+  { mtch : Compile.re Lazy.t
+  ; srch : Compile.re Lazy.t
+  }
+
+let compile_regexp s c =
+  let re = Emacs.re_no_emacs ~case:(not c) s in
+  { mtch = lazy (Compile.compile (Ast.seq [ Ast.start; re ]))
+  ; srch = lazy (Compile.compile re)
+  }
+;;
+
+let state = Domain.DLS.new_key (fun () -> None)
+
+let string_match re s p =
+  match exec ~pos:p (Lazy.force re.mtch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    true
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    false
+;;
+
+let string_partial_match re s p =
+  match exec_partial ~pos:p (Lazy.force re.mtch) s with
+  | `Full -> string_match re s p
+  | `Partial -> true
+  | `Mismatch -> false
+;;
+
+let search_forward re s p =
+  match exec ~pos:p (Lazy.force re.srch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    fst (Group.offset res 0)
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    raise Not_found
+;;
+
+let rec search_backward re s p =
+  match exec ~pos:p (Lazy.force re.mtch) s with
+  | res ->
+    Domain.DLS.set state (Some res);
+    p
+  | exception Not_found ->
+    Domain.DLS.set state None;
+    if p = 0 then raise Not_found else search_backward re s (p - 1)
+;;
+
+let valid_group n =
+  n >= 0
+  && n < 10
+  &&
+  match Domain.DLS.get state with
+  | None -> false
+  | Some m -> n < Group.nb_groups m
+;;
+
+let offset_group i =
+  match Domain.DLS.get state with
+  | Some m -> Group.offset m i
+  | None -> raise Not_found
+;;
+
+let group_len i =
+  match offset_group i with
+  | b, e -> e - b
+  | exception Not_found -> 0
+;;
+
+let rec repl_length repl p q len =
+  if p < len
+  then
+    if repl.[p] <> '\\'
+    then repl_length repl (p + 1) (q + 1) len
+    else (
+      let p = p + 1 in
+      if p = len then failwith "Str.replace: illegal backslash sequence";
+      let q =
+        match repl.[p] with
+        | '\\' -> q + 1
+        | '0' .. '9' as c -> q + group_len (Char.code c - Char.code '0')
+        | _ -> q + 2
+      in
+      repl_length repl (p + 1) q len)
+  else q
+;;
+
+let rec replace orig repl p res q len =
+  if p < len
+  then (
+    let c = repl.[p] in
+    if c <> '\\'
+    then (
+      Bytes.set res q c;
+      replace orig repl (p + 1) res (q + 1) len)
+    else (
+      match repl.[p + 1] with
+      | '\\' ->
+        Bytes.set res q '\\';
+        replace orig repl (p + 2) res (q + 1) len
+      | '0' .. '9' as c ->
+        let d =
+          let group = Char.code c - Char.code '0' in
+          match offset_group group with
+          | exception Not_found -> 0
+          | b, e ->
+            let d = e - b in
+            if d > 0 then String.blit orig b res q d;
+            d
+        in
+        replace orig repl (p + 2) res (q + d) len
+      | c ->
+        Bytes.set res q '\\';
+        Bytes.set res (q + 1) c;
+        replace orig repl (p + 2) res (q + 2) len))
+;;
+
+let replacement_text repl orig =
+  let len = String.length repl in
+  let res = Bytes.create (repl_length repl 0 0 len) in
+  replace orig repl 0 res 0 (String.length repl);
+  Bytes.unsafe_to_string res
+;;
+
+let quote s =
+  let len = String.length s in
+  let buf = Buffer.create (2 * len) in
+  for i = 0 to len - 1 do
+    match s.[i] with
+    | ('[' | ']' | '*' | '.' | '\\' | '?' | '+' | '^' | '$') as c ->
+      Buffer.add_char buf '\\';
+      Buffer.add_char buf c
+    | c -> Buffer.add_char buf c
+  done;
+  Buffer.contents buf
+;;
+
+let string_before s n = String.sub s 0 n
+let string_after s n = String.sub s n (String.length s - n)
+let first_chars s n = String.sub s 0 n
+let last_chars s n = String.sub s (String.length s - n) n
+let regexp e = compile_regexp e false
+let regexp_case_fold e = compile_regexp e true
+let regexp_string s = compile_regexp (quote s) false
+let regexp_string_case_fold s = compile_regexp (quote s) true
+
+let group_beginning n =
+  if not (valid_group n) then invalid_arg "Str.group_beginning";
+  let pos = fst (offset_group n) in
+  if pos = -1 then raise Not_found else pos
+;;
+
+let group_end n =
+  if not (valid_group n) then invalid_arg "Str.group_end";
+  let pos = snd (offset_group n) in
+  if pos = -1 then raise Not_found else pos
+;;
+
+let matched_group n txt =
+  let b, e = offset_group n in
+  String.sub txt b (e - b)
+;;
+
+let replace_matched repl matched = replacement_text repl matched
+
+let match_beginning () = group_beginning 0
+and match_end () = group_end 0
+and matched_string txt = matched_group 0 txt
+
+let substitute_first expr repl_fun text =
+  try
+    let pos = search_forward expr text 0 in
+    String.concat
+      ""
+      [ string_before text pos; repl_fun text; string_after text (match_end ()) ]
+  with
+  | Not_found -> text
+;;
+
+let global_substitute expr repl_fun text =
+  let rec replace accu start last_was_empty =
+    let startpos = if last_was_empty then start + 1 else start in
+    if startpos > String.length text
+    then string_after text start :: accu
+    else (
+      match search_forward expr text startpos with
+      | pos ->
+        let end_pos = match_end () in
+        let repl_text = repl_fun text in
+        replace
+          (repl_text :: String.sub text start (pos - start) :: accu)
+          end_pos
+          (end_pos = pos)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  String.concat "" (List.rev (replace [] 0 false))
+;;
+
+let global_replace expr repl text = global_substitute expr (replacement_text repl) text
+and replace_first expr repl text = substitute_first expr (replacement_text repl) text
+
+let search_forward_progress re s p =
+  let pos = search_forward re s p in
+  if match_end () > p
+  then pos
+  else if p < String.length s
+  then search_forward re s (p + 1)
+  else raise Not_found
+;;
+
+let bounded_split expr text num =
+  let start = if string_match expr text 0 then match_end () else 0 in
+  let rec split accu start n =
+    if start >= String.length text
+    then accu
+    else if n = 1
+    then string_after text start :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  List.rev (split [] start num)
+;;
+
+let split expr text = bounded_split expr text 0
+
+let bounded_split_delim expr text num =
+  let rec split accu start n =
+    if start > String.length text
+    then accu
+    else if n = 1
+    then string_after text start :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos -> split (String.sub text start (pos - start) :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> string_after text start :: accu)
+  in
+  if text = "" then [] else List.rev (split [] 0 num)
+;;
+
+let split_delim expr text = bounded_split_delim expr text 0
+
+type split_result =
+  | Text of string
+  | Delim of string
+
+let bounded_full_split expr text num =
+  let rec split accu start n =
+    if start >= String.length text
+    then accu
+    else if n = 1
+    then Text (string_after text start) :: accu
+    else (
+      match search_forward_progress expr text start with
+      | pos ->
+        let s = matched_string text in
+        if pos > start
+        then
+          split
+            (Delim s :: Text (String.sub text start (pos - start)) :: accu)
+            (match_end ())
+            (n - 1)
+        else split (Delim s :: accu) (match_end ()) (n - 1)
+      | exception Not_found -> Text (string_after text start) :: accu)
+  in
+  List.rev (split [] 0 num)
+;;
+
+let full_split expr text = bounded_full_split expr text 0