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 | -- A collection of protected data with notifiers
with Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Vectors;
with Agpl.Generic_Handle;
package Agpl.Protected_Datastore is
pragma Preelaborate;
Log_Section : constant String := "agpl.protected_datastore";
Data_Not_Present : exception;
type Object_Data is abstract tagged null record;
-- This is data to be kept in the datastore
type Object_Data_Access is access all Object_Data'Class;
package Object_Data_Handles is new Agpl.Generic_Handle (Object_Data'Class);
type Data_Handle is new Object_Data_Handles.Object with null record;
-- To modify values in place
type Functor is abstract tagged null record;
procedure Operate (This : in out Functor; Value : in out Object_Data'Class)
is abstract;
subtype Object_Key is String;
-- This is the indexing type
-- Should be an interface but GPL2006 still gives problems
type Key_Listener is abstract tagged limited null record;
-- Something that wants to be notified when a key is stored
type Key_Listener_Access is access all Key_Listener'Class;
procedure On_Key_Stored (This : in out Key_Listener;
Key : in Object_Key;
Value : in Object_Data'Class)
is abstract;
-- Processing here should be as fast as possible, since all chained calls
-- are synchronous.
-- Care is to be taken to not cause recursive calling!! This is up to the
-- clients.
type Object is tagged limited private;
type Object_Access is access Object'Class;
pragma Preelaborable_Initialization (Object);
function Contains (This : in Object;
Key : in Object_Key)
return Boolean;
function Get (This : in Object;
Key : in Object_Key)
return Object_Data'Class;
-- Retrieve something or raise Data_Not_Present.
procedure Put (This : in out Object;
Key : in Object_Key;
Value : in Object_Data'Class);
-- Store something.
procedure Set (This : in out Object;
Key : in Object_Key;
Value : in Object_Data'Class) renames Put;
procedure Listen (This : in out Object;
Key : in Object_Key;
Listener : not null Key_Listener_Access);
-- Register for a key
procedure Unlisten (This : in out Object;
Key : Object_Key;
Listener : not null Key_Listener_Access);
procedure Update (This : in out Object;
Key : in Object_Key;
Fun : in out Functor'Class);
private
package Listener_Vectors is new Ada.Containers.Vectors
(Positive,
Key_Listener_Access);
package Key_Listener_Maps is new Ada.Containers.Indefinite_Ordered_Maps
(Object_Key,
Listener_Vectors.Vector,
"<",
Listener_Vectors."=");
package Key_Object_Maps is new Ada.Containers.Indefinite_Ordered_Maps
(Object_Key,
Object_Data'Class);
protected type Safe_Object is
function Contains (Key : in Object_Key)
return Boolean;
procedure Put (Key : in Object_Key;
Value : in Object_Data'Class);
function Get (Key : in Object_Key)
return Object_Data'Class;
function Get_Callbacks (Key : in Object_Key)
return Listener_Vectors.Vector;
procedure Listen (Key : in Object_Key;
Listener : Key_Listener_Access);
procedure Unlisten (Key : in Object_Key;
Listener : Key_Listener_Access);
procedure Update (Key : in Object_Key;
Fun : in out Functor'Class;
Res : out Object_Data_Handles.Object);
private
Callbacks : Key_Listener_Maps.Map;
Values : Key_Object_Maps.Map;
end Safe_Object;
type Object is tagged limited record
Safe : Safe_Object;
end record;
end Agpl.protected_Datastore;
|