Permalink
Browse files

[feature] libbase: Added baseStringSlice.

  • Loading branch information...
1 parent 1beb724 commit 59411f160dd79b13e0f5197c0368cfe46ad56bae @nrs135 nrs135 committed Sep 6, 2011
Showing with 290 additions and 0 deletions.
  1. +231 −0 libbase/baseStringSlice.ml
  2. +59 −0 libbase/baseStringSlice.mli
View
@@ -0,0 +1,231 @@
+(*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*)
+
+
+type slice = { str : string; mutable base : int; mutable len : int; }
+
+let empty = { str=""; base=0; len=0; }
+
+let length s = s.len
+
+let get s i = String.get s.str (s.base+i)
+
+let set s i ch = String.set s.str (s.base+i) ch
+
+let create len = { str=String.create len; base=0; len=len; }
+
+let unsafe_get s i = String.unsafe_get s.str (s.base+i)
+
+let unsafe_set s i ch = String.unsafe_set s.str (s.base+i) ch
+
+let unsafe_blit s soff d doff len = String.unsafe_blit s.str (s.base+soff) d.str (d.base+doff) len
+
+let unsafe_fill s off len ch = String.unsafe_fill s.str (s.base+off) len ch
+
+let make n c =
+ let s = create n in
+ unsafe_fill s 0 n c;
+ s
+
+let copy s =
+ let len = length s in
+ let r = create len in
+ unsafe_blit s 0 r 0 len;
+ r
+
+let unsafe_sub s ofs len =
+ { str=s.str; base=ofs; len; }
+
+let sub s ofs len =
+ if ofs < 0 || len < 0 || ofs > length s - len
+ then invalid_arg "BaseStringSlice.sub"
+ else unsafe_sub s ofs len
+
+let fill s ofs len c =
+ if ofs < 0 || len < 0 || ofs > length s - len
+ then invalid_arg "BaseStringSlice.fill"
+ else unsafe_fill s ofs len c
+
+let blit s1 ofs1 s2 ofs2 len =
+ if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
+ || ofs2 < 0 || ofs2 > length s2 - len
+ then invalid_arg "String.blit"
+ else unsafe_blit s1 ofs1 s2 ofs2 len
+
+let iter f a =
+ for i = 0 to length a - 1 do f(unsafe_get a i) done
+
+let concat sep l =
+ match l with
+ [] -> empty
+ | hd :: tl ->
+ let num = ref 0 and len = ref 0 in
+ List.iter (fun s -> incr num; len := !len + length s) l;
+ let r = create (!len + length sep * (!num - 1)) in
+ unsafe_blit hd 0 r 0 (length hd);
+ let pos = ref(length hd) in
+ List.iter
+ (fun s ->
+ unsafe_blit sep 0 r !pos (length sep);
+ pos := !pos + length sep;
+ unsafe_blit s 0 r !pos (length s);
+ pos := !pos + length s)
+ tl;
+ r
+
+external is_printable: char -> bool = "caml_is_printable"
+external char_code: char -> int = "%identity"
+external char_chr: int -> char = "%identity"
+
+let escaped s =
+ let n = ref 0 in
+ for i = 0 to length s - 1 do
+ n := !n +
+ (match unsafe_get s i with
+ | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+ | c -> if is_printable c then 1 else 4)
+ done;
+ if !n = length s then s else begin
+ let s' = create !n in
+ n := 0;
+ for i = 0 to length s - 1 do
+ begin
+ match unsafe_get s i with
+ | ('"' | '\\') as c ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
+ | '\n' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
+ | '\t' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
+ | '\r' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
+ | '\b' ->
+ unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
+ | c ->
+ if is_printable c then
+ unsafe_set s' !n c
+ else begin
+ let a = char_code c in
+ unsafe_set s' !n '\\';
+ incr n;
+ unsafe_set s' !n (char_chr (48 + a / 100));
+ incr n;
+ unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
+ incr n;
+ unsafe_set s' !n (char_chr (48 + a mod 10))
+ end
+ end;
+ incr n
+ done;
+ s'
+ end
+
+let map f s =
+ let l = length s in
+ if l = 0 then s else begin
+ let r = create l in
+ for i = 0 to l - 1 do unsafe_set r i (f(unsafe_get s i)) done;
+ r
+ end
+
+let uppercase s = map Char.uppercase s
+let lowercase s = map Char.lowercase s
+
+let apply1 f s =
+ if length s = 0 then s else begin
+ let r = copy s in
+ unsafe_set r 0 (f(unsafe_get s 0));
+ r
+ end
+
+let capitalize s = apply1 Char.uppercase s
+let uncapitalize s = apply1 Char.lowercase s
+
+let rec index_rec s lim i c =
+ if i >= lim then raise Not_found else
+ if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
+
+let index s c = index_rec s (length s) 0 c;;
+
+let index_from s i c =
+ let l = length s in
+ if i < 0 || i > l then invalid_arg "String.index_from" else
+ index_rec s l i c;;
+
+let rec rindex_rec s i c =
+ if i < 0 then raise Not_found else
+ if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
+
+let rindex s c = rindex_rec s (length s - 1) c;;
+
+let rindex_from s i c =
+ if i < -1 || i >= length s then invalid_arg "String.rindex_from" else
+ rindex_rec s i c;;
+
+let contains_from s i c =
+ let l = length s in
+ if i < 0 || i > l then invalid_arg "String.contains_from" else
+ try ignore (index_rec s l i c); true with Not_found -> false;;
+
+let contains s c = contains_from s 0 c;;
+
+let rcontains_from s i c =
+ if i < 0 || i >= length s then invalid_arg "String.rcontains_from" else
+ try ignore (rindex_rec s i c); true with Not_found -> false;;
+
+type t = slice
+
+let compare s1 s2 =
+ match Pervasives.compare s1.len s2.len with
+ | 0 ->
+ let rec aux n =
+ if n >= s1.len
+ then 0
+ else
+ match Pervasives.compare s1.str.[s1.base+n] s2.str.[s1.base+n] with
+ | 0 -> aux (n+1)
+ | n -> n
+ in
+ aux 0
+ | n -> n
+
+(* ---Specials--- *)
+
+let of_string str = { str; base=0; len=String.length str; }
+
+let to_string s = String.sub s.str s.base s.len
+
+let export s = (s.str,s.base,s.len)
+
+let import (str,base,len) = { str; base; len; }
+
+let widen s = s.base <- 0; s.len <- String.length s.str
+
+let normalize s = { str=to_string s; base=0; len=s.len; }
+
+let real_size s = String.length s.str
+
+let set_size s len =
+ let str = String.create len in
+ String.unsafe_blit s.str s.base str 0 (min s.len len);
+ { str; base=0; len=len; }
+
+let rebase s =
+ if s.base <> 0
+ then (String.unsafe_blit s.str s.base s.str 0 s.len;
+ s.base <- 0)
@@ -0,0 +1,59 @@
+(*
+ Copyright © 2011 MLstate
+
+ This file is part of OPA.
+
+ OPA is free software: you can redistribute it and/or modify it under the
+ terms of the GNU Affero General Public License, version 3, as published by
+ the Free Software Foundation.
+
+ OPA is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+ FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
+ more details.
+
+ You should have received a copy of the GNU Affero General Public License
+ along with OPA. If not, see <http://www.gnu.org/licenses/>.
+*)
+
+type t
+val empty : t
+val length : t -> int
+val get : t -> int -> char
+val set : t -> int -> char -> unit
+val create : int -> t
+val make : int -> char -> t
+val copy : t -> t
+val sub : t -> int -> int -> t
+val unsafe_sub : t -> int -> int -> t
+val fill : t -> int -> int -> char -> unit
+val blit : t -> int -> t -> int -> int -> unit
+val concat : t -> t list -> t
+val iter : (char -> unit) -> t -> unit
+val escaped : t -> t
+val index : t -> char -> int
+val rindex : t -> char -> int
+val index_from : t -> int -> char -> int
+val rindex_from : t -> int -> char -> int
+val contains : t -> char -> bool
+val contains_from : t -> int -> char -> bool
+val rcontains_from : t -> int -> char -> bool
+val uppercase : t -> t
+val lowercase : t -> t
+val capitalize : t -> t
+val uncapitalize : t -> t
+val compare: t -> t -> int
+val unsafe_get : t -> int -> char
+val unsafe_set : t -> int -> char -> unit
+val unsafe_blit : t -> int -> t -> int -> int -> unit
+val unsafe_fill : t -> int -> int -> char -> unit
+
+val of_string : string -> t
+val to_string : t -> string
+val export : t -> string * int * int
+val import : string * int * int -> t
+val widen : t -> unit
+val normalize : t -> t
+val real_size : t -> int
+val set_size : t -> int -> t
+val rebase : t -> unit

0 comments on commit 59411f1

Please sign in to comment.