Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 115 lines (97 sloc) 3.058 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 exception MaxSize
19 exception UnknownCell
20
21 type 'a t =
22 { mutable array : 'a array
23 ; init : 'a
24 ; mutable length : int }
25
26 let make ?size n init =
27 let size = match size with Some s -> s | _ -> n in
28 { array = Array.make size init
29 ; init = init
30 ; length = n }
31
32 let create = make
33
34 let clear t =
35 t.array <- [||];
36 t.length <- 0
37
38 let get a i =
39 if i < a.length then Array.unsafe_get a.array i
40 else raise UnknownCell
41 (** problème: set peut renvoyer (sans qu'on le sache) un tableau frais
42 cela est gênant si on dépend d'effets de bord
43 *)
44
45 let set a i v =
46 let l = Array.length a.array in
47 if i < l then begin
48 Array.unsafe_set a.array i v ;
49 if i >= a.length then a.length <- succ i
50 end
51 else if i < Sys.max_array_length then
52 let n = max i (min Sys.max_array_length (2 * l)) in
53 begin
54 a.array <- Array.init n (
55 fun j ->
56 if j < l then Array.unsafe_get a.array j
57 else if j = i then v
58 else a.init
59 ) ;
60 a.length <- succ i
61 end
62 else raise MaxSize
63
64 let length a = a.length
65
66 let real_length a = Array.length a.array
67
68 let append a b =
69 let la = length a
70 and lb = length b in
71 let l = la + lb in
72 { array = Array.init l (
73 fun i ->
74 if i < la then Array.unsafe_get a.array i
75 else Array.unsafe_get b.array (i - la)
76 )
77 ; init = if la>0 || lb>0 then Array.unsafe_get (if la > 0 then a else b).array 0 else a.init
78 ; length = la + lb }
79
80 let fold_left f init a =
81 let rec aux acc i =
82 if i = length a then acc
83 else aux (f acc (Array.unsafe_get a.array i)) (succ i)
84 in aux init 0
85
86 let fold_left_i f init a =
87 let rec aux acc i =
88 if i = length a then acc
89 else aux (f acc (Array.unsafe_get a.array i) ~i) (succ i)
90 in aux init 0
91
92 let delete a pfrom pto =
93 let offset = pto - pfrom in
94 if offset > 0 then begin
95 for i = pto to pred (length a) do
96 a.array.(i - offset) <- a.array.(i)
97 done ;
98 a.length <- a.length - offset
99 end else failwith "delete failed: empty region"
100
101 let insert a pos b =
102 let la = length a
103 and lb = length b in
104 let l = la + lb in
105 if l <= real_length a then begin
106 for i = pred l downto pos + lb do
107 a.array.(i) <- a.array.(i - lb)
108 done ;
109 for i = pos to pred (pos + lb) do
110 a.array.(i) <- b.array.(i - pos)
111 done ;
112 a.length <- a.length + lb
113 end else
114 raise (Base.NotImplemented "insert")
Something went wrong with that request. Please try again.