Source file table.ml
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
module type BASE = sig
val b : int
end
module type TABLE = sig
type 'a t
type key
val empty : 'a t
val add : ?overwrite:bool -> key -> 'a -> 'a t -> ('a t) option
val find : key -> 'a t -> 'a option
val fold : (key -> 'a -> 'b -> 'b) -> 'b -> 'a t -> 'b
val iter : (key -> 'a -> unit) -> 'a t -> unit
val pp :
?sep:
( (Format.formatter -> key * 'a -> unit) -> key * 'a -> unit,
Format.formatter,
unit,
unit,
unit,
(Format.formatter -> key * 'a -> unit) -> key * 'a -> unit )
format6 ->
(Format.formatter -> key -> 'a -> unit) ->
Format.formatter ->
'a t ->
unit
end
module Make_table (Base : BASE) = struct
type 'a t = Nil | T of ('a option * 'a t) array
type key = int
let create () = T (Array.make Base.b (None, Nil))
let empty = Nil
let add ?(overwrite = false) n attr table =
let rec insert1 n table =
match table with
| Nil -> insert1 n (create ())
| T ar ->
let r, i = (n / Base.b, n mod Base.b) in
let a, tb = ar.(i) in
if r = 0 then (
match (a, overwrite) with
| None, _ ->
ar.(i) <- (Some attr, tb);
Some (T ar)
| Some _, false -> None
| Some _, true ->
ar.(i) <- (Some attr, tb);
Some (T ar))
else (
Option.map
(fun o ->
ar.(i) <- (a, o);
T ar)
(insert1 r tb))
in
insert1 n table
let rec find n table =
match table with
| Nil -> None
| T ar ->
let r, i = (n / Base.b, n mod Base.b) in
let a, tb = ar.(i) in
if r = 0 then a
else find r tb
let fold f acc table =
let rec fold_aux q acc = function
| Nil -> acc
| T ar ->
let _, new_acc =
Array.fold_left
(fun (i, acc) -> function
| Some v, _ -> (i + 1, f ((q * Base.b) + i) v acc)
| None, _ -> (i + 1, acc))
(0, acc) ar
in
snd
(Array.fold_left
(fun (i, acc) (_, t) -> (i + 1, fold_aux (q + 1) acc t))
(0, new_acc) ar)
in
fold_aux 0 acc table
let iter f table =
let rec iteri_aux q f table =
match table with
| Nil -> ()
| T ar ->
let () =
Array.iteri
(fun i (value, _t) ->
match value with Some v -> f ((q * Base.b) + i) v | None -> ())
ar
in
Array.iteri (fun q (_value, t) -> iteri_aux (q + 1) f t) ar
in
iteri_aux 0 f table
let pp ?(sep = format_of_string "@,") ppf m t =
let l_pp m (k, v) = ppf m k v in
let first = ref true in
iter
(fun i v ->
if !first then
let () = first := false in
ppf m i v
else Format.fprintf m (sep ^^ "%a") l_pp (i, v))
t
end