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
module Bests = Set.Make (Db.Entry)
type t =
{ size : int
; bests : Bests.t
}
let empty = { size = 0; bests = Bests.empty }
type step =
| Continue of t
| Stop of t
let update_entry query entry =
let = Dynamic_cost.score query entry in
Db.Entry.{ entry with cost = entry.cost + extra_cost }
let add ~query ~limit elt t =
if t.size < limit
then begin
let elt = update_entry query elt in
Continue { size = t.size + 1; bests = Bests.add elt t.bests }
end
else begin
let worst = Bests.max_elt t.bests in
if Db.Entry.(elt.cost > worst.cost)
then Stop t
else begin
let elt = update_entry query elt in
if Db.Entry.(elt.cost > worst.cost)
then Continue t
else Continue { t with bests = Bests.add elt @@ Bests.remove worst t.bests }
end
end
let max_seek = 10
module Make (IO : Io.S) = struct
module Seq = Io.Seq (IO)
let of_seq ~query ~limit seq =
let rec go total_seen t seq =
if total_seen >= limit + max_seek
then IO.return t
else begin
IO.bind (seq ())
@@ function
| Seq.Nil -> IO.return t
| Cons (x, xs) -> begin
match add ~query ~limit x t with
| Stop t -> IO.return t
| Continue t -> go (total_seen + 1) t xs
end
end
in
IO.map (go 0 empty seq) @@ fun t -> List.of_seq @@ Bests.to_seq t.bests
end