Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 252 lines (229 sloc) 6.37 kB
fccc685 Initial open-source release
MLstate 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 (* CF mli *)
19
20 include Array
21 let is_empty a = Array.length a = 0
22 let unsafe_create l = create l (Obj.magic 0)
23 let copy_memory a =
24 let l = length a in
25 if l = 0 then [||] else begin
26 let res = unsafe_create l in
27 for i = 0 to pred l do
28 unsafe_set res i (unsafe_get a i)
29 done;
30 res
31 end
32 let unsafe_blit a1 ofs1 a2 ofs2 len =
33 if ofs1 < ofs2 then
34 (* Top-down copy *)
35 for i = len - 1 downto 0 do
36 unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
37 done
38 else
39 (* Bottom-up copy *)
40 for i = 0 to len - 1 do
41 unsafe_set a2 (ofs2 + i) (unsafe_get a1 (ofs1 + i))
42 done
43 let append_memory a1 a2 =
44 let l1 = Array.length a1 and l2 = Array.length a2 in
45 if l1 = 0 && l2 = 0 then [||] else begin
46 let r = unsafe_create (l1 + l2) (*This deactivates [float] optimizations*) in
47 for i = 0 to l1 - 1 do Array.unsafe_set r i (Array.unsafe_get a1 i) done;
48 for i = 0 to l2 - 1 do Array.unsafe_set r (i + l1) (Array.unsafe_get a2 i) done;
49 r
50 end
51 let swap a i j =
52 let t = a.(i) in
53 a.(i) <- a.(j) ;
54 a.(j) <- t
55 let insert_sorted ?(cmp=Pervasives.compare) ?(dupl=false) x a =
56 let l = Array.length a in
57 let insert_and_blit x i =
58 let t = unsafe_create (succ l) in
59 t.(i) <- x;
60 unsafe_blit a 0 t 0 i;
61 unsafe_blit a i t (i+1) (l-i);
62 t
63 in
64 let rec aux i t =
65 if i < l then
66 let c = cmp x a.(i) in
67 if c < 0 then insert_and_blit x i
68 else if c=0 then (if not dupl then t else insert_and_blit x i)
69 else aux (i+1) t
70 else insert_and_blit x i
71 in aux 0 a
72
73 (*
74 Mathieu Wed Nov 3 16:03:15 CET 2010
75 I've benched VS snd (fold_left (fun (i, acc) x -> (succ i, f acc x i)) (0, init) a),
76 The GC die in case of too much tuple allocations.
77 *)
78 let fold_left_i f acc a =
79 let p = ref (-1) in
80 let f acc e =
81 incr(p);
82 f acc e !p
83 in
84 Array.fold_left f acc a
85
86 (** max et min d'un tableau (doit être non vide) *)
87 let max, min =
88 let oper op a =
89 let l = length a in
90 assert (l > 0) ;
91 let r = ref a.(0) in
92 for i = 1 to pred l do
93 r := op !r (unsafe_get a i)
94 done ;
95 !r
96 in
97 (fun a -> oper Pervasives.max a),
98 (fun a -> oper Pervasives.min a)
99
100 (** argmax et argmin d'un tableau (doit être non vide) *)
101 let argmax, argmin =
102 let arg_oper op a =
103 let l = length a in
104 assert (l > 0) ;
105 let m = ref 0 in
106 for i = 1 to pred l do
107 if op (unsafe_get a i) (unsafe_get a !m) then m := i
108 done ;
109 !m
110 in
111 (fun a -> arg_oper (>) a),
112 (fun a -> arg_oper (<) a)
113
114 let map_some f a =
115 let a' = map f a in
116 let nb = fold_left (fun acc -> function Some _ -> succ acc | _ -> acc) 0 a' in
117 let pos = ref 0 in
118 init nb (
119 fun _ ->
120 while not(Option.is_some a'.(!pos)) do incr pos done ;
121 let r = match a'.(!pos) with Some r -> r | _ -> assert false in
122 incr pos ; r
123 )
124
125 let mapi_some f a =
126 let a' = mapi f a in
127 let nb = fold_left (fun acc -> function Some _ -> succ acc | _ -> acc) 0 a' in
128 let pos = ref 0 in
129 init nb (
130 fun _ ->
131 while not(Option.is_some a'.(!pos)) do incr pos done ;
132 let r = match a'.(!pos) with Some r -> r | _ -> assert false in
133 incr pos ; r
134 )
135
136 let map2 f a1 a2 =
137 let l = length a1 in
138 assert (l = length a2) ;
139 init l (fun i -> f (unsafe_get a1 i) (unsafe_get a2 i))
140
141 let fill_some a v pfrom pto =
142 for i = pfrom to pred pto do
143 match a.(i) with
144 | None -> a.(i) <- Some v
145 | _ -> ()
146 done
147
148 let mem a tab =
149 let l = length tab in
150 let rec aux i =
151 if i >= l then false
152 else if unsafe_get tab i = a then true else aux (succ i)
153 in aux 0
154
155 let exists fct tab =
156 let l = length tab in
157 let rec aux i =
158 if i >= l then false
159 else if fct (unsafe_get tab i) then true else aux (succ i)
160 in aux 0
161
162 let split a =
163 let len = Array.length a in
164 if len = 0 then ([||], [||])
165 else
166 let (left_init, right_init) = a.(0) in
167 let left = Array.make len left_init
168 and right= Array.make len right_init in
169 for i = 0 to len - 1 do
170 let (left_item, right_item) = unsafe_get a i in
171 unsafe_set left i left_item;
172 unsafe_set right i right_item
173 done;
174 (left, right)
175
176 let find a x =
177 let l = length a in
178 let rec aux i =
179 if i >= l then raise Not_found
180 else if unsafe_get a i = x then i else aux (succ i)
181 in aux 0
182
183 let compare cmp a b =
184 if a == b then 0 else
185 let len_a = length a in
186 let len_b = length b in
187 let rec aux i =
188 if i >= len_a then
189 if i >= len_b then 0 else -1
190 else if i >= len_b then
191 1
192 else
193 let va = unsafe_get a i in
194 let vb = unsafe_get b i in
195 let cmp = cmp va vb in
196 if cmp <> 0 then cmp
197 else aux (succ i)
198 in aux 0
199
200
201 let to_string f a =
202 let rec aux acc i =
203 if i < 0 then acc
204 else aux ((f a.(i))^acc) (pred i)
205 in
206 let l = length a in
207 if l = 0 then "[||]"
208 else aux "" (l -1);;
209
210 let print f a =
211 let rec aux acc i =
212 if i = 0 then "[|"^(f a.(i))^acc
213 else aux (";"^(f a.(i))^acc) (pred i)
214 in
215 let l = length a in
216 if l = 0 then "[||]"
217 else aux "|]" (l-1);;
218
219 let filteri fct a =
220 let len = length a in
221 if len = 0
222 then a
223 else
224 let rec aux filter acc i =
225 if i = len
226 then
227 filter, acc
228 else
229 let ai = unsafe_get a i in
230 if fct i ai
231 then
232 aux (succ filter) (ai :: acc) (succ i)
233 else
234 aux filter acc (succ i)
235 in
236 let filter, acc = aux 0 [] 0 in
237 let fa = create filter (unsafe_get a 0) in
238 let rec fill acc i =
239 match acc with
240 | [] -> ()
241 | hd :: tl -> (
242 unsafe_set fa i hd ;
243 fill tl (pred i)
244 )
245 in
246 fill acc (pred filter) ;
247 fa
248
249 let filter fct a =
250 let fct _ a = fct a in
251 filteri fct a
Something went wrong with that request. Please try again.