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
131
132
133
134
module type BASE = sig
val b : int
end
module type TABLE = sig
exception Not_found
exception Conflict
type 'a t
type key
val empty : 'a t
val add : ?overwrite:bool -> key -> 'a -> 'a t -> 'a t
val find : key -> 'a t -> 'a
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
exception Not_found
exception Conflict
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);
T ar
| Some _, false -> raise Conflict
| Some _, true ->
ar.(i) <- (Some attr, tb);
T ar)
else (
ar.(i) <- (a, insert1 r tb);
T ar)
in
insert1 n table
let rec find n table =
match table with
| Nil -> raise Not_found
| 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 with None -> raise Not_found | Some b -> b
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