Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 105 lines (84 sloc) 2.831 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18
19 (* Note for hacker :
20 size is an indicator of how many elt are in the set.
21 it is just a hint, because inhabitants of a set may deleted by the GC.
22 it is used in union for optimization purpose.
23 *)
24 type ('a, 'b) t = { mutable link : ('a, 'b) node }
25
26 and ('a, 'b) immediate = { size : int ;
27 key : 'a ;
28 value : 'b }
29
30 and ('a, 'b) node = | Immediate of ('a, 'b) immediate
31 | Link of ('a, 'b) t
32
33 let make k v =
34 { link = Immediate { size = 1 ; key = k ; value = v } }
35
36 let rec follow = function
37 | { link = Immediate _ } as root ->
38 root
39
40 | { link = Link link } as child ->
41 let root = follow link in
42 begin
43 (* Collapsing rule *)
44 child.link <- Link root;
45 root
46 end
47
48 let info x =
49 match follow x with
50 | { link = Immediate imm } as root ->
51 root, imm.size, imm.key, imm.value
52 | { link = Link _ } -> assert false
53
54 (* The fact to split find in 2 function in inefficent in case
55 of we need the 2 at the same time : factorization of lookup
56 (call to function info) and simplification of API *)
57
58 let find x =
59 match follow x with
60 | { link = Immediate imm } -> imm.key, imm.value
61 | _ -> assert false
62
63 let key x =
64 match follow x with
65 | { link = Immediate imm } -> imm.key
66 | _ -> assert false
67
68 let value x =
69 match follow x with
70 | { link = Immediate imm } -> imm.value
71 | _ -> assert false
72
73
74 let union a b =
75 let ca, sa, _, _ = info a
76 and cb, sb, k, v = info b in
77 (* Weighted Union rule *)
78 let tall, low, low_o =
79 (if sa > sb
80 then ca, cb, b
81 else cb, ca, a)
82 in
83 begin
84 (* optimisation : origin of low can be collapsed there as well as low.link *)
85 low_o.link <- Link tall ;
86 low.link <- Link tall ;
87 tall.link <- Immediate { size = sa + sb ; key = k ; value = v }
88 end
89
90 let replace ~replaced ~keeped = union replaced keeped
91
92 let changeval x v =
93 let root = follow x in
94 match root.link with
95 | Immediate imm -> root.link <- Immediate { imm with value = v }
96 | Link _ -> assert false
97
98 (*
99 let refresh_singleton x k v =
100 match x.link with
101 | Link _ -> assert false
102 | Immediate _ ->
103 x.link <- Immediate {size = 1; key = k; value = v}
104 *)
Something went wrong with that request. Please try again.