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
type 'a key0 = ..
type (_, _) eq_res = Eq : ('a, 'a) eq_res | NEq : ('a, 'b) eq_res
type 'a key = { eq : 'b. 'b key0 -> ('a,'b) eq_res
; key : 'a key0
; cln : 'a -> bool
; del : 'a -> unit
; sav : out_channel -> 'a -> unit
; lod : in_channel -> 'a
; idx : string }
type cell = D : 'a key * 'a -> cell
type data = cell list
type key_ref = R : 'a key -> key_ref
let key_directory = Hashtbl.create 128
let get_key : string -> key_ref = Hashtbl.find key_directory
let get_idx k = k.idx
let new_key : type a. (a -> bool) -> (a -> unit) ->
(out_channel -> a -> unit) ->
(in_channel -> a) ->
string ->
a key =
fun cln del sav lod key_name ->
let module M = struct
type 'a key0 += K : a key0
let key = K
let eq : type b. b key0 -> (a,b) eq_res = function
| K -> Eq
| _ -> NEq
let r = { eq; key; cln; del; sav; lod; idx=key_name }
let _ =
if Hashtbl.mem key_directory key_name then
begin
Printf.eprintf "FATAL ERROR: data key %s allready exists\n%!" key_name;
exit 1
end;
Hashtbl.add key_directory key_name (R r);
end
in
M.r
let search : type a. a key -> data -> a
= fun key l ->
let rec fn : data -> a = function
| [] -> raise Not_found
| D(k,x):: l ->
match key.eq k.key, x with
| Eq, x -> x
| NEq, _ -> fn l
in fn l
let add_replace : type a. a key -> a -> data -> data
= fun key x l ->
let rec fn : data -> data -> data = fun acc l ->
match l with
| [] -> List.rev_append acc [D(key, x)]
| D(k,_) as c:: l ->
match key.eq k.key with
| Eq -> List.rev_append acc (D(k,x) :: l)
| _ -> fn (c::acc) l
in fn [] l
let remove : type a. a key -> data -> data
= fun key l0 ->
let rec fn : data -> data -> data = fun acc l ->
match l with
| [] -> l0
| D(k,_) as c:: l ->
match key.eq k.key with
| Eq -> List.rev_append acc l
| _ -> fn (c::acc) l
in fn [] l0
let cleanup k x = k.cln x
let cleanup_delete l =
List.iter (function D(k,x) ->
let b = cleanup k x in
if b then k.del x) l
let cleanup_filter l =
List.filter (function D(k,x) -> cleanup k x) l
let empty = []
let save ch l =
let l = cleanup_filter l in
output_value ch (List.length l);
List.iter (function D(key, data) ->
output_value ch key.idx;
key.sav ch data) l
let load ch =
let size = input_value ch in
let res = ref [] in
for _ = 1 to size do
let idx = input_value ch in
try
match get_key idx with
| R k ->
let data = k.lod ch in
res := D(k, data) :: !res;
with
Not_found ->
Printf.eprintf "FATAL ERROR: data key: %s not found\n%!" idx;
exit 1
done;
!res