1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
(** {1 Efficient Mutable Lists} *)
type 'a gen = unit -> 'a option
type 'a iter = ('a -> unit) -> unit
type 'a clonable = <
gen : 'a gen; (** Generator of values tied to this copy *)
clone : 'a clonable; (** Clone the internal state *)
>
type 'a node =
| Nil
| Cons of 'a array * int ref * 'a node ref
| Cons1 of 'a * 'a node ref
| Suspend of 'a gen
type 'a t = {
start : 'a node ref;
mutable chunk_size : int;
max_chunk_size : int;
}
let _make ~max_chunk_size gen = {
start = ref (Suspend gen);
chunk_size = 8;
max_chunk_size;
}
let _make_no_buffer gen = {
start = ref (Suspend gen);
chunk_size = 1;
max_chunk_size = 1;
}
let _incr_chunk_size mlist =
if mlist.chunk_size < mlist.max_chunk_size
then mlist.chunk_size <- 2 * mlist.chunk_size
let _read_chunk mlist gen =
match gen() with
| None -> Nil
| Some x when mlist.max_chunk_size = 1 ->
let tail = ref (Suspend gen) in
let node = Cons1 (x, tail) in
node
| Some x ->
let r = ref 1 in
let a = Array.make mlist.chunk_size x in
let tail = ref (Suspend gen) in
let stop = ref false in
let node = Cons (a, r, tail) in
while not !stop && !r < mlist.chunk_size do
match gen() with
| None ->
tail := Nil;
stop := true
| Some x ->
a.(!r) <- x;
incr r;
done;
_incr_chunk_size mlist;
node
let of_gen gen =
let mlist = _make ~max_chunk_size:4096 gen in
let rec _fill prev = match _read_chunk mlist gen with
| Nil -> prev := Nil
| Suspend _ -> assert false
| Cons1 (_, prev') as node ->
prev := node;
_fill prev'
| Cons (_, _, prev') as node ->
prev := node;
_fill prev'
in
_fill mlist.start;
mlist
let of_gen_lazy ?(max_chunk_size=2048) ?(caching=true) gen =
if caching
then
let max_chunk_size = max max_chunk_size 2 in
_make ~max_chunk_size gen
else _make_no_buffer gen
let to_gen l =
let cur = ref l.start in
let i = ref 0 in
let rec next() = match ! !cur with
| Nil -> None
| Cons1 (x, l') ->
cur := l';
Some x
| Cons (a,n,l') ->
if !i = !n
then begin
cur := l';
i := 0;
next()
end else begin
let y = a.(!i) in
incr i;
Some y
end
| Suspend gen ->
let node = _read_chunk l gen in
!cur := node;
next()
in
next
let to_seq l0 : _ Seq.t =
let rec next l i ()=
match !l with
| Nil -> Seq.Nil
| Cons1 (x, l') ->
Seq.Cons (x, next l' i)
| Cons (a,n,l') ->
if i = !n then (
next l' 0 ()
) else (
let y = a.(i) in
Seq.Cons (y, next l (i+1))
)
| Suspend gen ->
let node = _read_chunk l0 gen in
l := node;
next l i ()
in
next l0.start 0
let to_clonable l : 'a clonable =
let rec make node i =
let cur = ref node and i = ref i in
let rec next() = match ! !cur with
| Nil -> None
| Cons (a,n,l') ->
if !i = !n
then begin
cur := l';
i := 0;
next()
end else begin
let y = a.(!i) in
i := !i+1;
Some y
end
| Cons1 (x, l') ->
cur := l';
Some x
| Suspend gen ->
let node = _read_chunk l gen in
(!cur) := node;
next()
in
object
method gen = next
method clone = make !cur !i
end
in
make l.start 0