299 lines
8.4 KiB
OCaml
299 lines
8.4 KiB
OCaml
(***********************************************************************)
|
|
(* *)
|
|
(* 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
|