Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 232 lines (181 sloc) 6.519 kB
59411f1 @nrs135 [feature] libbase: Added baseStringSlice.
nrs135 authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19
20 type slice = { str : string; mutable base : int; mutable len : int; }
21
22 let empty = { str=""; base=0; len=0; }
23
24 let length s = s.len
25
26 let get s i = String.get s.str (s.base+i)
27
28 let set s i ch = String.set s.str (s.base+i) ch
29
30 let create len = { str=String.create len; base=0; len=len; }
31
32 let unsafe_get s i = String.unsafe_get s.str (s.base+i)
33
34 let unsafe_set s i ch = String.unsafe_set s.str (s.base+i) ch
35
36 let unsafe_blit s soff d doff len = String.unsafe_blit s.str (s.base+soff) d.str (d.base+doff) len
37
38 let unsafe_fill s off len ch = String.unsafe_fill s.str (s.base+off) len ch
39
40 let make n c =
41 let s = create n in
42 unsafe_fill s 0 n c;
43 s
44
45 let copy s =
46 let len = length s in
47 let r = create len in
48 unsafe_blit s 0 r 0 len;
49 r
50
51 let unsafe_sub s ofs len =
4268e9e @nrs135 [fix] libbase: Fixed bug in sub in BaseStringSlice.
nrs135 authored
52 { str=s.str; base=s.base+ofs; len; }
59411f1 @nrs135 [feature] libbase: Added baseStringSlice.
nrs135 authored
53
54 let sub s ofs len =
55 if ofs < 0 || len < 0 || ofs > length s - len
56 then invalid_arg "BaseStringSlice.sub"
57 else unsafe_sub s ofs len
58
59 let fill s ofs len c =
60 if ofs < 0 || len < 0 || ofs > length s - len
61 then invalid_arg "BaseStringSlice.fill"
62 else unsafe_fill s ofs len c
63
64 let blit s1 ofs1 s2 ofs2 len =
65 if len < 0 || ofs1 < 0 || ofs1 > length s1 - len
66 || ofs2 < 0 || ofs2 > length s2 - len
67 then invalid_arg "String.blit"
68 else unsafe_blit s1 ofs1 s2 ofs2 len
69
70 let iter f a =
71 for i = 0 to length a - 1 do f(unsafe_get a i) done
72
73 let concat sep l =
74 match l with
75 [] -> empty
76 | hd :: tl ->
77 let num = ref 0 and len = ref 0 in
78 List.iter (fun s -> incr num; len := !len + length s) l;
79 let r = create (!len + length sep * (!num - 1)) in
80 unsafe_blit hd 0 r 0 (length hd);
81 let pos = ref(length hd) in
82 List.iter
83 (fun s ->
84 unsafe_blit sep 0 r !pos (length sep);
85 pos := !pos + length sep;
86 unsafe_blit s 0 r !pos (length s);
87 pos := !pos + length s)
88 tl;
89 r
90
91 external is_printable: char -> bool = "caml_is_printable"
92 external char_code: char -> int = "%identity"
93 external char_chr: int -> char = "%identity"
94
95 let escaped s =
96 let n = ref 0 in
97 for i = 0 to length s - 1 do
98 n := !n +
99 (match unsafe_get s i with
100 | '"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
101 | c -> if is_printable c then 1 else 4)
102 done;
103 if !n = length s then s else begin
104 let s' = create !n in
105 n := 0;
106 for i = 0 to length s - 1 do
107 begin
108 match unsafe_get s i with
109 | ('"' | '\\') as c ->
110 unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c
111 | '\n' ->
112 unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n'
113 | '\t' ->
114 unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't'
115 | '\r' ->
116 unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r'
117 | '\b' ->
118 unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b'
119 | c ->
120 if is_printable c then
121 unsafe_set s' !n c
122 else begin
123 let a = char_code c in
124 unsafe_set s' !n '\\';
125 incr n;
126 unsafe_set s' !n (char_chr (48 + a / 100));
127 incr n;
128 unsafe_set s' !n (char_chr (48 + (a / 10) mod 10));
129 incr n;
130 unsafe_set s' !n (char_chr (48 + a mod 10))
131 end
132 end;
133 incr n
134 done;
135 s'
136 end
137
138 let map f s =
139 let l = length s in
140 if l = 0 then s else begin
141 let r = create l in
142 for i = 0 to l - 1 do unsafe_set r i (f(unsafe_get s i)) done;
143 r
144 end
145
146 let uppercase s = map Char.uppercase s
147 let lowercase s = map Char.lowercase s
148
149 let apply1 f s =
150 if length s = 0 then s else begin
151 let r = copy s in
152 unsafe_set r 0 (f(unsafe_get s 0));
153 r
154 end
155
156 let capitalize s = apply1 Char.uppercase s
157 let uncapitalize s = apply1 Char.lowercase s
158
159 let rec index_rec s lim i c =
160 if i >= lim then raise Not_found else
161 if unsafe_get s i = c then i else index_rec s lim (i + 1) c;;
162
163 let index s c = index_rec s (length s) 0 c;;
164
165 let index_from s i c =
166 let l = length s in
167 if i < 0 || i > l then invalid_arg "String.index_from" else
168 index_rec s l i c;;
169
170 let rec rindex_rec s i c =
171 if i < 0 then raise Not_found else
172 if unsafe_get s i = c then i else rindex_rec s (i - 1) c;;
173
174 let rindex s c = rindex_rec s (length s - 1) c;;
175
176 let rindex_from s i c =
177 if i < -1 || i >= length s then invalid_arg "String.rindex_from" else
178 rindex_rec s i c;;
179
180 let contains_from s i c =
181 let l = length s in
182 if i < 0 || i > l then invalid_arg "String.contains_from" else
183 try ignore (index_rec s l i c); true with Not_found -> false;;
184
185 let contains s c = contains_from s 0 c;;
186
187 let rcontains_from s i c =
188 if i < 0 || i >= length s then invalid_arg "String.rcontains_from" else
189 try ignore (rindex_rec s i c); true with Not_found -> false;;
190
191 type t = slice
192
193 let compare s1 s2 =
194 match Pervasives.compare s1.len s2.len with
195 | 0 ->
196 let rec aux n =
197 if n >= s1.len
198 then 0
199 else
200 match Pervasives.compare s1.str.[s1.base+n] s2.str.[s1.base+n] with
201 | 0 -> aux (n+1)
202 | n -> n
203 in
204 aux 0
205 | n -> n
206
207 (* ---Specials--- *)
208
209 let of_string str = { str; base=0; len=String.length str; }
210
211 let to_string s = String.sub s.str s.base s.len
212
213 let export s = (s.str,s.base,s.len)
214
215 let import (str,base,len) = { str; base; len; }
216
217 let widen s = s.base <- 0; s.len <- String.length s.str
218
219 let normalize s = { str=to_string s; base=0; len=s.len; }
220
221 let real_size s = String.length s.str
222
223 let set_size s len =
224 let str = String.create len in
225 String.unsafe_blit s.str s.base str 0 (min s.len len);
226 { str; base=0; len=len; }
227
228 let rebase s =
229 if s.base <> 0
230 then (String.unsafe_blit s.str s.base s.str 0 s.len;
231 s.base <- 0)
Something went wrong with that request. Please try again.